Change quasiquote algorithm
[jackhill/mal.git] / impls / yorick / core.i
CommitLineData
21986733
DM
1require, "types.i"
2
3func mal_equal(a) { return new_boolean(equal(*a(1), *a(2))); }
4func mal_throw(a) { return MalError(obj=a(1)); }
5
6func mal_nil_q(a) { return new_boolean(structof(*a(1)) == MalNil); }
7func mal_true_q(a) { return new_boolean(structof(*a(1)) == MalTrue); }
8func mal_false_q(a) { return new_boolean(structof(*a(1)) == MalFalse); }
9func mal_string_q(a) { return new_boolean(structof(*a(1)) == MalString); }
10func mal_symbol(a) { return MalSymbol(val=a(1)->val); }
11func mal_symbol_q(a) { return new_boolean(structof(*a(1)) == MalSymbol); }
12func mal_keyword(a) { return MalKeyword(val=a(1)->val); }
13func mal_keyword_q(a) { return new_boolean(structof(*a(1)) == MalKeyword); }
7cecb87a
DM
14func mal_number_q(a) { return new_boolean(structof(*a(1)) == MalNumber); }
15func mal_fn_q(a)
16{
17 if (structof(*a(1)) == MalNativeFunction) return MAL_TRUE;
18 return new_boolean(structof(*a(1)) == MalFunction && !a(1)->macro);
19}
20func mal_macro_q(a) { return new_boolean(structof(*a(1)) == MalFunction && a(1)->macro); }
21986733
DM
21
22func string_helper(a, delimiter, readable)
23{
24 res = ""
25 for (i = 1; i <= numberof(a); ++i) {
26 if (i > 1) res += delimiter
27 res += pr_str(*a(i), readable)
28 }
29 return res
30}
31
32func mal_pr_str(a) { return MalString(val=string_helper(a, " ", 1)); }
33func mal_str(a) { return MalString(val=string_helper(a, "", 0)); }
34func mal_prn(a) { write, format="%s\n", string_helper(a, " ", 1); return MAL_NIL; }
35func mal_println(a) { write, format="%s\n", string_helper(a, " ", 0); return MAL_NIL; }
36func mal_read_string(a) { return read_str(a(1)->val); }
37
38func mal_readline(a)
39{
40 extern stdin_file
6c4cc8ad 41 stdin_file = open("/dev/stdin", "r")
21986733
DM
42 write, format="%s", a(1)->val
43 line = rdline(stdin_file, prompt="")
44 return line ? MalString(val=line) : MAL_NIL
45}
46
47func mal_slurp(a)
48{
49 f = open(a(1)->val)
50 lines = rdfile(f)
51 close, f
52 s = ""
53 for (i = 1; i <= numberof(lines); ++i) {
54 s += (lines(i) + "\n")
55 }
56 return MalString(val=s)
57}
58
59func mal_lt(a) { return new_boolean(a(1)->val < a(2)->val); }
60func mal_lte(a) { return new_boolean(a(1)->val <= a(2)->val); }
61func mal_gt(a) { return new_boolean(a(1)->val > a(2)->val); }
62func mal_gte(a) { return new_boolean(a(1)->val >= a(2)->val); }
63
64func mal_add(a) { return MalNumber(val=(a(1)->val + a(2)->val)); }
65func mal_sub(a) { return MalNumber(val=(a(1)->val - a(2)->val)); }
66func mal_mul(a) { return MalNumber(val=(a(1)->val * a(2)->val)); }
67func mal_div(a) { return MalNumber(val=(a(1)->val / a(2)->val)); }
68
69func mal_time_ms(a)
70{
71 elapsed = array(double, 3)
72 timer, elapsed
73 return MalNumber(val=floor(elapsed(3) * 1000))
74}
75
76func mal_list(a) { return MalList(val=&a); }
77func mal_list_q(a) { return new_boolean(structof(*a(1)) == MalList); }
78func mal_vector(a) { return MalVector(val=&a); }
79func mal_vector_q(a) { return new_boolean(structof(*a(1)) == MalVector); }
80func mal_hash_map(a) { return array_to_hashmap(a); }
81func mal_map_q(a) { return new_boolean(structof(*a(1)) == MalHashmap); }
82
83func mal_assoc(a) {
84 h = *(a(1)->val)
85 k1 = *h.keys
86 v1 = *h.vals
87 new_h = Hash(keys=&k1, vals=&v1)
88 for (i = 2; i <= numberof(a); i += 2) {
89 hash_set, new_h, hashmap_obj_to_key(*a(i)), *a(i + 1)
90 }
91 return MalHashmap(val=&new_h);
92}
93
94func mal_dissoc(a) {
95 h = *(a(1)->val)
96 k1 = *h.keys
97 v1 = *h.vals
98 new_h = Hash(keys=&k1, vals=&v1)
99 for (i = 2; i <= numberof(a); ++i) {
100 hash_delete, new_h, hashmap_obj_to_key(*a(i))
101 }
102 return MalHashmap(val=&new_h);
103}
104
105func mal_get(a) {
106 if (structof(*a(1)) == MalNil) return MAL_NIL
107 h = *(a(1)->val)
108 key_obj = *a(2)
109 val = hash_get(h, hashmap_obj_to_key(key_obj))
110 return is_void(val) ? MAL_NIL : val
111}
112
113func mal_contains_q(a) {
114 if (structof(*a(1)) == MalNil) return MAL_FALSE
115 h = *(a(1)->val)
116 key_obj = *a(2)
117 return hash_has_key(h, hashmap_obj_to_key(key_obj)) ? MAL_TRUE : MAL_FALSE
118}
119
120func mal_keys(a) {
121 keys_strs = *(a(1)->val->keys)
122 if (numberof(keys_strs) == 0) return MalList(val=&[])
123 res = array(pointer, numberof(keys_strs))
124 for (i = 1; i <= numberof(keys_strs); ++i) {
125 res(i) = &hashmap_key_to_obj(keys_strs(i))
126 }
127 return MalList(val=&res);
128}
129
130func mal_vals(a) { return MalList(val=a(1)->val->vals); }
131
132func mal_sequential_q(a) { return new_boolean(structof(*a(1)) == MalList || structof(*a(1)) == MalVector); }
133
134func mal_cons(a)
135{
136 a2_len = count(*a(2))
137 seq = array(pointer, a2_len + 1)
138 seq(1) = a(1)
139 if (a2_len > 0) {
140 seq(2:) = *(a(2)->val)
141 }
142 return MalList(val=&seq)
143}
144
145func mal_concat(a)
146{
147 seq = []
148 for (i = 1; i <= numberof(a); ++i) {
149 grow, seq, *(a(i)->val)
150 }
151 return MalList(val=&seq)
152}
153
fbfe6784
NB
154func mal_vec(a)
155{
156 if (numberof(a) == 1) {
157 type = structof(*a(1))
158 if (type == MalVector) return *(a(1))
159 if (type == MalList) return MalVector(val=a(1)->val)
160 }
161 return MalError(message="vec: requires a sequence")
162}
163
21986733
DM
164func mal_nth(a)
165{
166 index = a(2)->val
167 if (index >= count(*a(1))) return MalError(message="nth: index out of range")
168 return *((*(a(1)->val))(index + 1))
169}
170
171func mal_first(a)
172{
173 if (structof(*a(1)) == MalNil || count(*a(1)) == 0) return MAL_NIL
174 return *((*(a(1)->val))(1))
175}
176
177func mal_rest(a)
178{
179 if (structof(*a(1)) == MalNil) return MalList(val=&[])
180 return rest(*a(1))
181}
182
183func mal_empty_q(a) { return new_boolean((structof(*a(1)) == MalNil ? 1 : count(*a(1)) == 0)); }
184func mal_count(a) { return MalNumber(val=(structof(*a(1)) == MalNil ? 0 : count(*a(1)))); }
185
186func call_func(fn, args)
187{
188 if (structof(fn) == MalNativeFunction) {
189 return call_core_fn(fn.val, args)
190 } else if (structof(fn) == MalFunction) {
191 fn_env = env_new(fn.env, binds=*fn.binds, exprs=args)
192 return EVAL(*fn.ast, fn_env)
193 } else {
194 return MalError(message="Unknown function type")
195 }
196}
197
198func mal_apply(a) {
199 mid_args = numberof(a) > 2 ? a(2:-1) : []
200 return call_func(*a(1), grow(mid_args, *(a(0)->val)))
201}
202
203func mal_map(a) {
204 fn = *a(1)
205 seq = *(a(2)->val)
206 if (numberof(seq) == 0) return MalList(val=&[])
207 new_seq = array(pointer, numberof(seq))
208 for (i = 1; i <= numberof(seq); ++i) {
209 new_val = call_func(fn, [seq(i)])
210 if (structof(new_val) == MalError) return new_val
211 new_seq(i) = &new_val
212 }
213 return MalList(val=&new_seq)
214}
215
216func mal_conj(a)
217{
218 obj = *a(1)
219 type = structof(obj)
220 if (type == MalList) {
221 res = obj
222 for (i = 2; i <= numberof(a); ++i) {
223 res = mal_cons([a(i), &res])
224 }
225 return res
226 } else if (type == MalVector) {
227 seq = *obj.val
228 grow, seq, a(2:)
229 return MalVector(val=&seq)
230 } else {
231 return MalError(message="conj requires list or vector")
232 }
233}
234
235func mal_seq(a)
236{
237 obj = *a(1)
238 type = structof(obj)
239 if (type == MalString) {
240 len = strlen(obj.val)
241 if (len == 0) return MAL_NIL
242 seq = array(pointer, len)
243 for (i = 1; i <= len; ++i) {
244 seq(i) = &MalString(val=strpart(obj.val, i:i))
245 }
246 return MalList(val=&seq)
247 } else if (type == MalList) {
248 return count(obj) == 0 ? MAL_NIL : obj
249 } else if (type == MalVector) {
250 return count(obj) == 0 ? MAL_NIL : MalList(val=obj.val)
251 } else if (type == MalNil) {
252 return MAL_NIL
253 } else {
254 return MalError(message="seq requires string or list or vector or nil")
255 }
256}
257
258func mal_meta(a)
259{
260 meta_obj = *(a(1)->meta)
261 return is_void(meta_obj) ? MAL_NIL : meta_obj
262}
263
264func mal_with_meta(a)
265{
266 new_obj = *a(1)
267 new_obj.meta = a(2)
268 return new_obj
269}
270
271func mal_atom(a) { return MalAtom(val=&MalAtomVal(val=a(1))); }
272func mal_atom_q(a) { return new_boolean(structof(*a(1)) == MalAtom); }
273func mal_deref(a) { return *(a(1)->val->val); }
274func mal_reset_bang(a) { a(1)->val->val = a(2); return *(a(1)->val->val); }
275func mal_swap_bang(a)
276{
277 old_val = mal_deref([a(1)])
278 args = array(pointer, numberof(a) - 1)
279 args(1) = &old_val
280 if (numberof(a) > 2) args(2:) = a(3:)
281 new_val = call_func(*a(2), args)
282 if (structof(new_val) == MalError) return new_val
283 return mal_reset_bang([a(1), &new_val])
284}
285
286func mal_eval(a) { return EVAL(*a(1), repl_env); }
287
c81a869e
DM
288func yorick_to_mal(e)
289{
290 if (is_void(e)) return MAL_NIL
291 if (is_scalar(e)) {
292 if (is_numerical(e)) return MalNumber(val=e)
293 else if (is_string(e)) return MalString(val=e)
294 else return MalString(val=totxt(e))
295 } else {
296 seq = array(pointer, numberof(e))
297 for (i = 1; i <= numberof(e); ++i) {
298 seq(i) = &yorick_to_mal(e(i))
299 }
300 return MalList(val=&seq)
301 }
302}
303
304func mal_yorick_eval(a) { return yorick_to_mal(exec(a(1)->val)); }
305
21986733
DM
306core_ns = h_new()
307
308h_set, core_ns, "=", mal_equal
309h_set, core_ns, "throw", mal_throw
310
311h_set, core_ns, "nil?", mal_nil_q
312h_set, core_ns, "true?", mal_true_q
313h_set, core_ns, "false?", mal_false_q
314h_set, core_ns, "string?", mal_string_q
315h_set, core_ns, "symbol", mal_symbol
316h_set, core_ns, "symbol?", mal_symbol_q
317h_set, core_ns, "keyword", mal_keyword
318h_set, core_ns, "keyword?", mal_keyword_q
7cecb87a
DM
319h_set, core_ns, "number?", mal_number_q
320h_set, core_ns, "fn?", mal_fn_q
321h_set, core_ns, "macro?", mal_macro_q
21986733
DM
322
323h_set, core_ns, "pr-str", mal_pr_str
324h_set, core_ns, "str", mal_str
325h_set, core_ns, "prn", mal_prn
326h_set, core_ns, "println", mal_println
327h_set, core_ns, "read-string", mal_read_string
328h_set, core_ns, "readline", mal_readline
329h_set, core_ns, "slurp", mal_slurp
330
331h_set, core_ns, "<", mal_lt
332h_set, core_ns, "<=", mal_lte
333h_set, core_ns, ">", mal_gt
334h_set, core_ns, ">=", mal_gte
335h_set, core_ns, "+", mal_add
336h_set, core_ns, "-", mal_sub
337h_set, core_ns, "*", mal_mul
338h_set, core_ns, "/", mal_div
339h_set, core_ns, "time-ms", mal_time_ms
340
341h_set, core_ns, "list", mal_list
342h_set, core_ns, "list?", mal_list_q
343h_set, core_ns, "vector", mal_vector
344h_set, core_ns, "vector?", mal_vector_q
345h_set, core_ns, "hash-map", mal_hash_map
346h_set, core_ns, "map?", mal_map_q
347h_set, core_ns, "assoc", mal_assoc
348h_set, core_ns, "dissoc", mal_dissoc
349h_set, core_ns, "get", mal_get
350h_set, core_ns, "contains?", mal_contains_q
351h_set, core_ns, "keys", mal_keys
352h_set, core_ns, "vals", mal_vals
353
354h_set, core_ns, "sequential?", mal_sequential_q
355h_set, core_ns, "cons", mal_cons
356h_set, core_ns, "concat", mal_concat
fbfe6784 357h_set, core_ns, "vec", mal_vec
21986733
DM
358h_set, core_ns, "nth", mal_nth
359h_set, core_ns, "first", mal_first
360h_set, core_ns, "rest", mal_rest
361h_set, core_ns, "empty?", mal_empty_q
362h_set, core_ns, "count", mal_count
363h_set, core_ns, "apply", mal_apply
364h_set, core_ns, "map", mal_map
365
366h_set, core_ns, "conj", mal_conj
367h_set, core_ns, "seq", mal_seq
368
369h_set, core_ns, "meta", mal_meta
370h_set, core_ns, "with-meta", mal_with_meta
371h_set, core_ns, "atom", mal_atom
372h_set, core_ns, "atom?", mal_atom_q
373h_set, core_ns, "deref", mal_deref
374h_set, core_ns, "reset!", mal_reset_bang
375h_set, core_ns, "swap!", mal_swap_bang
376
377h_set, core_ns, "eval", mal_eval
c81a869e 378h_set, core_ns, "yorick-eval", mal_yorick_eval
21986733
DM
379
380func call_core_fn(name, args_list)
381{
382 f = h_get(core_ns, name)
383 return f(args_list)
384}