perl6/step8_macros.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 is_macro_call ($ast, $env) {
  43   return so $ast ~~ MalList && $ast[0] ~~ MalSymbol
  44     && $env.find($ast[0].val).?get($ast[0].val).?is_macro;
  45 }
  46
  47 sub macroexpand ($ast is copy, $env is copy) {
  48   while is_macro_call($ast, $env) {
  49     my $func = $env.get($ast[0].val);
  50     $ast = $func.apply($ast[1..*]);
  51   }
  52   return $ast;
  53 }
  54
  55 sub eval ($ast is copy, $env is copy) {
  56   loop {
  57     return eval_ast($ast, $env) if $ast !~~ MalList;
  58     $ast = macroexpand($ast, $env);
  59     return eval_ast($ast, $env) if $ast !~~ MalList;
  60     return $ast if !$ast.elems;
  61
  62     my ($a0, $a1, $a2, $a3) = $ast.val;
  63     given $a0.val {
  64       when 'def!' {
  65         return $env.set($a1.val, eval($a2, $env));
  66       }
  67       when 'let*' {
  68         my $new_env = MalEnv.new($env);
  69         for |$a1.val -> $key, $value {
  70           $new_env.set($key.val, eval($value, $new_env));
  71         }
  72         $env = $new_env;
  73         $ast = $a2;
  74       }
  75       when 'do' {
  76         eval_ast(MalList([$ast[1..*-2]]), $env);
  77         $ast = $ast[*-1];
  78       }
  79       when 'if' {
  80         if eval($a1, $env) ~~ MalNil|MalFalse {
  81           return $NIL if $a3 ~~ $NIL;
  82           $ast = $a3;
  83         }
  84         else {
  85           $ast = $a2;
  86         }
  87       }
  88       when 'fn*' {
  89         my @binds = $a1 ?? $a1.map(*.val) !! ();
  90         my &fn = -> *@args {
  91           eval($a2, MalEnv.new($env, @binds, @args));
  92         };
  93         return MalFunction($a2, $env, @binds, &fn);
  94       }
  95       when 'quote' { return $a1 }
  96       when 'quasiquote' { $ast = quasiquote($a1) }
  97       when 'defmacro!' {
  98         my $func = eval($a2, $env);
  99         $func.is_macro = True;
 100         return $env.set($a1.val, $func);
 101       }
 102       when 'macroexpand' { return macroexpand($a1, $env) }
 103       default {
 104         my ($func, @args) = eval_ast($ast, $env).val;
 105         return $func.apply(|@args) if $func !~~ MalFunction;
 106         $ast = $func.ast;
 107         $env = MalEnv.new($func.env, $func.params, @args);
 108       }
 109     }
 110   }
 111 }
 112
 113 sub print ($exp) {
 114   return pr_str($exp, True);
 115 }
 116
 117 my $repl_env = MalEnv.new;
 118
 119 sub rep ($str) {
 120   return print(eval(read($str), $repl_env));
 121 }
 122
 123 sub MAIN ($source_file?, *@args) {
 124   $repl_env.set(.key, .value) for %core::ns;
 125   $repl_env.set('eval', MalCode({ eval($^a, $repl_env) }));
 126   $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })]));
 127   rep(q{(def! not (fn* (a) (if a false true)))});
 128   rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))});
 129   rep(q{(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))});
 130
 131   if ($source_file.defined) {
 132     rep("(load-file \"$source_file\")");
 133     exit;
 134   }
 135
 136   while (my $line = prompt 'user> ').defined {
 137     say rep($line);
 138     CATCH {
 139       when X::MalException { .Str.say }
 140     }
 141   }
 142 }