Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Perl Forth interpreter

by GrandFather (Sage)
on May 29, 2009 at 01:09 UTC ( #766784=CUFP: print w/replies, xml ) Need Help??

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

Replies are listed 'Best First'.
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/>

    G. Wade

      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
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?

      Because of a bug! The four arithmetic routines should push @stack, ... instead of return ....


      True laziness is hard work
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

      I didn't even glance at CPAN before having a play. Language::PGForth doesn't have many passes and the documentation is a little sparse!


      True laziness is hard work
Re: Perl Forth interpreter
by ambrus (Abbot) on May 30, 2009 at 10:52 UTC

    Could you please show some interesting input code to type into this interpreter?

      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
Re: Perl Forth interpreter
by metaperl (Curate) on Apr 28, 2011 at 14:58 UTC
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 ...

      Uhh, okay... nevermind... so you really had to be there, I guess ...

      I know right, and then it ordered another coffee and went back under the bridge

Re: Perl Forth interpreter
by Anonymous Monk on Apr 27, 2011 at 16:08 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://766784]
Approved by toolic
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (2)
As of 2018-12-14 04:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How many stories does it take before you've heard them all?







    Results (64 votes). Check out past polls.

    Notices?