simple-lispy-interpreter.p6

class Lispy {
    has $.global-env;
    class Env is Associative { # XXX EnumMap
        has %.hash handles *;
        has $.outer;
        method new (*@hash, :$outer) {
            bless self: :$outer, :@hash;
        }
        method get ($k) is rw { self.hash{$k} // self.outer.get($k) }
    }

    method new-env { Env.new(
        'begin' => -> *@x { @x[*-1] },
        'pi' => pi,
        'perl' => { .perl }, # (.lisp NYI)
        outer => class :: {
            has %!cache;
            method get ($k) {
                %!cache{$k} //=
                    $k ~~ /^<[$@%&]>/ ?? try { ::($k) } !!
                    try { ::("&$k") } // try { ::("&infix:<$k>") }
            }
        }.new
    )}

    class Symbol {
        has Str $.Str handles *;
        method new ($Str) { bless self: :$Str }
        method gist { $!Str }
        method perl { "'$!Str" }
    }

    class Procedure is Callable {
        has @.params;
        has $.body;
        has $.env;
        method count { +@.params }
        method arity { +@.params }
        method invoke (\c) {
            eval $!body, env => Env.new((@!params Z c.list), outer => $!env);
        }
    }

    our proto eval (|) {*}
    multi eval (Numeric $n, :$env) { $n }
    multi eval (Symbol $sy, :$env!) is rw { $env.get($sy) // die "no symbol $sy" }
    multi eval (@l, :$env! is rw) {
        my @r := @l[1..*];
        my &evm = { $_ ~~ Positional ?? map { eval $_, :$env }, @$_ !! eval $_, :$env }
        given @l[0] {
            when 'quote' { @r[0] }
            when 'define' {
                $env.hash{@r[0]} = eval @r[1], :$env;
            }
            when 'if' {
                eval :$env, ( eval(:$env, @r[0]) ?? @r[1] !! @r[2] );
            }
            when 'lambda' {
                Procedure.new(params => @r[0], body => @r[1], :$env);
            }
            when 'eval' {
                given eval(@r[0], :$env) -> \r {
                    eval r, :$env;
                }
            }
            default {
                given evm(@l) {
                    die "Error: {.[0]} is not a function" unless .[0] ~~ Callable;
                    .[0](|.[1..*]);
                }
            }
        }
    }

    grammar Parser {
        rule TOP { '' <atom> * }
        token ws { [ \s+ | ';' \N* \n? ]* }
        proto token atom {*}
        rule atom:parens { \( ~ \) <atom> + }
        rule atom:quote  { \' <atom> }
        token atom:number { <[+-]>?\d+[\.\d+]?[<[eE]><[+-]>?\d+]? }
        token atom:symbol { {} <-[()\s]>+ }
    }

    class Actions {
        method TOP ($/) { make map @<atom>: *.ast }
        method atom:parens ($/) { make [@<atom>».ast] }
        method atom:quote  ($/) { make [Symbol.new('quote'), $<atom>.ast] }
        method atom:number ($/) { make +$/ }
        method atom:symbol ($/) { make Symbol.new(~$/) }
    }

    method BUILD (:$!global-env = $.new-env) { }
    method eval ($s) {
        map {eval $_, env => $!global-env},
            (Parser.parse($s, :actions(Actions)).?ast // die "Malformed input")
    }
}

multi MAIN {
    my $L = Lispy.new;
    loop {
        try {
            say $L.eval: prompt('> ');
            CATCH { default { .note } }
        }
    }
}
multi MAIN ($filehandle as IO) {
    Lispy.new.eval: $filehandle.slurp;
}