impls/perl6/step7_quote.pl

   1 use v6;
   2 use lib IO::Path.new($?FILE).dirname;
   3 use reader;
   4 use printer;
   5 use types;
   6 use env;
   7 use core;
   8
   9 sub read ($str) {
  10   return read_str($str);
  11 }
  12
  13 sub eval_ast ($ast, $env) {
  14   given $ast {
  15     when MalSymbol  { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) }
  16     when MalList    { MalList([$ast.map({ eval($_, $env) })]) }
  17     when MalVector  { MalVector([$ast.map({ eval($_, $env) })]) }
  18     when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) }
  19     default         { $ast // $NIL }
  20   }
  21 }
  22
  23 sub is_pair ($ast) {
  24   return so $ast ~~ MalList|MalVector && $ast.elems;
  25 }
  26
  27 sub quasiquote ($ast) {
  28   if !is_pair($ast) {
  29     return MalList([MalSymbol('quote'), $ast]);
  30   }
  31   elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' {
  32     return $ast[1];
  33   }
  34   elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' {
  35     return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]);
  36   }
  37   else {
  38     return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]);
  39   }
  40 }
  41
  42 sub eval ($ast is copy, $env is copy) {
  43   loop {
  44     return eval_ast($ast, $env) if $ast !~~ MalList;
  45     return $ast if !$ast.elems;
  46
  47     my ($a0, $a1, $a2, $a3) = $ast.val;
  48     given $a0.val {
  49       when 'def!' {
  50         return $env.set($a1.val, eval($a2, $env));
  51       }
  52       when 'let*' {
  53         my $new_env = MalEnv.new($env);
  54         for |$a1.val -> $key, $value {
  55           $new_env.set($key.val, eval($value, $new_env));
  56         }
  57         $env = $new_env;
  58         $ast = $a2;
  59       }
  60       when 'do' {
  61         eval_ast(MalList([$ast[1..*-2]]), $env);
  62         $ast = $ast[*-1];
  63       }
  64       when 'if' {
  65         if eval($a1, $env) ~~ MalNil|MalFalse {
  66           return $NIL if $a3 ~~ $NIL;
  67           $ast = $a3;
  68         }
  69         else {
  70           $ast = $a2;
  71         }
  72       }
  73       when 'fn*' {
  74         my @binds = $a1 ?? $a1.map(*.val) !! ();
  75         my &fn = -> *@args {
  76           eval($a2, MalEnv.new($env, @binds, @args));
  77         };
  78         return MalFunction($a2, $env, @binds, &fn);
  79       }
  80       when 'quote' { return $a1 }
  81       when 'quasiquote' { $ast = quasiquote($a1) }
  82       default {
  83         my ($func, @args) = eval_ast($ast, $env).val;
  84         return $func.apply(|@args) if $func !~~ MalFunction;
  85         $ast = $func.ast;
  86         $env = MalEnv.new($func.env, $func.params, @args);
  87       }
  88     }
  89   }
  90 }
  91
  92 sub print ($exp) {
  93   return pr_str($exp, True);
  94 }
  95
  96 my $repl_env = MalEnv.new;
  97
  98 sub rep ($str) {
  99   return print(eval(read($str), $repl_env));
 100 }
 101
 102 sub MAIN ($source_file?, *@args) {
 103   $repl_env.set(.key, .value) for %core::ns;
 104   $repl_env.set('eval', MalCode({ eval($^a, $repl_env) }));
 105   $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })]));
 106   rep(q{(def! not (fn* (a) (if a false true)))});
 107   rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))});
 108
 109   if ($source_file.defined) {
 110     rep("(load-file \"$source_file\")");
 111     exit;
 112   }
 113
 114   while (my $line = prompt 'user> ').defined {
 115     say rep($line);
 116     CATCH {
 117       when X::MalException { .Str.say }
 118     }
 119   }
 120 }