Merge pull request #400 from asarhaddon/improve-mal-impl-macro-no-meta
[jackhill/mal.git] / 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
154func mal_nth(a)
155{
156 index = a(2)->val
157 if (index >= count(*a(1))) return MalError(message="nth: index out of range")
158 return *((*(a(1)->val))(index + 1))
159}
160
161func mal_first(a)
162{
163 if (structof(*a(1)) == MalNil || count(*a(1)) == 0) return MAL_NIL
164 return *((*(a(1)->val))(1))
165}
166
167func mal_rest(a)
168{
169 if (structof(*a(1)) == MalNil) return MalList(val=&[])
170 return rest(*a(1))
171}
172
173func mal_empty_q(a) { return new_boolean((structof(*a(1)) == MalNil ? 1 : count(*a(1)) == 0)); }
174func mal_count(a) { return MalNumber(val=(structof(*a(1)) == MalNil ? 0 : count(*a(1)))); }
175
176func call_func(fn, args)
177{
178 if (structof(fn) == MalNativeFunction) {
179 return call_core_fn(fn.val, args)
180 } else if (structof(fn) == MalFunction) {
181 fn_env = env_new(fn.env, binds=*fn.binds, exprs=args)
182 return EVAL(*fn.ast, fn_env)
183 } else {
184 return MalError(message="Unknown function type")
185 }
186}
187
188func mal_apply(a) {
189 mid_args = numberof(a) > 2 ? a(2:-1) : []
190 return call_func(*a(1), grow(mid_args, *(a(0)->val)))
191}
192
193func mal_map(a) {
194 fn = *a(1)
195 seq = *(a(2)->val)
196 if (numberof(seq) == 0) return MalList(val=&[])
197 new_seq = array(pointer, numberof(seq))
198 for (i = 1; i <= numberof(seq); ++i) {
199 new_val = call_func(fn, [seq(i)])
200 if (structof(new_val) == MalError) return new_val
201 new_seq(i) = &new_val
202 }
203 return MalList(val=&new_seq)
204}
205
206func mal_conj(a)
207{
208 obj = *a(1)
209 type = structof(obj)
210 if (type == MalList) {
211 res = obj
212 for (i = 2; i <= numberof(a); ++i) {
213 res = mal_cons([a(i), &res])
214 }
215 return res
216 } else if (type == MalVector) {
217 seq = *obj.val
218 grow, seq, a(2:)
219 return MalVector(val=&seq)
220 } else {
221 return MalError(message="conj requires list or vector")
222 }
223}
224
225func mal_seq(a)
226{
227 obj = *a(1)
228 type = structof(obj)
229 if (type == MalString) {
230 len = strlen(obj.val)
231 if (len == 0) return MAL_NIL
232 seq = array(pointer, len)
233 for (i = 1; i <= len; ++i) {
234 seq(i) = &MalString(val=strpart(obj.val, i:i))
235 }
236 return MalList(val=&seq)
237 } else if (type == MalList) {
238 return count(obj) == 0 ? MAL_NIL : obj
239 } else if (type == MalVector) {
240 return count(obj) == 0 ? MAL_NIL : MalList(val=obj.val)
241 } else if (type == MalNil) {
242 return MAL_NIL
243 } else {
244 return MalError(message="seq requires string or list or vector or nil")
245 }
246}
247
248func mal_meta(a)
249{
250 meta_obj = *(a(1)->meta)
251 return is_void(meta_obj) ? MAL_NIL : meta_obj
252}
253
254func mal_with_meta(a)
255{
256 new_obj = *a(1)
257 new_obj.meta = a(2)
258 return new_obj
259}
260
261func mal_atom(a) { return MalAtom(val=&MalAtomVal(val=a(1))); }
262func mal_atom_q(a) { return new_boolean(structof(*a(1)) == MalAtom); }
263func mal_deref(a) { return *(a(1)->val->val); }
264func mal_reset_bang(a) { a(1)->val->val = a(2); return *(a(1)->val->val); }
265func mal_swap_bang(a)
266{
267 old_val = mal_deref([a(1)])
268 args = array(pointer, numberof(a) - 1)
269 args(1) = &old_val
270 if (numberof(a) > 2) args(2:) = a(3:)
271 new_val = call_func(*a(2), args)
272 if (structof(new_val) == MalError) return new_val
273 return mal_reset_bang([a(1), &new_val])
274}
275
276func mal_eval(a) { return EVAL(*a(1), repl_env); }
277
c81a869e
DM
278func yorick_to_mal(e)
279{
280 if (is_void(e)) return MAL_NIL
281 if (is_scalar(e)) {
282 if (is_numerical(e)) return MalNumber(val=e)
283 else if (is_string(e)) return MalString(val=e)
284 else return MalString(val=totxt(e))
285 } else {
286 seq = array(pointer, numberof(e))
287 for (i = 1; i <= numberof(e); ++i) {
288 seq(i) = &yorick_to_mal(e(i))
289 }
290 return MalList(val=&seq)
291 }
292}
293
294func mal_yorick_eval(a) { return yorick_to_mal(exec(a(1)->val)); }
295
21986733
DM
296core_ns = h_new()
297
298h_set, core_ns, "=", mal_equal
299h_set, core_ns, "throw", mal_throw
300
301h_set, core_ns, "nil?", mal_nil_q
302h_set, core_ns, "true?", mal_true_q
303h_set, core_ns, "false?", mal_false_q
304h_set, core_ns, "string?", mal_string_q
305h_set, core_ns, "symbol", mal_symbol
306h_set, core_ns, "symbol?", mal_symbol_q
307h_set, core_ns, "keyword", mal_keyword
308h_set, core_ns, "keyword?", mal_keyword_q
7cecb87a
DM
309h_set, core_ns, "number?", mal_number_q
310h_set, core_ns, "fn?", mal_fn_q
311h_set, core_ns, "macro?", mal_macro_q
21986733
DM
312
313h_set, core_ns, "pr-str", mal_pr_str
314h_set, core_ns, "str", mal_str
315h_set, core_ns, "prn", mal_prn
316h_set, core_ns, "println", mal_println
317h_set, core_ns, "read-string", mal_read_string
318h_set, core_ns, "readline", mal_readline
319h_set, core_ns, "slurp", mal_slurp
320
321h_set, core_ns, "<", mal_lt
322h_set, core_ns, "<=", mal_lte
323h_set, core_ns, ">", mal_gt
324h_set, core_ns, ">=", mal_gte
325h_set, core_ns, "+", mal_add
326h_set, core_ns, "-", mal_sub
327h_set, core_ns, "*", mal_mul
328h_set, core_ns, "/", mal_div
329h_set, core_ns, "time-ms", mal_time_ms
330
331h_set, core_ns, "list", mal_list
332h_set, core_ns, "list?", mal_list_q
333h_set, core_ns, "vector", mal_vector
334h_set, core_ns, "vector?", mal_vector_q
335h_set, core_ns, "hash-map", mal_hash_map
336h_set, core_ns, "map?", mal_map_q
337h_set, core_ns, "assoc", mal_assoc
338h_set, core_ns, "dissoc", mal_dissoc
339h_set, core_ns, "get", mal_get
340h_set, core_ns, "contains?", mal_contains_q
341h_set, core_ns, "keys", mal_keys
342h_set, core_ns, "vals", mal_vals
343
344h_set, core_ns, "sequential?", mal_sequential_q
345h_set, core_ns, "cons", mal_cons
346h_set, core_ns, "concat", mal_concat
347h_set, core_ns, "nth", mal_nth
348h_set, core_ns, "first", mal_first
349h_set, core_ns, "rest", mal_rest
350h_set, core_ns, "empty?", mal_empty_q
351h_set, core_ns, "count", mal_count
352h_set, core_ns, "apply", mal_apply
353h_set, core_ns, "map", mal_map
354
355h_set, core_ns, "conj", mal_conj
356h_set, core_ns, "seq", mal_seq
357
358h_set, core_ns, "meta", mal_meta
359h_set, core_ns, "with-meta", mal_with_meta
360h_set, core_ns, "atom", mal_atom
361h_set, core_ns, "atom?", mal_atom_q
362h_set, core_ns, "deref", mal_deref
363h_set, core_ns, "reset!", mal_reset_bang
364h_set, core_ns, "swap!", mal_swap_bang
365
366h_set, core_ns, "eval", mal_eval
c81a869e 367h_set, core_ns, "yorick-eval", mal_yorick_eval
21986733
DM
368
369func call_core_fn(name, args_list)
370{
371 f = h_get(core_ns, name)
372 return f(args_list)
373}