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 mal_number_q
{a
} {
44 bool_new
[integer_q
[lindex $a 0]]
49 switch [obj_type
$f] {
50 function
{ return [bool_new
[expr {![macro_q
$f]}]] }
51 nativefunction
{ return $::mal_true }
52 default { return $::mal_false }
56 proc mal_macro_q
{a
} {
57 bool_new
[macro_q
[lindex $a 0]]
60 proc render_array
{arr readable delim
} {
63 lappend res
[pr_str
$e $readable]
69 string_new
[render_array
$a 1 " "]
73 string_new
[render_array
$a 0 ""]
77 puts [render_array
$a 1 " "]
81 proc mal_println
{a
} {
82 puts [render_array
$a 0 " "]
86 proc mal_read_string
{a
} {
87 read_str
[obj_val
[lindex $a 0]]
90 proc mal_readline
{a
} {
91 set prompt
[obj_val
[lindex $a 0]]
92 set res
[_readline
$prompt]
93 if {[lindex $res 0] == "EOF"} {
96 string_new
[lindex $res 1]
100 set filename [obj_val
[lindex $a 0]]
101 set file [open $filename]
102 set content
[read $file]
108 bool_new
[expr {[obj_val
[lindex $a 0]] < [obj_val
[lindex $a 1]]}]
112 bool_new
[expr {[obj_val
[lindex $a 0]] <= [obj_val
[lindex $a 1]]}]
116 bool_new
[expr {[obj_val
[lindex $a 0]] > [obj_val
[lindex $a 1]]}]
120 bool_new
[expr {[obj_val
[lindex $a 0]] >= [obj_val
[lindex $a 1]]}]
124 integer_new
[expr {[obj_val
[lindex $a 0]] + [obj_val
[lindex $a 1]]}]
128 integer_new
[expr {[obj_val
[lindex $a 0]] - [obj_val
[lindex $a 1]]}]
132 integer_new
[expr {[obj_val
[lindex $a 0]] * [obj_val
[lindex $a 1]]}]
136 integer_new
[expr {[obj_val
[lindex $a 0]] / [obj_val
[lindex $a 1]]}]
139 proc mal_time_ms
{a
} {
140 integer_new
[clock milliseconds
]
147 proc mal_list_q
{a
} {
148 bool_new
[list_q
[lindex $a 0]]
151 proc mal_vector
{a
} {
155 proc mal_vector_q
{a
} {
156 bool_new
[vector_q
[lindex $a 0]]
159 proc mal_hash_map
{a
} {
162 dict
set d
[obj_val
$k] $v
168 bool_new
[hashmap_q
[lindex $a 0]]
173 dict
for {k v
} [obj_val
[lindex $a 0]] {
176 foreach {k v
} [lrange $a 1 end
] {
177 dict
set d
[obj_val
$k] $v
182 proc mal_dissoc
{a
} {
184 dict
for {k v
} [obj_val
[lindex $a 0]] {
187 foreach k
[lrange $a 1 end
] {
188 dict
unset d
[obj_val
$k]
194 lassign
$a hashmap_obj key_obj
195 if {[dict exists
[obj_val
$hashmap_obj] [obj_val
$key_obj]]} {
196 dict get
[obj_val
$hashmap_obj] [obj_val
$key_obj]
202 proc mal_contains_q
{a
} {
203 lassign
$a hashmap_obj key_obj
204 bool_new
[dict exists
[obj_val
$hashmap_obj] [obj_val
$key_obj]]
209 foreach k
[dict keys
[obj_val
[lindex $a 0]]] {
210 lappend res
[string_new
$k]
216 list_new
[dict values
[obj_val
[lindex $a 0]]]
219 proc mal_sequential_q
{a
} {
220 bool_new
[sequential_q
[lindex $a 0]]
225 list_new
[concat [list $head] [obj_val
$lst]]
228 proc mal_concat
{a
} {
234 set res
[concat $res [obj_val
$lst]]
240 lassign
$a lst_obj index_obj
241 set index
[obj_val
$index_obj]
242 set lst
[obj_val
$lst_obj]
243 if {$index >= [llength $lst]} {
244 error "nth: index out of range"
251 if {[nil_q
$lst] ||
[llength [obj_val
$lst]] == 0} {
254 lindex [obj_val
$lst] 0
259 list_new
[lrange [obj_val
$lst] 1 end
]
262 proc mal_empty_q
{a
} {
263 bool_new
[expr {[llength [obj_val
[lindex $a 0]]] == 0}]
267 integer_new
[llength [obj_val
[lindex $a 0]]]
272 if {[llength $a] > 1} {
273 set mid_args
[lrange $a 1 end-1
]
274 set last_list
[lindex $a end
]
275 set apply_args
[concat $mid_args [obj_val
$last_list]]
280 switch [obj_type
$f] {
282 set funcdict
[obj_val
$f]
283 set body
[dict get
$funcdict body
]
284 set env
[dict get
$funcdict env
]
285 set binds
[dict get
$funcdict binds
]
286 set funcenv
[Env new
$env $binds $apply_args]
287 return [EVAL
$body $funcenv]
290 set body
[concat [list [obj_val
$f]] {$a}]
291 set lambda
[list {a
} $body]
292 return [apply
$lambda $apply_args]
295 error "Not a function"
303 foreach item
[obj_val
$seq] {
304 set mappeditem
[mal_apply
[list $f [list_new
[list $item]]]]
305 lappend res
$mappeditem
314 foreach item
[lrange $a 1 end
] {
315 set lst
[mal_cons
[list $item $lst]]
318 } elseif
{[vector_q
$a0]} {
319 set res
[obj_val
$a0]
320 foreach item
[lrange $a 1 end
] {
325 error "conj requires list or vector"
331 if {[string_q
$a0]} {
332 set str
[obj_val
$a0]
337 foreach char
[split $str {}] {
338 lappend res
[string_new
$char]
341 } elseif
{[list_q
$a0]} {
342 if {[llength [obj_val
$a0]] == 0} {
346 } elseif
{[vector_q
$a0]} {
347 if {[llength [obj_val
$a0]] == 0} {
350 list_new
[obj_val
$a0]
351 } elseif
{[nil_q
$a0]} {
354 error "seq requires string or list or vector or nil"
359 obj_meta
[lindex $a 0]
362 proc mal_with_meta
{a
} {
364 obj_new
[obj_type
$a0] [obj_val
$a0] $a1
368 atom_new
[lindex $a 0]
371 proc mal_atom_q
{a
} {
372 bool_new
[atom_q
[lindex $a 0]]
376 obj_val
[lindex $a 0]
379 proc mal_reset_bang
{a
} {
384 proc mal_swap_bang
{a
} {
386 set apply_args
[concat [list [obj_val
$a0]] [lrange $a 2 end
]]
387 set newval
[mal_apply
[list $f [list_new
$apply_args]]]
388 mal_reset_bang
[list $a0 $newval]
391 set core_ns
[dict create
\
392 "=" [nativefunction_new mal_equal
] \
393 "throw" [nativefunction_new mal_throw
] \
395 "nil?" [nativefunction_new mal_nil_q
] \
396 "true?" [nativefunction_new mal_true_q
] \
397 "false?" [nativefunction_new mal_false_q
] \
398 "symbol" [nativefunction_new mal_symbol
] \
399 "symbol?" [nativefunction_new mal_symbol_q
] \
400 "string?" [nativefunction_new mal_string_q
] \
401 "keyword" [nativefunction_new mal_keyword
] \
402 "keyword?" [nativefunction_new mal_keyword_q
] \
403 "number?" [nativefunction_new mal_number_q
] \
404 "fn?" [nativefunction_new mal_fn_q
] \
405 "macro?" [nativefunction_new mal_macro_q
] \
407 "pr-str" [nativefunction_new mal_pr_str
] \
408 "str" [nativefunction_new mal_str
] \
409 "prn" [nativefunction_new mal_prn
] \
410 "println" [nativefunction_new mal_println
] \
411 "read-string" [nativefunction_new mal_read_string
] \
412 "readline" [nativefunction_new mal_readline
] \
413 "slurp" [nativefunction_new mal_slurp
] \
415 "<" [nativefunction_new mal_lt
] \
416 "<=" [nativefunction_new mal_lte
] \
417 ">" [nativefunction_new mal_gt
] \
418 ">=" [nativefunction_new mal_gte
] \
419 "+" [nativefunction_new mal_add
] \
420 "-" [nativefunction_new mal_sub
] \
421 "*" [nativefunction_new mal_mul
] \
422 "/" [nativefunction_new mal_div
] \
423 "time-ms" [nativefunction_new mal_time_ms
] \
425 "list" [nativefunction_new mal_list
] \
426 "list?" [nativefunction_new mal_list_q
] \
427 "vector" [nativefunction_new mal_vector
] \
428 "vector?" [nativefunction_new mal_vector_q
] \
429 "hash-map" [nativefunction_new mal_hash_map
] \
430 "map?" [nativefunction_new mal_map_q
] \
431 "assoc" [nativefunction_new mal_assoc
] \
432 "dissoc" [nativefunction_new mal_dissoc
] \
433 "get" [nativefunction_new mal_get
] \
434 "contains?" [nativefunction_new mal_contains_q
] \
435 "keys" [nativefunction_new mal_keys
] \
436 "vals" [nativefunction_new mal_vals
] \
438 "sequential?" [nativefunction_new mal_sequential_q
] \
439 "cons" [nativefunction_new mal_cons
] \
440 "concat" [nativefunction_new mal_concat
] \
441 "nth" [nativefunction_new mal_nth
] \
442 "first" [nativefunction_new mal_first
] \
443 "rest" [nativefunction_new mal_rest
] \
444 "empty?" [nativefunction_new mal_empty_q
] \
445 "count" [nativefunction_new mal_count
] \
446 "apply" [nativefunction_new mal_apply
] \
447 "map" [nativefunction_new mal_map
] \
449 "conj" [nativefunction_new mal_conj
] \
450 "seq" [nativefunction_new mal_seq
] \
452 "meta" [nativefunction_new mal_meta
] \
453 "with-meta" [nativefunction_new mal_with_meta
] \
454 "atom" [nativefunction_new mal_atom
] \
455 "atom?" [nativefunction_new mal_atom_q
] \
456 "deref" [nativefunction_new mal_deref
] \
457 "reset!" [nativefunction_new mal_reset_bang
] \
458 "swap!" [nativefunction_new mal_swap_bang
] \