A discussion of Forth in the CB today led me to wondering how much effort would be required to implement a rudimentary Forth interpreter in Perl. The answer is: about an hours worth.
use strict;
use warnings;
my %dictionary = (
'.' => \&doDot,
'."' => \&doDotQuote,
'+' => \&doAdd,
'-' => \&doSub,
'*' => \&doMul,
'/' => \&doDiv,
':' => \&doDefine,
'(' => \&doComment,
'CR' => \&doCR,
'DUP' => \&doDup,
'DROP' => \&doDrop,
'?BRANCH' => \&doFBranch,
'BRANCH' => \&doBranch,
'EMIT' => \&doEmit,
);
my @stack;
my @rstack;
my $line;
my @words;
my $state = '';
while (defined (my $word = fetchWord ())) {
next if dispatch ($word, \$state);
if ($word !~ /^[+-]?\d+\.?\d*([eE][+-]?\d+)?$/) {
print "I don't understand '$word' in line: $line\n";
@words = ();
next;
}
push @stack, $word;
}
sub fetchWord {
while (! @words) {
$line = <>;
chomp $line;
@words = split /\s+/, $line;
}
return shift @words;
}
sub dispatch {
my ($word, $state) = @_;
if ($$state eq 'quoting') {
if ($word eq '"') {
$$state = '';
return 1;
}
$stack[-1] = join ' ', grep {defined} ($stack[-1], $word);
return 1;
}
if ($$state eq 'comment') {
$$state = '' if $word eq ')';
return 1;
}
if ($$state eq 'new') {
push @stack, $word;
push @stack, undef;
$$state = 'defining';
return 1;
}
if ($$state eq 'defining') {
if ($word eq ';') {
my $code = pop @stack;
my $word = pop @stack;
$dictionary{$word} = $code;
$$state = '';
return 1;
}
$stack[-1] = join ' ', grep {defined} ($stack[-1], $word);
return 1;
}
if ($$state =~ /^\d+/) {
# Skipping for branch
$$state = '' if ! --$$state;
return 1;
}
return undef if ! exists $dictionary{$word};
if (ref $dictionary{$word}) {
$dictionary{$word}->($state);
return 1;
}
my @words = split /\s+/, $dictionary{$word};
while (@words) {
return 0 if ! dispatch (shift @words, $state);
}
return 1;
}
sub doDot {
print pop @stack;
}
sub doDotQuote {
push @stack, undef;
${$_[0]} = 'quoting';
}
sub doAdd {
return (pop @stack) + (pop @stack);
}
sub doSub {
my $rh = pop @stack;
my $lh = pop @stack;
return $lh - $rh;
}
sub doMul {
return (pop @stack) * (pop @stack);
}
sub doDiv {
my $rh = pop @stack;
my $lh = pop @stack;
return $lh / $rh;
}
sub doDefine {
${$_[0]} = 'new';
}
sub doComment {
${$_[0]} = 'comment';
}
sub doCR {
print "\n";
}
sub doDup {
push @stack, $stack[-1] if @stack
}
sub doDrop {
pop @stack;
}
sub doFBranch {
my $skip = pop @stack;
my $test = pop @stack;
${$_[0]} = $skip if ! $test;
}
sub doBranch {
${$_[0]} = pop @stack;
}
sub doEmit {
print chr $_[0];
}
Note that there is very little error checking. In particular there is essentially no checking for stack underflow!
Adding a few more primitive words would make many things easier and there is important stuff just plain missing. However, there is enough in that primitive kernel to make quite a start along to road to conquering the world. Now to write an Ook! interpreter using it. ;)
True laziness is hard work
|
Re: Perl Forth interpreter
by gwadej (Chaplain) on May 29, 2009 at 12:53 UTC
|
As an old Forth programmer, I'm happy to see this. Although, I probably would have done the core loop much differently.
Forth normally reads the input stream one word (\S+) at a time. This allows immediate words (like '"', '."', ':', and '(') to read the input directly instead of delegating that to the input function. This also allows removal of the state logic in dispatch.
If I remember correctly, the first Forth I learned on had about a dozen words defined in assembly and the rest were defined in Forth. Your experiment reminds me of how little it took to get a beginning Forth system up and running.
Thanks for the memories.<grin/>
| [reply] |
|
|
It was very largely for the memories that I did it! And yes, the inner loop is not right at all, but I'd forgotten almost as much about Forth as I once knew. If I were starting over I'd do it differently. :-D
Major deficiencies are that it doesn't provide dictionary management, it doesn't manage compile/interpret switching properly, it doesn't facilitate variables, ...
True laziness is hard work
| [reply] |
Re: Perl Forth interpreter
by ambrus (Abbot) on Jun 01, 2009 at 08:03 UTC
|
Okay, another question. If I enter
1 10 100 + . CR
why does the interpreter print 1 instead of 110?
| [reply]
[d/l] |
|
|
| [reply]
[d/l]
[select] |
Re: Perl Forth interpreter
by Anonymous Monk on May 29, 2009 at 05:44 UTC
|
Where are the first three? I'd really love to see the evolution of this... :) Language::PGForth | [reply] |
|
|
| [reply] |
Re: Perl Forth interpreter
by ambrus (Abbot) on May 30, 2009 at 10:52 UTC
|
| [reply] |
|
|
Define 'interesting'. A 'Hello world' session could look like:
: hi ." Hello world " . CR ;
hi
Hello world
with text you type in blue and the interpreter's output in black.
True laziness is hard work
| [reply] |
Re: Perl Forth interpreter
by metaperl (Curate) on Apr 28, 2011 at 14:58 UTC
|
| [reply] |
Re: Perl Forth interpreter
by Anonymous Monk on Apr 27, 2011 at 16:08 UTC
|
| [reply] |
Re: Perl Forth interpreter
by sundialsvc4 (Abbot) on Apr 30, 2011 at 13:15 UTC
|
I once did a “compiled Forth” on an Apple-II (knock-off) computer and ... much to my surprise ... the damn thing actually worked. (Instead of running through a TIL dispatcher-loop, it generated M6502 subroutines in-line.) As I recall, I did about thirty words in assembler before the “Frankenstein moment” happened. (“It’s a-live! It’s a-live!! Bwa-ha-ha-ha-hahaha!”) :*} Uhh, okay... nevermind... so you really had to be there, I guess ...
| |
|
|
| [reply] |
|
|
