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_string_q
{a
} {
32 bool_new
[string_q
[lindex $a 0]]
35 proc mal_keyword
{a
} {
36 keyword_new
[obj_val
[lindex $a 0]]
39 proc mal_keyword_q
{a
} {
40 bool_new
[keyword_q
[lindex $a 0]]
43 proc render_array
{arr readable delim
} {
46 lappend res
[pr_str
$e $readable]
52 string_new
[render_array
$a 1 " "]
56 string_new
[render_array
$a 0 ""]
60 puts [render_array
$a 1 " "]
64 proc mal_println
{a
} {
65 puts [render_array
$a 0 " "]
69 proc mal_read_string
{a
} {
70 read_str
[obj_val
[lindex $a 0]]
73 proc mal_readline
{a
} {
74 set prompt
[obj_val
[lindex $a 0]]
75 set res
[_readline
$prompt]
76 if {[lindex $res 0] == "EOF"} {
79 string_new
[lindex $res 1]
83 set filename [obj_val
[lindex $a 0]]
84 set file [open $filename]
85 set content
[read $file]
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 bool_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]]}]
119 integer_new
[expr {[obj_val
[lindex $a 0]] / [obj_val
[lindex $a 1]]}]
122 proc mal_time_ms
{a
} {
123 integer_new
[clock milliseconds
]
130 proc mal_list_q
{a
} {
131 bool_new
[list_q
[lindex $a 0]]
134 proc mal_vector
{a
} {
138 proc mal_vector_q
{a
} {
139 bool_new
[vector_q
[lindex $a 0]]
142 proc mal_hash_map
{a
} {
145 dict
set d
[obj_val
$k] $v
151 bool_new
[hashmap_q
[lindex $a 0]]
156 dict
for {k v
} [obj_val
[lindex $a 0]] {
159 foreach {k v
} [lrange $a 1 end
] {
160 dict
set d
[obj_val
$k] $v
165 proc mal_dissoc
{a
} {
167 dict
for {k v
} [obj_val
[lindex $a 0]] {
170 foreach k
[lrange $a 1 end
] {
171 dict
unset d
[obj_val
$k]
177 lassign
$a hashmap_obj key_obj
178 if {[dict exists
[obj_val
$hashmap_obj] [obj_val
$key_obj]]} {
179 dict get
[obj_val
$hashmap_obj] [obj_val
$key_obj]
185 proc mal_contains_q
{a
} {
186 lassign
$a hashmap_obj key_obj
187 bool_new
[dict exists
[obj_val
$hashmap_obj] [obj_val
$key_obj]]
192 foreach k
[dict keys
[obj_val
[lindex $a 0]]] {
193 lappend res
[string_new
$k]
199 list_new
[dict values
[obj_val
[lindex $a 0]]]
202 proc mal_sequential_q
{a
} {
203 bool_new
[sequential_q
[lindex $a 0]]
208 list_new
[concat [list $head] [obj_val
$lst]]
211 proc mal_concat
{a
} {
217 set res
[concat $res [obj_val
$lst]]
223 lassign
$a lst_obj index_obj
224 set index
[obj_val
$index_obj]
225 set lst
[obj_val
$lst_obj]
226 if {$index >= [llength $lst]} {
227 error "nth: index out of range"
234 if {[nil_q
$lst] ||
[llength [obj_val
$lst]] == 0} {
237 lindex [obj_val
$lst] 0
242 list_new
[lrange [obj_val
$lst] 1 end
]
245 proc mal_empty_q
{a
} {
246 bool_new
[expr {[llength [obj_val
[lindex $a 0]]] == 0}]
250 integer_new
[llength [obj_val
[lindex $a 0]]]
255 if {[llength $a] > 1} {
256 set mid_args
[lrange $a 1 end-1
]
257 set last_list
[lindex $a end
]
258 set apply_args
[concat $mid_args [obj_val
$last_list]]
263 switch [obj_type
$f] {
265 set funcdict
[obj_val
$f]
266 set body
[dict get
$funcdict body
]
267 set env
[dict get
$funcdict env
]
268 set binds
[dict get
$funcdict binds
]
269 set funcenv
[Env new
$env $binds $apply_args]
270 return [EVAL
$body $funcenv]
273 set body
[concat [list [obj_val
$f]] {$a}]
274 set lambda
[list {a
} $body]
275 return [apply
$lambda $apply_args]
278 error "Not a function"
286 foreach item
[obj_val
$seq] {
287 set mappeditem
[mal_apply
[list $f [list_new
[list $item]]]]
288 lappend res
$mappeditem
297 foreach item
[lrange $a 1 end
] {
298 set lst
[mal_cons
[list $item $lst]]
301 } elseif
{[vector_q
$a0]} {
302 set res
[obj_val
$a0]
303 foreach item
[lrange $a 1 end
] {
308 error "conj requires list or vector"
314 if {[string_q
$a0]} {
315 set str
[obj_val
$a0]
320 foreach char
[split $str {}] {
321 lappend res
[string_new
$char]
324 } elseif
{[list_q
$a0]} {
325 if {[llength [obj_val
$a0]] == 0} {
329 } elseif
{[vector_q
$a0]} {
330 if {[llength [obj_val
$a0]] == 0} {
333 list_new
[obj_val
$a0]
334 } elseif
{[nil_q
$a0]} {
337 error "seq requires string or list or vector or nil"
342 obj_meta
[lindex $a 0]
345 proc mal_with_meta
{a
} {
347 obj_new
[obj_type
$a0] [obj_val
$a0] $a1
351 atom_new
[lindex $a 0]
354 proc mal_atom_q
{a
} {
355 bool_new
[atom_q
[lindex $a 0]]
359 obj_val
[lindex $a 0]
362 proc mal_reset_bang
{a
} {
367 proc mal_swap_bang
{a
} {
369 set apply_args
[concat [list [obj_val
$a0]] [lrange $a 2 end
]]
370 set newval
[mal_apply
[list $f [list_new
$apply_args]]]
371 mal_reset_bang
[list $a0 $newval]
374 set core_ns
[dict create
\
375 "=" [nativefunction_new mal_equal
] \
376 "throw" [nativefunction_new mal_throw
] \
378 "nil?" [nativefunction_new mal_nil_q
] \
379 "true?" [nativefunction_new mal_true_q
] \
380 "false?" [nativefunction_new mal_false_q
] \
381 "symbol" [nativefunction_new mal_symbol
] \
382 "symbol?" [nativefunction_new mal_symbol_q
] \
383 "string?" [nativefunction_new mal_string_q
] \
384 "keyword" [nativefunction_new mal_keyword
] \
385 "keyword?" [nativefunction_new mal_keyword_q
] \
387 "pr-str" [nativefunction_new mal_pr_str
] \
388 "str" [nativefunction_new mal_str
] \
389 "prn" [nativefunction_new mal_prn
] \
390 "println" [nativefunction_new mal_println
] \
391 "read-string" [nativefunction_new mal_read_string
] \
392 "readline" [nativefunction_new mal_readline
] \
393 "slurp" [nativefunction_new mal_slurp
] \
395 "<" [nativefunction_new mal_lt
] \
396 "<=" [nativefunction_new mal_lte
] \
397 ">" [nativefunction_new mal_gt
] \
398 ">=" [nativefunction_new mal_gte
] \
399 "+" [nativefunction_new mal_add
] \
400 "-" [nativefunction_new mal_sub
] \
401 "*" [nativefunction_new mal_mul
] \
402 "/" [nativefunction_new mal_div
] \
403 "time-ms" [nativefunction_new mal_time_ms
] \
405 "list" [nativefunction_new mal_list
] \
406 "list?" [nativefunction_new mal_list_q
] \
407 "vector" [nativefunction_new mal_vector
] \
408 "vector?" [nativefunction_new mal_vector_q
] \
409 "hash-map" [nativefunction_new mal_hash_map
] \
410 "map?" [nativefunction_new mal_map_q
] \
411 "assoc" [nativefunction_new mal_assoc
] \
412 "dissoc" [nativefunction_new mal_dissoc
] \
413 "get" [nativefunction_new mal_get
] \
414 "contains?" [nativefunction_new mal_contains_q
] \
415 "keys" [nativefunction_new mal_keys
] \
416 "vals" [nativefunction_new mal_vals
] \
418 "sequential?" [nativefunction_new mal_sequential_q
] \
419 "cons" [nativefunction_new mal_cons
] \
420 "concat" [nativefunction_new mal_concat
] \
421 "nth" [nativefunction_new mal_nth
] \
422 "first" [nativefunction_new mal_first
] \
423 "rest" [nativefunction_new mal_rest
] \
424 "empty?" [nativefunction_new mal_empty_q
] \
425 "count" [nativefunction_new mal_count
] \
426 "apply" [nativefunction_new mal_apply
] \
427 "map" [nativefunction_new mal_map
] \
429 "conj" [nativefunction_new mal_conj
] \
430 "seq" [nativefunction_new mal_seq
] \
432 "meta" [nativefunction_new mal_meta
] \
433 "with-meta" [nativefunction_new mal_with_meta
] \
434 "atom" [nativefunction_new mal_atom
] \
435 "atom?" [nativefunction_new mal_atom_q
] \
436 "deref" [nativefunction_new mal_deref
] \
437 "reset!" [nativefunction_new mal_reset_bang
] \
438 "swap!" [nativefunction_new mal_swap_bang
] \