mirror of
https://github.com/kanaka/mal.git
synced 2024-10-26 22:28:26 +03:00
fbfe6784d2
- Add a `vec` built-in function in step7 so that `quasiquote` does not require `apply` from step9. - Introduce quasiquoteexpand special in order to help debugging step7. This may also prepare newcomers to understand step8. - Add soft tests. - Do not quote numbers, strings and so on. Should ideally have been in separate commits: - elisp: simplify and fix (keyword :k) - factor: fix copy/paste error in let*/step7, simplify eval-ast. - guile: improve list/vector types - haskell: revert evaluation during quasiquote - logo, make: cosmetic issues
242 lines
6.2 KiB
Plaintext
242 lines
6.2 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 starts_with :ast :sym
|
|
if (obj_type :ast) <> "list [output "false]
|
|
localmake "xs obj_val :ast
|
|
if emptyp :xs [output "false]
|
|
localmake "a0 first :xs
|
|
output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym)
|
|
end
|
|
|
|
to quasiquote :ast
|
|
if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)]
|
|
if not sequentialp :ast [output :ast]
|
|
if starts_with :ast "unquote [output nth :ast 1]
|
|
localmake "result mal_list
|
|
foreach reverse obj_val :ast [
|
|
ifelse starts_with ? "splice-unquote [
|
|
make "result (mal_list symbol_new "concat nth ? 1 :result)
|
|
] [
|
|
make "result (mal_list symbol_new "cons quasiquote ? :result)
|
|
] ]
|
|
if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)]
|
|
output :result
|
|
end
|
|
|
|
to macrocallp :ast :env
|
|
if (obj_type :ast) = "list [
|
|
if (_count :ast) > 0 [
|
|
localmake "a0 nth :ast 0
|
|
if (obj_type :a0) = "symbol [
|
|
if not emptyp env_find :env :a0 [
|
|
localmake "f env_get :env :a0
|
|
if (obj_type :f) = "fn [
|
|
output fn_is_macro :f
|
|
]
|
|
]
|
|
]
|
|
]
|
|
]
|
|
output "false
|
|
end
|
|
|
|
to _macroexpand :ast :env
|
|
if not macrocallp :ast :env [output :ast]
|
|
localmake "a0 nth :ast 0
|
|
localmake "f env_get :env :a0
|
|
output _macroexpand invoke_fn :f rest :ast :env
|
|
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 :a_ast :a_env
|
|
localmake "ast :a_ast
|
|
localmake "env :a_env
|
|
forever [
|
|
if (obj_type :ast) <> "list [output eval_ast :ast :env]
|
|
make "ast _macroexpand :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)
|
|
]
|
|
make "env :letenv
|
|
make "ast nth :ast 2 ] ; TCO
|
|
|
|
[[[symbol quote]]
|
|
output nth :ast 1 ]
|
|
|
|
[[[symbol quasiquote]]
|
|
make "ast quasiquote nth :ast 1 ] ; TCO
|
|
|
|
[[[symbol quasiquoteexpand]]
|
|
output quasiquote nth :ast 1]
|
|
|
|
[[[symbol defmacro!]]
|
|
localmake "a1 nth :ast 1
|
|
localmake "a2 nth :ast 2
|
|
localmake "macro_fn _eval :a2 :env
|
|
fn_set_macro :macro_fn
|
|
output env_set :env :a1 :macro_fn ]
|
|
|
|
[[[symbol macroexpand]]
|
|
output _macroexpand nth :ast 1 :env ]
|
|
|
|
[[[symbol try*]]
|
|
localmake "a1 nth :ast 1
|
|
if (_count :ast) < 3 [
|
|
output _eval :a1 :env
|
|
]
|
|
localmake "result nil_new
|
|
catch "error [make "result _eval :a1 :env]
|
|
localmake "exception error
|
|
ifelse emptyp :exception [
|
|
output :result
|
|
] [
|
|
localmake "e first butfirst :exception
|
|
localmake "exception_obj ifelse :e = "_mal_exception_ [:global_exception] [obj_new "string :e]
|
|
localmake "a2 nth :ast 2
|
|
localmake "catchenv env_new :env [] []
|
|
ignore env_set :catchenv nth :a2 1 :exception_obj
|
|
output _eval nth :a2 2 :catchenv
|
|
] ]
|
|
|
|
[[[symbol do]]
|
|
localmake "i 1
|
|
while [:i < ((_count :ast) - 1)] [
|
|
ignore _eval nth :ast :i :env
|
|
make "i (:i + 1)
|
|
]
|
|
make "ast last obj_val :ast ] ; TCO
|
|
|
|
[[[symbol if]]
|
|
localmake "a1 nth :ast 1
|
|
localmake "cond _eval :a1 :env
|
|
case obj_type :cond [
|
|
[[nil false] ifelse (_count :ast) > 3 [
|
|
make "ast nth :ast 3 ; TCO
|
|
] [
|
|
output nil_new
|
|
]]
|
|
[else make "ast nth :ast 2] ; TCO
|
|
]]
|
|
|
|
[[[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]
|
|
make "env env_new fn_env :f fn_args :f rest :el
|
|
make "ast fn_body :f ] ; TCO
|
|
[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 print_exception :exception
|
|
if not emptyp :exception [
|
|
localmake "e first butfirst :exception
|
|
ifelse :e = "_mal_exception_ [
|
|
(print "Error: pr_str :global_exception "false)
|
|
] [
|
|
(print "Error: :e)
|
|
]
|
|
]
|
|
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]
|
|
print_exception error
|
|
]
|
|
]
|
|
]
|
|
end
|
|
|
|
to mal_eval :a
|
|
output _eval :a :repl_env
|
|
end
|
|
|
|
to argv_list
|
|
localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line]
|
|
output obj_new "list map [obj_new "string ?] :argv
|
|
end
|
|
|
|
make "repl_env env_new [] [] []
|
|
foreach :core_ns [
|
|
ignore env_set :repl_env first ? first butfirst ?
|
|
]
|
|
ignore env_set :repl_env [symbol eval] [nativefn mal_eval]
|
|
ignore env_set :repl_env [symbol *ARGV*] argv_list
|
|
|
|
; core.mal: defined using the language itself
|
|
ignore re "|(def! *host-language* "logo")|
|
|
ignore re "|(def! not (fn* (a) (if a false true)))|
|
|
ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))|
|
|
ignore re "|(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs)))))))|
|
|
|
|
if not emptyp :command.line [
|
|
catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )]
|
|
print_exception error
|
|
bye
|
|
]
|
|
|
|
ignore re "|(println (str "Mal [" *host-language* "]"))|
|
|
repl
|
|
bye
|