Commit | Line | Data |
---|---|---|
4eb88ef2 DM |
1 | load "../logo/readline.lg |
2 | load "../logo/reader.lg | |
3 | load "../logo/printer.lg | |
4 | load "../logo/types.lg | |
5 | load "../logo/env.lg | |
6 | load "../logo/core.lg | |
7 | ||
8 | to _read :str | |
9 | output read_str :str | |
10 | end | |
11 | ||
fbfe6784 NB |
12 | to starts_with :ast :sym |
13 | if (obj_type :ast) <> "list [output "false] | |
14 | localmake "xs obj_val :ast | |
15 | if emptyp :xs [output "false] | |
16 | localmake "a0 first :xs | |
17 | output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) | |
4eb88ef2 DM |
18 | end |
19 | ||
20 | to quasiquote :ast | |
fbfe6784 NB |
21 | if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] |
22 | if not sequentialp :ast [output :ast] | |
23 | if starts_with :ast "unquote [output nth :ast 1] | |
24 | localmake "result mal_list | |
25 | foreach reverse obj_val :ast [ | |
26 | ifelse starts_with ? "splice-unquote [ | |
27 | make "result (mal_list symbol_new "concat nth ? 1 :result) | |
28 | ] [ | |
29 | make "result (mal_list symbol_new "cons quasiquote ? :result) | |
30 | ] ] | |
31 | if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] | |
32 | output :result | |
4eb88ef2 DM |
33 | end |
34 | ||
35 | to macrocallp :ast :env | |
36 | if (obj_type :ast) = "list [ | |
37 | if (_count :ast) > 0 [ | |
38 | localmake "a0 nth :ast 0 | |
39 | if (obj_type :a0) = "symbol [ | |
40 | if not emptyp env_find :env :a0 [ | |
41 | localmake "f env_get :env :a0 | |
42 | if (obj_type :f) = "fn [ | |
43 | output fn_is_macro :f | |
44 | ] | |
45 | ] | |
46 | ] | |
47 | ] | |
48 | ] | |
49 | output "false | |
50 | end | |
51 | ||
52 | to _macroexpand :ast :env | |
53 | if not macrocallp :ast :env [output :ast] | |
54 | localmake "a0 nth :ast 0 | |
55 | localmake "f env_get :env :a0 | |
56 | output _macroexpand invoke_fn :f rest :ast :env | |
57 | end | |
58 | ||
59 | to eval_ast :ast :env | |
60 | output case (obj_type :ast) [ | |
61 | [[symbol] env_get :env :ast] | |
62 | [[list] obj_new "list map [_eval ? :env] obj_val :ast] | |
63 | [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] | |
64 | [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] | |
65 | [else :ast] | |
66 | ] | |
67 | end | |
68 | ||
69 | to _eval :a_ast :a_env | |
70 | localmake "ast :a_ast | |
71 | localmake "env :a_env | |
72 | forever [ | |
73 | if (obj_type :ast) <> "list [output eval_ast :ast :env] | |
74 | make "ast _macroexpand :ast :env | |
75 | if (obj_type :ast) <> "list [output eval_ast :ast :env] | |
76 | if emptyp obj_val :ast [output :ast] | |
77 | localmake "a0 nth :ast 0 | |
78 | case list obj_type :a0 obj_val :a0 [ | |
79 | [[[symbol def!]] | |
80 | localmake "a1 nth :ast 1 | |
81 | localmake "a2 nth :ast 2 | |
82 | output env_set :env :a1 _eval :a2 :env ] | |
83 | ||
84 | [[[symbol let*]] | |
85 | localmake "a1 nth :ast 1 | |
86 | localmake "letenv env_new :env [] [] | |
87 | localmake "i 0 | |
88 | while [:i < _count :a1] [ | |
89 | ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv | |
90 | make "i (:i + 2) | |
91 | ] | |
92 | make "env :letenv | |
93 | make "ast nth :ast 2 ] ; TCO | |
94 | ||
95 | [[[symbol quote]] | |
96 | output nth :ast 1 ] | |
97 | ||
98 | [[[symbol quasiquote]] | |
99 | make "ast quasiquote nth :ast 1 ] ; TCO | |
100 | ||
fbfe6784 NB |
101 | [[[symbol quasiquoteexpand]] |
102 | output quasiquote nth :ast 1] | |
103 | ||
4eb88ef2 DM |
104 | [[[symbol defmacro!]] |
105 | localmake "a1 nth :ast 1 | |
106 | localmake "a2 nth :ast 2 | |
107 | localmake "macro_fn _eval :a2 :env | |
108 | fn_set_macro :macro_fn | |
109 | output env_set :env :a1 :macro_fn ] | |
110 | ||
111 | [[[symbol macroexpand]] | |
112 | output _macroexpand nth :ast 1 :env ] | |
113 | ||
114 | [[[symbol do]] | |
115 | localmake "i 1 | |
116 | while [:i < ((_count :ast) - 1)] [ | |
117 | ignore _eval nth :ast :i :env | |
118 | make "i (:i + 1) | |
119 | ] | |
120 | make "ast last obj_val :ast ] ; TCO | |
121 | ||
122 | [[[symbol if]] | |
123 | localmake "a1 nth :ast 1 | |
124 | localmake "cond _eval :a1 :env | |
125 | case obj_type :cond [ | |
126 | [[nil false] ifelse (_count :ast) > 3 [ | |
127 | make "ast nth :ast 3 ; TCO | |
128 | ] [ | |
129 | output nil_new | |
130 | ]] | |
131 | [else make "ast nth :ast 2] ; TCO | |
132 | ]] | |
133 | ||
134 | [[[symbol fn*]] | |
135 | output fn_new nth :ast 1 :env nth :ast 2 ] | |
136 | ||
137 | [else | |
138 | localmake "el eval_ast :ast :env | |
139 | localmake "f nth :el 0 | |
140 | case obj_type :f [ | |
141 | [[nativefn] | |
142 | output apply obj_val :f butfirst obj_val :el ] | |
143 | [[fn] | |
144 | make "env env_new fn_env :f fn_args :f rest :el | |
145 | make "ast fn_body :f ] ; TCO | |
146 | [else | |
147 | (throw "error [Wrong type for apply])] | |
148 | ] ] | |
149 | ] | |
150 | ] | |
151 | end | |
152 | ||
153 | to _print :exp | |
154 | output pr_str :exp "true | |
155 | end | |
156 | ||
157 | to re :str | |
158 | output _eval _read :str :repl_env | |
159 | end | |
160 | ||
161 | to rep :str | |
162 | output _print re :str | |
163 | end | |
164 | ||
165 | to print_exception :exception | |
166 | if not emptyp :exception [ | |
167 | localmake "e first butfirst :exception | |
168 | ifelse :e = "_mal_exception_ [ | |
169 | (print "Error: pr_str :global_exception "false) | |
170 | ] [ | |
171 | (print "Error: :e) | |
172 | ] | |
173 | ] | |
174 | end | |
175 | ||
176 | to repl | |
177 | localmake "running "true | |
178 | while [:running] [ | |
179 | localmake "line readline word "user> :space_char | |
180 | ifelse :line=[] [ | |
181 | print " | |
182 | make "running "false | |
183 | ] [ | |
184 | if not emptyp :line [ | |
185 | catch "error [print rep :line] | |
186 | print_exception error | |
187 | ] | |
188 | ] | |
189 | ] | |
190 | end | |
191 | ||
192 | to mal_eval :a | |
193 | output _eval :a :repl_env | |
194 | end | |
195 | ||
196 | to argv_list | |
197 | localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] | |
198 | output obj_new "list map [obj_new "string ?] :argv | |
199 | end | |
200 | ||
201 | make "repl_env env_new [] [] [] | |
202 | foreach :core_ns [ | |
203 | ignore env_set :repl_env first ? first butfirst ? | |
204 | ] | |
205 | ignore env_set :repl_env [symbol eval] [nativefn mal_eval] | |
206 | ignore env_set :repl_env [symbol *ARGV*] argv_list | |
207 | ||
208 | ; core.mal: defined using the language itself | |
209 | ignore re "|(def! not (fn* (a) (if a false true)))| | |
e6d41de4 | 210 | ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| |
4eb88ef2 | 211 | ignore re "|(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)))))))| |
4eb88ef2 DM |
212 | |
213 | if not emptyp :command.line [ | |
214 | catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] | |
215 | print_exception error | |
216 | bye | |
217 | ] | |
218 | ||
219 | repl | |
220 | bye |