2 bool_new
[equal_q
[lindex $a 0] [lindex $a 1]]
5 set ::mal_exception_obj 0
7 set ::mal_exception_obj [lindex $a 0]
8 error "__MalException__"
12 bool_new
[nil_q
[lindex $a 0]]
16 bool_new
[true_q
[lindex $a 0]]
19 proc mal_false_q
{a
} {
20 bool_new
[false_q
[lindex $a 0]]
24 symbol_new
[obj_val
[lindex $a 0]]
27 proc mal_symbol_q
{a
} {
28 bool_new
[symbol_q
[lindex $a 0]]
31 proc mal_keyword
{a
} {
32 keyword_new
[obj_val
[lindex $a 0]]
35 proc mal_keyword_q
{a
} {
36 bool_new
[keyword_q
[lindex $a 0]]
39 proc render_array
{arr readable delim
} {
42 lappend res
[pr_str
$e $readable]
48 string_new
[render_array
$a 1 " "]
52 string_new
[render_array
$a 0 ""]
56 puts [render_array
$a 1 " "]
60 proc mal_println
{a
} {
61 puts [render_array
$a 0 " "]
65 proc mal_read_string
{a
} {
66 read_str
[obj_val
[lindex $a 0]]
69 proc mal_readline
{a
} {
70 set prompt
[obj_val
[lindex $a 0]]
71 set res
[_readline
$prompt]
72 if {[lindex $res 0] == "EOF"} {
75 string_new
[lindex $res 1]
79 set filename [obj_val
[lindex $a 0]]
80 set file [open $filename]
81 set content
[read $file]
87 bool_new
[expr {[obj_val
[lindex $a 0]] < [obj_val
[lindex $a 1]]}]
91 bool_new
[expr {[obj_val
[lindex $a 0]] <= [obj_val
[lindex $a 1]]}]
95 bool_new
[expr {[obj_val
[lindex $a 0]] > [obj_val
[lindex $a 1]]}]
99 bool_new
[expr {[obj_val
[lindex $a 0]] >= [obj_val
[lindex $a 1]]}]
103 integer_new
[expr {[obj_val
[lindex $a 0]] + [obj_val
[lindex $a 1]]}]
107 integer_new
[expr {[obj_val
[lindex $a 0]] - [obj_val
[lindex $a 1]]}]
111 integer_new
[expr {[obj_val
[lindex $a 0]] * [obj_val
[lindex $a 1]]}]
115 integer_new
[expr {[obj_val
[lindex $a 0]] / [obj_val
[lindex $a 1]]}]
118 proc mal_time_ms
{a
} {
119 integer_new
[clock milliseconds
]
126 proc mal_list_q
{a
} {
127 bool_new
[list_q
[lindex $a 0]]
130 proc mal_vector
{a
} {
134 proc mal_vector_q
{a
} {
135 bool_new
[vector_q
[lindex $a 0]]
138 proc mal_hash_map
{a
} {
141 dict
set d
[obj_val
$k] $v
147 bool_new
[hashmap_q
[lindex $a 0]]
152 dict
for {k v
} [obj_val
[lindex $a 0]] {
155 foreach {k v
} [lrange $a 1 end
] {
156 dict
set d
[obj_val
$k] $v
161 proc mal_dissoc
{a
} {
163 dict
for {k v
} [obj_val
[lindex $a 0]] {
166 foreach k
[lrange $a 1 end
] {
167 dict
unset d
[obj_val
$k]
173 lassign
$a hashmap_obj key_obj
174 if {[dict exists
[obj_val
$hashmap_obj] [obj_val
$key_obj]]} {
175 dict get
[obj_val
$hashmap_obj] [obj_val
$key_obj]
181 proc mal_contains_q
{a
} {
182 lassign
$a hashmap_obj key_obj
183 bool_new
[dict exists
[obj_val
$hashmap_obj] [obj_val
$key_obj]]
188 foreach k
[dict keys
[obj_val
[lindex $a 0]]] {
189 lappend res
[string_new
$k]
195 list_new
[dict values
[obj_val
[lindex $a 0]]]
198 proc mal_sequential_q
{a
} {
199 bool_new
[sequential_q
[lindex $a 0]]
204 list_new
[concat [list $head] [obj_val
$lst]]
207 proc mal_concat
{a
} {
213 set res
[concat $res [obj_val
$lst]]
219 lassign
$a lst_obj index_obj
220 set index
[obj_val
$index_obj]
221 set lst
[obj_val
$lst_obj]
222 if {$index >= [llength $lst]} {
223 error "nth: index out of range"
230 if {[nil_q
$lst] ||
[llength [obj_val
$lst]] == 0} {
233 lindex [obj_val
$lst] 0
238 list_new
[lrange [obj_val
$lst] 1 end
]
241 proc mal_empty_q
{a
} {
242 bool_new
[expr {[llength [obj_val
[lindex $a 0]]] == 0}]
246 integer_new
[llength [obj_val
[lindex $a 0]]]
251 if {[llength $a] > 1} {
252 set mid_args
[lrange $a 1 end-1
]
253 set last_list
[lindex $a end
]
254 set apply_args
[concat $mid_args [obj_val
$last_list]]
259 switch [obj_type
$f] {
261 set funcdict
[obj_val
$f]
262 set body
[dict get
$funcdict body
]
263 set env
[dict get
$funcdict env
]
264 set binds
[dict get
$funcdict binds
]
265 set funcenv
[Env new
$env $binds $apply_args]
266 return [EVAL
$body $funcenv]
269 set body
[concat [list [obj_val
$f]] {$a}]
270 set lambda
[list {a
} $body]
271 return [apply
$lambda $apply_args]
274 error "Not a function"
282 foreach item
[obj_val
$seq] {
283 set mappeditem
[mal_apply
[list $f [list_new
[list $item]]]]
284 lappend res
$mappeditem
293 foreach item
[lrange $a 1 end
] {
294 set lst
[mal_cons
[list $item $lst]]
297 } elseif
{[vector_q
$a0]} {
298 set res
[obj_val
$a0]
299 foreach item
[lrange $a 1 end
] {
304 error "conj requires list or vector"
309 obj_meta
[lindex $a 0]
312 proc mal_with_meta
{a
} {
314 obj_new
[obj_type
$a0] [obj_val
$a0] $a1
318 atom_new
[lindex $a 0]
321 proc mal_atom_q
{a
} {
322 bool_new
[atom_q
[lindex $a 0]]
326 obj_val
[lindex $a 0]
329 proc mal_reset_bang
{a
} {
334 proc mal_swap_bang
{a
} {
336 set apply_args
[concat [list [obj_val
$a0]] [lrange $a 2 end
]]
337 set newval
[mal_apply
[list $f [list_new
$apply_args]]]
338 mal_reset_bang
[list $a0 $newval]
341 set core_ns
[dict create
\
342 "=" [nativefunction_new mal_equal
] \
343 "throw" [nativefunction_new mal_throw
] \
345 "nil?" [nativefunction_new mal_nil_q
] \
346 "true?" [nativefunction_new mal_true_q
] \
347 "false?" [nativefunction_new mal_false_q
] \
348 "symbol" [nativefunction_new mal_symbol
] \
349 "symbol?" [nativefunction_new mal_symbol_q
] \
350 "keyword" [nativefunction_new mal_keyword
] \
351 "keyword?" [nativefunction_new mal_keyword_q
] \
353 "pr-str" [nativefunction_new mal_pr_str
] \
354 "str" [nativefunction_new mal_str
] \
355 "prn" [nativefunction_new mal_prn
] \
356 "println" [nativefunction_new mal_println
] \
357 "read-string" [nativefunction_new mal_read_string
] \
358 "readline" [nativefunction_new mal_readline
] \
359 "slurp" [nativefunction_new mal_slurp
] \
361 "<" [nativefunction_new mal_lt
] \
362 "<=" [nativefunction_new mal_lte
] \
363 ">" [nativefunction_new mal_gt
] \
364 ">=" [nativefunction_new mal_gte
] \
365 "+" [nativefunction_new mal_add
] \
366 "-" [nativefunction_new mal_sub
] \
367 "*" [nativefunction_new mal_mul
] \
368 "/" [nativefunction_new mal_div
] \
369 "time-ms" [nativefunction_new mal_time_ms
] \
371 "list" [nativefunction_new mal_list
] \
372 "list?" [nativefunction_new mal_list_q
] \
373 "vector" [nativefunction_new mal_vector
] \
374 "vector?" [nativefunction_new mal_vector_q
] \
375 "hash-map" [nativefunction_new mal_hash_map
] \
376 "map?" [nativefunction_new mal_map_q
] \
377 "assoc" [nativefunction_new mal_assoc
] \
378 "dissoc" [nativefunction_new mal_dissoc
] \
379 "get" [nativefunction_new mal_get
] \
380 "contains?" [nativefunction_new mal_contains_q
] \
381 "keys" [nativefunction_new mal_keys
] \
382 "vals" [nativefunction_new mal_vals
] \
384 "sequential?" [nativefunction_new mal_sequential_q
] \
385 "cons" [nativefunction_new mal_cons
] \
386 "concat" [nativefunction_new mal_concat
] \
387 "nth" [nativefunction_new mal_nth
] \
388 "first" [nativefunction_new mal_first
] \
389 "rest" [nativefunction_new mal_rest
] \
390 "empty?" [nativefunction_new mal_empty_q
] \
391 "count" [nativefunction_new mal_count
] \
392 "apply" [nativefunction_new mal_apply
] \
393 "map" [nativefunction_new mal_map
] \
395 "conj" [nativefunction_new mal_conj
] \
397 "meta" [nativefunction_new mal_meta
] \
398 "with-meta" [nativefunction_new mal_with_meta
] \
399 "atom" [nativefunction_new mal_atom
] \
400 "atom?" [nativefunction_new mal_atom_q
] \
401 "deref" [nativefunction_new mal_deref
] \
402 "reset!" [nativefunction_new mal_reset_bang
] \
403 "swap!" [nativefunction_new mal_swap_bang
] \