mirror of
https://github.com/kanaka/mal.git
synced 2024-09-19 09:38:28 +03:00
4eb88ef295
Tested on UCBLogo 6.0 with some minor tweaks (for performance and adding a `timems` function). The tweaks are performed during Docker image creation (see Dockerfile). Tests of step 5 are skipped because UCBLogo is too slow. Interop is available via `(logo-eval "logo code to run")`. The `examples` directory contains a Mal example of drawing a tree using turtle graphics.
114 lines
2.5 KiB
Plaintext
114 lines
2.5 KiB
Plaintext
load "../logo/readline.lg
|
|
load "../logo/reader.lg
|
|
load "../logo/printer.lg
|
|
load "../logo/types.lg
|
|
load "../logo/env.lg
|
|
load "../logo/core.lg
|
|
|
|
to _read :str
|
|
output read_str :str
|
|
end
|
|
|
|
to eval_ast :ast :env
|
|
output case (obj_type :ast) [
|
|
[[symbol] env_get :env :ast]
|
|
[[list] obj_new "list map [_eval ? :env] obj_val :ast]
|
|
[[vector] obj_new "vector map [_eval ? :env] obj_val :ast]
|
|
[[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast]
|
|
[else :ast]
|
|
]
|
|
end
|
|
|
|
to _eval :ast :env
|
|
if (obj_type :ast) <> "list [output eval_ast :ast :env]
|
|
if emptyp obj_val :ast [output :ast]
|
|
localmake "a0 nth :ast 0
|
|
case list obj_type :a0 obj_val :a0 [
|
|
[[[symbol def!]]
|
|
localmake "a1 nth :ast 1
|
|
localmake "a2 nth :ast 2
|
|
output env_set :env :a1 _eval :a2 :env ]
|
|
|
|
[[[symbol let*]]
|
|
localmake "a1 nth :ast 1
|
|
localmake "letenv env_new :env [] []
|
|
localmake "i 0
|
|
while [:i < _count :a1] [
|
|
ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv
|
|
make "i (:i + 2)
|
|
]
|
|
output _eval nth :ast 2 :letenv ]
|
|
|
|
[[[symbol do]]
|
|
output last obj_val eval_ast rest :ast :env ]
|
|
|
|
[[[symbol if]]
|
|
localmake "a1 nth :ast 1
|
|
localmake "cond _eval :a1 :env
|
|
output case obj_type :cond [
|
|
[[nil false] ifelse (_count :ast) > 3 [
|
|
_eval nth :ast 3 :env
|
|
] [
|
|
nil_new
|
|
]]
|
|
[else _eval nth :ast 2 :env]
|
|
]]
|
|
|
|
[[[symbol fn*]]
|
|
output fn_new nth :ast 1 :env nth :ast 2 ]
|
|
|
|
[else
|
|
localmake "el eval_ast :ast :env
|
|
localmake "f nth :el 0
|
|
case obj_type :f [
|
|
[[nativefn]
|
|
output apply obj_val :f butfirst obj_val :el ]
|
|
[[fn]
|
|
localmake "funcenv env_new fn_env :f fn_args :f rest :el
|
|
output _eval fn_body :f :funcenv ]
|
|
[else
|
|
(throw "error [Wrong type for apply])]
|
|
] ]
|
|
]
|
|
end
|
|
|
|
to _print :exp
|
|
output pr_str :exp "true
|
|
end
|
|
|
|
to re :str
|
|
output _eval _read :str :repl_env
|
|
end
|
|
|
|
to rep :str
|
|
output _print re :str
|
|
end
|
|
|
|
to repl
|
|
localmake "running "true
|
|
while [:running] [
|
|
localmake "line readline word "user> :space_char
|
|
ifelse :line=[] [
|
|
print "
|
|
make "running "false
|
|
] [
|
|
if not emptyp :line [
|
|
catch "error [print rep :line]
|
|
localmake "exception error
|
|
if not emptyp :exception [
|
|
(print "Error: first butfirst :exception)
|
|
]
|
|
]
|
|
]
|
|
]
|
|
end
|
|
|
|
make "repl_env env_new [] [] []
|
|
foreach :core_ns [
|
|
ignore env_set :repl_env first ? first butfirst ?
|
|
]
|
|
; core.mal: defined using the language itself
|
|
ignore re "|(def! not (fn* (a) (if a false true)))|
|
|
repl
|
|
bye
|