gistfile1.txt

use v6;

sub simple-intepreter($input) {
    my %defined-words;
    my @stack;
    my $defining = False;

    sub run-words(@words is copy) {
        while $_ = @words.shift {
            if $defining {
                when ";" { $defining = False }
                default  { %defined-words{$defining}.push($_) }
            }

            when /^ \d+ $/      { @stack.push($_.Int) }
            when "."            { say @stack.pop }
            when "dup"          { @stack.push(@stack[*-1]) }
            when "drop"         { @stack.pop }
            when "+"            { @stack.push(@stack.pop + @stack.pop) }
            when "-"            { @stack.push(@stack.pop R- @stack.pop) }
            when "*"            { @stack.push(@stack.pop * @stack.pop) }
            when "/"            { @stack.push(@stack.pop Rdiv @stack.pop) }
            when "mod"          { @stack.push(@stack.pop Rmod @stack.pop) }
            when "max"          { @stack.push(@stack.pop max @stack.pop) }
            when "min"          { @stack.push(@stack.pop min @stack.pop) }
            when "negate"       { @stack[*-1] = -@stack[*-1] }
            when ":"            { $defining = @words.shift }
            when %defined-words { run-words(%defined-words{$_}) }
            default             { die "Unrecognized word $_" }
        }
    }

    run-words($input.words);
    
    @stack
}

multi sub MAIN() {
    my @results = simple-intepreter(slurp());
    say "Ending stack " ~ @results.join(" ");
}

multi sub MAIN("test") {
    use Test;
    is simple-intepreter("1").join(", "), "1", "Just putting a number on the stack works";
    is simple-intepreter("1 2 +").join(", "), "3", "Addition works";
    is simple-intepreter("10 4 -").join(", "), "6", "Subtraction works";
    is simple-intepreter("10 4 *").join(", "), "40", "Multiplication works";
    is simple-intepreter("10 4 /").join(", "), "2", "Division works";
    is simple-intepreter("10 3 mod").join(", "), "1", "Mod works";
    is simple-intepreter("10 3 dup").join(", "), "10, 3, 3", "dup works";
    is simple-intepreter("10 3 drop").join(", "), "10", "drop works";
    is simple-intepreter("10 3 min").join(", "), "3", "min works";
    is simple-intepreter("10 3 max").join(", "), "10", "max works";
    is simple-intepreter("10 3 negate").join(", "), "10, -3", "negate works";
    is simple-intepreter(": 2* 2 * ; 10 2* 23 2*").join(", "), "20, 46", "can define words";
    
    done;
}

This "solution" is purely an interpreter, it just runs the "Forth" code in Perl 6. It doesn't even bother to tokenize, really; if you create a new word, it just stores the list of words in the new word as a list of strings.

I've thought about implementing a Forth in NQP, but haven't gotten around to studying jnthn's presentation on NQP work from last year.