Runtest should fail on bad test data. Fix interop tests.
[jackhill/mal.git] / perl6 / stepA_mal.pl
CommitLineData
a7081401
HÖS
1use v6;
2use lib IO::Path.new($?FILE).dirname;
3use reader;
4use printer;
5use types;
6use env;
7use core;
8
9sub read ($str) {
10 return read_str($str);
11}
12
13sub 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
23sub is_pair ($ast) {
24 return so $ast ~~ MalList|MalVector && $ast.elems;
25}
26
27sub 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
42sub 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
47sub 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
55sub 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 when 'try*' {
104 return eval($a1, $env);
105 CATCH {
dd7a4f55 106 .rethrow if !$a2;
a7081401
HÖS
107 my $ex = $_ ~~ X::MalThrow ?? .value !! MalString(.Str);
108 my $new_env = $env;
109 $env.set($a2[1].val, $ex);
110 return eval($a2[2], $new_env);
111 }
112 }
113 default {
114 my ($func, @args) = eval_ast($ast, $env).val;
115 return $func.apply(|@args) if $func !~~ MalFunction;
116 $ast = $func.ast;
117 $env = MalEnv.new($func.env, $func.params, @args);
118 }
119 }
120 }
121}
122
123sub print ($exp) {
124 return pr_str($exp, True);
125}
126
127my $repl_env = MalEnv.new;
128
129sub rep ($str) {
130 return print(eval(read($str), $repl_env));
131}
132
133sub MAIN ($source_file?, *@args) {
134 $repl_env.set(.key, .value) for %core::ns;
135 $repl_env.set('eval', MalCode({ eval($^a, $repl_env) }));
136 $repl_env.set('*ARGV*', MalList([@args.map({ MalString($_) })]));
137 $repl_env.set('*host-language*', MalString('perl6'));
138 rep(q{(def! not (fn* (a) (if a false true)))});
139 rep(q{(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))});
140 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)))))))});
141 rep(q{(def! *gensym-counter* (atom 0))});
142 rep(q{(def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))});
143 rep(q{(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))});
144
145 if ($source_file.defined) {
146 rep("(load-file \"$source_file\")");
147 exit;
148 }
149 rep(q{(println (str "Mal [" *host-language* "]"))});
150
151 while (my $line = prompt 'user> ').defined {
152 say rep($line);
153 CATCH {
dd7a4f55
JM
154 when X::MalThrow { say "Error: " ~ pr_str(.value, True) }
155 when X::MalException { say "Error: " ~ .Str }
a7081401
HÖS
156 }
157 }
158}