Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Perl Forth interpreter

by GrandFather (Saint)
on May 29, 2009 at 01:09 UTC ( [id://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 Anonymous Monk on Apr 27, 2011 at 16:08 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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
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?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (4)
As of 2025-06-17 02:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.