Commit | Line | Data |
---|---|---|
a7081401 HÖS |
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 | 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 | ||
123 | sub print ($exp) { | |
124 | return pr_str($exp, True); | |
125 | } | |
126 | ||
127 | my $repl_env = MalEnv.new; | |
128 | ||
129 | sub rep ($str) { | |
130 | return print(eval(read($str), $repl_env)); | |
131 | } | |
132 | ||
133 | sub 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 | } |