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 qqLoop ($ast) {
  24   my $acc = MalList([]);
  25   for |$ast.val.reverse -> $elt {
  26     if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol
  27       && $elt[0].val eq 'splice-unquote'
  28     {
  29       $acc = MalList([MalSymbol('concat'), $elt[1], $acc]);
  30     }
  31     else {
  32       $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]);
  33     }
  34   }
  35   return $acc;
  36 }
  37
  38 sub quasiquote ($ast) {
  39   given $ast {
  40     when MalList {
  41       if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' {
  42         $ast[1]
  43       } else {
  44         qqLoop($ast);
  45       }
  46     }
  47     when MalVector            { MalList([MalSymbol('vec'), qqLoop($ast)]) }
  48     when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) }
  49     default                   { $ast }
  50   }
  51 }
  52
  53 sub eval ($ast is copy, $env is copy) {
  54   loop {
  55     return eval_ast($ast, $env) if $ast !~~ MalList;
  56     return $ast if !$ast.elems;
  57
  58     my ($a0, $a1, $a2, $a3) = $ast.val;
  59     given $a0.val {
  60       when 'def!' {
  61         return $env.set($a1.val, eval($a2, $env));
  62       }
  63       when 'let*' {
  64         my $new_env = MalEnv.new($env);
  65         for |$a1.val -> $key, $value {
  66           $new_env.set($key.val, eval($value, $new_env));
  67         }
  68         $env = $new_env;
  69         $ast = $a2;
  70       }
  71       when 'do' {
  72         eval_ast(MalList([$ast[1..*-2]]), $env);
  73         $ast = $ast[*-1];
  74       }
  75       when 'if' {
  76         if eval($a1, $env) ~~ MalNil|MalFalse {
  77           return $NIL if $a3 ~~ $NIL;
  78           $ast = $a3;
  79         }
  80         else {
  81           $ast = $a2;
  82         }
  83       }
  84       when 'fn*' {
  85         my @binds = $a1 ?? $a1.map(*.val) !! ();
  86         my &fn = -> *@args {
  87           eval($a2, MalEnv.new($env, @binds, @args));
  88         };
  89         return MalFunction($a2, $env, @binds, &fn);
  90       }
  91       when 'quote' { return $a1 }
  92       when 'quasiquoteexpand' { return quasiquote($a1) }
  93       when 'quasiquote' { $ast = quasiquote($a1) }
  94       default {
  95         my ($func, @args) = eval_ast($ast, $env).val;
  96         return $func.apply(|@args) if $func !~~ MalFunction;
  97         $ast = $func.ast;
  98         $env = MalEnv.new($func.env, $func.params, @args);
  99       }
 100     }
 101   }
 102 }
 103
 104 sub print ($exp) {
 105   return pr_str($exp, True);
 106 }
 107
 108 my $repl_env = MalEnv.new;
 109
 110 sub rep ($str) {
 111   return print(eval(read($str), $repl_env));
 112 }
 113
 114 sub MAIN ($source_file?, *@args) {
 115   $repl_env.set(.key, .value) for %core::ns;
 116   $repl_env.set('eval', MalCode({ eval($^a, $repl_env) }));
 117   $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })]));
 118   rep(q{(def! not (fn* (a) (if a false true)))});
 119   rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))});
 120
 121   if ($source_file.defined) {
 122     rep("(load-file \"$source_file\")");
 123     exit;
 124   }
 125
 126   while (my $line = prompt 'user> ').defined {
 127     say rep($line);
 128     CATCH {
 129       when X::MalException { .Str.say }
 130     }
 131   }
 132 }