mirror of
https://github.com/kanaka/mal.git
synced 2024-10-26 14:22:25 +03:00
Merge branch 'master' into bjh21-unterminated-strings
This should fix ocaml.
This commit is contained in:
commit
a94c795da6
@ -109,4 +109,5 @@ script:
|
||||
# Build, test, perf
|
||||
- ./.travis_test.sh build ${IMPL}
|
||||
- ./.travis_test.sh test ${IMPL}
|
||||
- STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./.travis_test.sh test ${IMPL}
|
||||
- ./.travis_test.sh perf ${IMPL}
|
||||
|
@ -61,6 +61,9 @@ test|perf)
|
||||
if ! ${MAKE} TEST_OPTS="${TEST_OPTS}" \
|
||||
${MAL_IMPL:+MAL_IMPL=${MAL_IMPL}} \
|
||||
${REGRESS:+REGRESS=${REGRESS}} \
|
||||
${HARD:+HARD=${HARD}} \
|
||||
${DEFERRABLE:+DEFERRABLE=${DEFERRABLE}} \
|
||||
${OPTIONAL:+OPTIONAL=${OPTIONAL}} \
|
||||
${ACTION}^${IMPL}${STEP:+^${STEP}}; then
|
||||
# print debug-file on error
|
||||
cat ${ACTION}.err
|
||||
|
6
Makefile
6
Makefile
@ -77,6 +77,7 @@ TEST_OPTS =
|
||||
# later steps.
|
||||
REGRESS =
|
||||
|
||||
HARD=
|
||||
DEFERRABLE=1
|
||||
OPTIONAL=1
|
||||
|
||||
@ -142,6 +143,8 @@ dist_EXCLUDES += guile io julia matlab swift
|
||||
|
||||
# Extra options to pass to runtest.py
|
||||
bbc-basic_TEST_OPTS = --test-timeout 60
|
||||
guile_TEST_OPTS = --test-timeout 120
|
||||
io_TEST_OPTS = --test-timeout 120
|
||||
logo_TEST_OPTS = --start-timeout 60 --test-timeout 120
|
||||
mal_TEST_OPTS = --start-timeout 60 --test-timeout 120
|
||||
miniMAL_TEST_OPTS = --start-timeout 60 --test-timeout 120
|
||||
@ -270,6 +273,7 @@ noop =
|
||||
SPACE = $(noop) $(noop)
|
||||
export FACTOR_ROOTS := .
|
||||
|
||||
opt_HARD = $(if $(strip $(HARD)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(HARD)),--hard,),)
|
||||
opt_DEFERRABLE = $(if $(strip $(DEFERRABLE)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(DEFERRABLE)),--deferrable,--no-deferrable),--no-deferrable)
|
||||
opt_OPTIONAL = $(if $(strip $(OPTIONAL)),$(if $(filter t true T True TRUE 1 y yes Yes YES,$(OPTIONAL)),--optional,--no-optional),--no-optional)
|
||||
|
||||
@ -328,7 +332,7 @@ get_run_prefix = $(strip $(foreach mode,$(call actual_impl,$(1))_MODE, \
|
||||
# Takes impl and step
|
||||
# Returns the runtest command prefix (with runtest options) for testing the given step
|
||||
get_runtest_cmd = $(call get_run_prefix,$(1),$(2),$(if $(filter cs fsharp mal tcl vb,$(1)),RAW=1,)) \
|
||||
../runtest.py $(opt_DEFERRABLE) $(opt_OPTIONAL) $(call $(1)_TEST_OPTS) $(TEST_OPTS)
|
||||
../runtest.py $(opt_HARD) $(opt_DEFERRABLE) $(opt_OPTIONAL) $(call $(1)_TEST_OPTS) $(TEST_OPTS)
|
||||
|
||||
# Takes impl and step
|
||||
# Returns the runtest command prefix (with runtest options) for testing the given step
|
||||
|
@ -156,8 +156,9 @@ package body Core is
|
||||
|
||||
function Keyword (Args : in Types.T_Array) return Types.T is
|
||||
begin
|
||||
Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_String,
|
||||
"expected a string");
|
||||
Err.Check (Args'Length = 1
|
||||
and then Args (Args'First).Kind in Types.Kind_Key,
|
||||
"expected a keyword or a string");
|
||||
return (Kind_Keyword, Args (Args'First).Str);
|
||||
end Keyword;
|
||||
|
||||
|
@ -401,12 +401,7 @@ procedure Step8_Macros is
|
||||
& " (list 'if (first xs)"
|
||||
& " (if (> (count xs) 1) (nth xs 1)"
|
||||
& " (throw ""odd number of forms to cond""))"
|
||||
& " (cons 'cond (rest (rest xs)))))))"
|
||||
& "(defmacro! or (fn* (& xs)"
|
||||
& " (if (empty? xs) nil"
|
||||
& " (if (= 1 (count xs)) (first xs)"
|
||||
& " `(let* (or_FIXME ~(first xs))"
|
||||
& " (if or_FIXME or_FIXME (or ~@(rest xs))))))))";
|
||||
& " (cons 'cond (rest (rest xs)))))))";
|
||||
Repl : constant Envs.Ptr := Envs.New_Env;
|
||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
||||
begin
|
||||
|
@ -431,12 +431,7 @@ procedure Step9_Try is
|
||||
& " (list 'if (first xs)"
|
||||
& " (if (> (count xs) 1) (nth xs 1)"
|
||||
& " (throw ""odd number of forms to cond""))"
|
||||
& " (cons 'cond (rest (rest xs)))))))"
|
||||
& "(defmacro! or (fn* (& xs)"
|
||||
& " (if (empty? xs) nil"
|
||||
& " (if (= 1 (count xs)) (first xs)"
|
||||
& " `(let* (or_FIXME ~(first xs))"
|
||||
& " (if or_FIXME or_FIXME (or ~@(rest xs))))))))";
|
||||
& " (cons 'cond (rest (rest xs)))))))";
|
||||
Repl : constant Envs.Ptr := Envs.New_Env;
|
||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
||||
begin
|
||||
|
@ -438,15 +438,6 @@ procedure StepA_Mal is
|
||||
& " (if (> (count xs) 1) (nth xs 1)"
|
||||
& " (throw ""odd number of forms to cond""))"
|
||||
& " (cons 'cond (rest (rest xs)))))))"
|
||||
& "(def! inc (fn* [x] (+ x 1)))"
|
||||
& "(def! gensym (let* [counter (atom 0)]"
|
||||
& " (fn* [] (symbol (str ""G__"" (swap! counter inc))))))"
|
||||
& "(defmacro! or (fn* (& xs)"
|
||||
& " (if (empty? xs) nil"
|
||||
& " (if (= 1 (count xs)) (first xs)"
|
||||
& " (let* (condvar (gensym))"
|
||||
& " `(let* (~condvar ~(first xs))"
|
||||
& " (if ~condvar ~condvar (or ~@(rest xs)))))))))"
|
||||
& "(def! *host-language* ""ada.2"")";
|
||||
Repl : constant Envs.Ptr := Envs.New_Env;
|
||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T is
|
||||
|
@ -527,7 +527,6 @@ begin
|
||||
RE ("(def! not (fn* (a) (if a false true)))");
|
||||
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
|
||||
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)))))))");
|
||||
RE ("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
|
||||
-- Command line processing.
|
||||
|
||||
|
@ -580,7 +580,6 @@ begin
|
||||
RE ("(def! not (fn* (a) (if a false true)))");
|
||||
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
|
||||
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)))))))");
|
||||
RE ("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
|
||||
-- Command line processing.
|
||||
|
||||
|
@ -580,9 +580,6 @@ begin
|
||||
RE ("(def! not (fn* (a) (if a false true)))");
|
||||
RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
|
||||
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)))))))");
|
||||
RE ("(def! inc (fn* [x] (+ x 1)))");
|
||||
RE ("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str ""G__"" (swap! counter inc))))))");
|
||||
RE ("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
|
||||
|
||||
-- Command line processing.
|
||||
|
||||
|
@ -507,7 +507,6 @@ function main(str, ret, i, idx)
|
||||
rep("(def! not (fn* (a) (if a false true)))")
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
rep("(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)))))))")
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
idx = types_allocate()
|
||||
env_set(repl_env, "'*ARGV*", "(" idx)
|
||||
|
@ -569,7 +569,6 @@ function main(str, ret, i, idx)
|
||||
rep("(def! not (fn* (a) (if a false true)))")
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
rep("(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)))))))")
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
idx = types_allocate()
|
||||
env_set(repl_env, "'*ARGV*", "(" idx)
|
||||
|
@ -572,9 +572,6 @@ function main(str, ret, i, idx)
|
||||
rep("(def! not (fn* (a) (if a false true)))")
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
rep("(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)))))))")
|
||||
rep("(def! inc (fn* [x] (+ x 1)))")
|
||||
rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
|
||||
|
||||
idx = types_allocate()
|
||||
env_set(repl_env, "'*ARGV*", "(" idx)
|
||||
|
@ -250,7 +250,6 @@ ENV_SET "${REPL_ENV}" "${r}" "${argv}";
|
||||
REP "(def! not (fn* (a) (if a false true)))"
|
||||
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
||||
REP "(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)))))))"
|
||||
REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
|
||||
# load/run file from command line (then exit)
|
||||
if [[ "${1}" ]]; then
|
||||
|
@ -263,7 +263,6 @@ ENV_SET "${REPL_ENV}" "${r}" "${argv}";
|
||||
REP "(def! not (fn* (a) (if a false true)))"
|
||||
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
||||
REP "(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)))))))"
|
||||
REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) \`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
|
||||
# load/run file from command line (then exit)
|
||||
if [[ "${1}" ]]; then
|
||||
|
@ -272,9 +272,6 @@ REP "(def! *host-language* \"bash\")"
|
||||
REP "(def! not (fn* (a) (if a false true)))"
|
||||
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
||||
REP "(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)))))))"
|
||||
REP "(def! inc (fn* [x] (+ x 1)))"
|
||||
REP "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))"
|
||||
REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) \`(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))"
|
||||
|
||||
# load/run file from command line (then exit)
|
||||
if [[ "${1}" ]]; then
|
||||
|
@ -537,10 +537,6 @@ MAIN:
|
||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
|
||||
A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
@ -570,10 +570,6 @@ MAIN:
|
||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
|
||||
A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
@ -569,18 +569,6 @@ MAIN:
|
||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(def! inc (fn* [x] (+ x 1)))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "+CHR$(34)
|
||||
A$=A$+"G__"+CHR$(34)+" (swap! counter inc))))))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
|
||||
A$=A$+" (let* (c (gensym)) `(let* (~c ~(first xs))"
|
||||
A$=A$+" (if ~c ~c (or ~@(rest xs)))))))))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
@ -22,7 +22,6 @@ RESTORE +0
|
||||
DATA (def! not (fn* (a) (if a false true)))
|
||||
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
|
||||
DATA (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)))))))
|
||||
DATA (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))
|
||||
DATA ""
|
||||
REPEAT
|
||||
READ form$
|
||||
|
@ -22,7 +22,6 @@ RESTORE +0
|
||||
DATA (def! not (fn* (a) (if a false true)))
|
||||
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
|
||||
DATA (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)))))))
|
||||
DATA (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))
|
||||
DATA ""
|
||||
REPEAT
|
||||
READ form$
|
||||
|
@ -22,9 +22,6 @@ RESTORE +0
|
||||
DATA (def! not (fn* (a) (if a false true)))
|
||||
DATA (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))
|
||||
DATA (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)))))))
|
||||
DATA (def! inc (fn* [x] (+ x 1)))
|
||||
DATA (def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc))))))
|
||||
DATA (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))
|
||||
DATA (def! *host-language* "BBC BASIC V")
|
||||
DATA ""
|
||||
REPEAT
|
||||
|
@ -291,7 +291,6 @@ void init_repl_env(int argc, char *argv[]) {
|
||||
RE(repl_env, "",
|
||||
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
RE(repl_env, "", "(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)))))))");
|
||||
RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
}
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
|
@ -316,7 +316,6 @@ void init_repl_env(int argc, char *argv[]) {
|
||||
RE(repl_env, "",
|
||||
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
RE(repl_env, "", "(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)))))))");
|
||||
RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
}
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
|
@ -322,9 +322,6 @@ void init_repl_env(int argc, char *argv[]) {
|
||||
RE(repl_env, "",
|
||||
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
RE(repl_env, "", "(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)))))))");
|
||||
RE(repl_env, "", "(def! inc (fn* [x] (+ x 1)))");
|
||||
RE(repl_env, "", "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
|
||||
RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
|
||||
}
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
|
@ -435,9 +435,7 @@ fun string rep(string input)
|
||||
|
||||
rep("(def! not (fn* (a) (if a false true)))");
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
|
||||
rep("(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)))))))");
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
|
||||
fun void main()
|
||||
{
|
||||
|
@ -452,9 +452,7 @@ fun string rep(string input)
|
||||
|
||||
rep("(def! not (fn* (a) (if a false true)))");
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
|
||||
rep("(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)))))))");
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
|
||||
fun void main()
|
||||
{
|
||||
|
@ -454,13 +454,8 @@ fun string rep(string input)
|
||||
|
||||
rep("(def! not (fn* (a) (if a false true)))");
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
|
||||
rep("(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)))))))");
|
||||
|
||||
rep("(def! inc (fn* [x] (+ x 1)))");
|
||||
rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
|
||||
|
||||
fun void main()
|
||||
{
|
||||
int done;
|
||||
|
@ -153,7 +153,6 @@
|
||||
(rep "(def! not (fn* [a] (if a false true)))")
|
||||
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(rep "(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)))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
;; repl loop
|
||||
(defn repl-loop []
|
||||
|
@ -170,7 +170,6 @@
|
||||
(rep "(def! not (fn* [a] (if a false true)))")
|
||||
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(rep "(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)))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
;; repl loop
|
||||
(defn repl-loop []
|
||||
|
@ -180,9 +180,6 @@
|
||||
(rep "(def! not (fn* [a] (if a false true)))")
|
||||
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(rep "(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)))))))")
|
||||
(rep "(def! inc (fn* [x] (+ x 1)))")
|
||||
(rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
|
||||
|
||||
;; repl loop
|
||||
(defn repl-loop []
|
||||
|
@ -107,7 +107,6 @@ repl_env.set types._symbol('*ARGV*'), []
|
||||
rep("(def! not (fn* (a) (if a false true)))");
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
rep("(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)))))))")
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
if process? && process.argv.length > 2
|
||||
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
||||
|
@ -116,7 +116,6 @@ repl_env.set types._symbol('*ARGV*'), []
|
||||
rep("(def! not (fn* (a) (if a false true)))");
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
rep("(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)))))))")
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
if process? && process.argv.length > 2
|
||||
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
||||
|
@ -123,9 +123,6 @@ rep("(def! *host-language* \"CoffeeScript\")")
|
||||
rep("(def! not (fn* (a) (if a false true)))");
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
rep("(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)))))))")
|
||||
rep("(def! inc (fn* [x] (+ x 1)))");
|
||||
rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
|
||||
|
||||
if process? && process.argv.length > 2
|
||||
repl_env.set types._symbol('*ARGV*'), process.argv[3..]
|
||||
|
@ -228,7 +228,6 @@
|
||||
(rep "(def! not (fn* (a) (if a false true)))")
|
||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(rep "(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)))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
(defvar *use-readline-p* nil)
|
||||
|
||||
|
@ -251,7 +251,6 @@
|
||||
(rep "(def! not (fn* (a) (if a false true)))")
|
||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(rep "(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)))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
(defvar *use-readline-p* nil)
|
||||
|
||||
|
@ -259,9 +259,6 @@
|
||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(rep "(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)))))))")
|
||||
(rep "(def! *host-language* \"common-lisp\")")
|
||||
(rep "(def! inc (fn* [x] (+ x 1)))")
|
||||
(rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
|
||||
|
||||
(defvar *use-readline-p* nil)
|
||||
|
||||
|
@ -280,7 +280,6 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
|
||||
|
||||
static const char* malFunctionTable[] = {
|
||||
"(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)))))))",
|
||||
"(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))",
|
||||
"(def! not (fn* (cond) (if cond false true)))",
|
||||
"(def! load-file (fn* (filename) \
|
||||
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",
|
||||
|
@ -329,7 +329,6 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
|
||||
|
||||
static const char* malFunctionTable[] = {
|
||||
"(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)))))))",
|
||||
"(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))",
|
||||
"(def! not (fn* (cond) (if cond false true)))",
|
||||
"(def! load-file (fn* (filename) \
|
||||
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",
|
||||
|
@ -330,12 +330,9 @@ static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
|
||||
|
||||
static const char* malFunctionTable[] = {
|
||||
"(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)))))))",
|
||||
"(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))",
|
||||
"(def! not (fn* (cond) (if cond false true)))",
|
||||
"(def! load-file (fn* (filename) \
|
||||
(eval (read-string (str \"(do \" (slurp filename) \")\")))))",
|
||||
"(def! inc (fn* [x] (+ x 1)))",
|
||||
"(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))",
|
||||
"(def! *host-language* \"C++\")",
|
||||
};
|
||||
|
||||
|
@ -231,7 +231,6 @@ REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0
|
||||
Mal.rep "(def! not (fn* (a) (if a false true)))"
|
||||
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
||||
Mal.rep "(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)))))))"
|
||||
Mal.rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
|
||||
argv = Mal::List.new
|
||||
REPL_ENV.set("*ARGV*", Mal::Type.new argv)
|
||||
|
@ -248,7 +248,6 @@ REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0
|
||||
Mal.rep "(def! not (fn* (a) (if a false true)))"
|
||||
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
||||
Mal.rep "(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)))))))"
|
||||
Mal.rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
|
||||
argv = Mal::List.new
|
||||
REPL_ENV.set("*ARGV*", Mal::Type.new argv)
|
||||
|
@ -254,9 +254,6 @@ REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0
|
||||
Mal.rep "(def! not (fn* (a) (if a false true)))"
|
||||
Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
|
||||
Mal.rep "(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)))))))"
|
||||
Mal.rep "(def! inc (fn* [x] (+ x 1)))"
|
||||
Mal.rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))"
|
||||
Mal.rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))"
|
||||
Mal.rep("(def! *host-language* \"crystal\")")
|
||||
|
||||
argv = Mal::List.new
|
||||
|
@ -227,7 +227,6 @@ namespace Mal {
|
||||
RE("(def! not (fn* (a) (if a false true)))");
|
||||
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
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)))))))");
|
||||
RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
|
||||
if (args.Length > fileIdx) {
|
||||
RE("(load-file \"" + args[fileIdx] + "\")");
|
||||
|
@ -248,7 +248,6 @@ namespace Mal {
|
||||
RE("(def! not (fn* (a) (if a false true)))");
|
||||
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
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)))))))");
|
||||
RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
|
||||
if (args.Length > fileIdx) {
|
||||
RE("(load-file \"" + args[fileIdx] + "\")");
|
||||
|
@ -249,9 +249,6 @@ namespace Mal {
|
||||
RE("(def! not (fn* (a) (if a false true)))");
|
||||
RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
|
||||
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)))))))");
|
||||
RE("(def! inc (fn* [x] (+ x 1)))");
|
||||
RE("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
|
||||
RE("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
|
||||
|
||||
if (args.Length > fileIdx) {
|
||||
RE("(load-file \"" + args[fileIdx] + "\")");
|
||||
|
@ -263,7 +263,6 @@ void main(string[] args)
|
||||
re("(def! not (fn* (a) (if a false true)))", repl_env);
|
||||
re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env);
|
||||
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)))))))", repl_env);
|
||||
re("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env);
|
||||
|
||||
if (args.length > 1)
|
||||
{
|
||||
|
@ -292,7 +292,6 @@ void main(string[] args)
|
||||
re("(def! not (fn* (a) (if a false true)))", repl_env);
|
||||
re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env);
|
||||
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)))))))", repl_env);
|
||||
re("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env);
|
||||
|
||||
if (args.length > 1)
|
||||
{
|
||||
|
@ -294,9 +294,6 @@ void main(string[] args)
|
||||
re("(def! not (fn* (a) (if a false true)))", repl_env);
|
||||
re("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env);
|
||||
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)))))))", repl_env);
|
||||
re("(def! inc (fn* [x] (+ x 1)))", repl_env);
|
||||
re("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))", repl_env);
|
||||
re("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))", repl_env);
|
||||
|
||||
if (args.length > 1)
|
||||
{
|
||||
|
@ -27,12 +27,6 @@ void setupEnv(List<String> argv) {
|
||||
" (nth xs 1) "
|
||||
" (throw \"odd number of forms to cond\")) "
|
||||
" (cons 'cond (rest (rest xs)))))))");
|
||||
rep("(defmacro! or "
|
||||
" (fn* (& xs) (if (empty? xs) nil "
|
||||
" (if (= 1 (count xs)) "
|
||||
" (first xs) "
|
||||
" `(let* (or_FIXME ~(first xs)) "
|
||||
" (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
}
|
||||
|
||||
/// Returns `true` if [ast] is a macro call.
|
||||
|
@ -27,12 +27,6 @@ void setupEnv(List<String> argv) {
|
||||
" (nth xs 1) "
|
||||
" (throw \"odd number of forms to cond\")) "
|
||||
" (cons 'cond (rest (rest xs)))))))");
|
||||
rep("(defmacro! or "
|
||||
" (fn* (& xs) (if (empty? xs) nil "
|
||||
" (if (= 1 (count xs)) "
|
||||
" (first xs) "
|
||||
" `(let* (or_FIXME ~(first xs)) "
|
||||
" (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
}
|
||||
|
||||
/// Returns `true` if [ast] is a macro call.
|
||||
@ -194,8 +188,7 @@ MalType EVAL(MalType ast, Env env) {
|
||||
ast = quasiquote(args.first);
|
||||
continue;
|
||||
} else if (symbol.value == 'macroexpand') {
|
||||
ast = macroexpand(args.first, env);
|
||||
continue;
|
||||
return macroexpand(args.first, env);
|
||||
} else if (symbol.value == 'try*') {
|
||||
var body = args.first;
|
||||
if (args.length < 2) {
|
||||
|
@ -29,20 +29,6 @@ void setupEnv(List<String> argv) {
|
||||
" (nth xs 1) "
|
||||
" (throw \"odd number of forms to cond\")) "
|
||||
" (cons 'cond (rest (rest xs)))))))");
|
||||
rep("(def! inc (fn* [x] (+ x 1)))");
|
||||
rep("(def! gensym"
|
||||
" (let* [counter (atom 0)]"
|
||||
" (fn* []"
|
||||
" (symbol (str \"G__\" (swap! counter inc))))))");
|
||||
rep("(defmacro! or "
|
||||
" (fn* (& xs) "
|
||||
" (if (empty? xs) "
|
||||
" nil "
|
||||
" (if (= 1 (count xs)) "
|
||||
" (first xs) "
|
||||
" (let* (condvar (gensym)) "
|
||||
" `(let* (~condvar ~(first xs)) "
|
||||
" (if ~condvar ~condvar (or ~@(rest xs)))))))))");
|
||||
}
|
||||
|
||||
/// Returns `true` if [ast] is a macro call.
|
||||
@ -204,8 +190,7 @@ MalType EVAL(MalType ast, Env env) {
|
||||
ast = quasiquote(args.first);
|
||||
continue;
|
||||
} else if (symbol.value == 'macroexpand') {
|
||||
ast = macroexpand(args.first, env);
|
||||
continue;
|
||||
return macroexpand(args.first, env);
|
||||
} else if (symbol.value == 'try*') {
|
||||
var body = args.first;
|
||||
if (args.length < 2) {
|
||||
|
@ -247,9 +247,6 @@
|
||||
<span class=file>step9_try.EXT</span>:
|
||||
<span class=function>EVAL</span>(<span class=var>ast</span>, <span class=var>env</span>):
|
||||
- set <span class=malsym>*host-language*</span> in <span class=var>repl_env</span> to host language name
|
||||
- <span class=malsym>inc</span>: define (using <span class=function>rep</span>()) a function incrementing an integer
|
||||
- <span class=malsym>gensym</span>: define using <span class=function>rep</span>()), return unique symbol
|
||||
- <span class=malsym>or</span>: use <span class=malsym>gensym</span> to fix <span class=malsym>or</span> macro
|
||||
<span class=function>main</span>(<span class=var>args</span>): <span class=function>rep</span>(<span class=string>"(println (str \"Mal [\" <span class=malsym>*host-language*</span> \"]\"))"</span>)
|
||||
</code></pre>
|
||||
</td>
|
||||
|
129
docs/exercises.md
Normal file
129
docs/exercises.md
Normal file
@ -0,0 +1,129 @@
|
||||
# Exercises to learn MAL
|
||||
|
||||
The process introduces LISP by describing the internals of selected
|
||||
low-level constructs. As a complementary and more traditional
|
||||
approach, you may want to solve the following exercises in the MAL
|
||||
language itself, using any of the existing implementations.
|
||||
|
||||
You are encouraged to use the shortcuts defined in the step files
|
||||
(`not`...) and `the `lib/` subdirectory (`reduce`...) whenever you
|
||||
find that they increase the readability.
|
||||
|
||||
The difficulty is progressive in each section, but they focus on
|
||||
related topics and it is recommended to start them in parallel.
|
||||
|
||||
Some solutions are given in the `examples` directory. Feel free to
|
||||
submit new solutions, or new exercises.
|
||||
|
||||
## Replace parts of the process with native constructs
|
||||
|
||||
Once you have a working implementation, you may want to implement
|
||||
parts of the process inside the MAL language itself. This has no other
|
||||
purpose than learning the MAL language. Once it exists, a built-in
|
||||
implementation will always be more efficient than a native
|
||||
implementation. Also, the functions described in MAL process are
|
||||
selected for educative purposes, so portability accross
|
||||
implementations does not matter much.
|
||||
|
||||
You may easily check your answers by passing them directly to the
|
||||
interpreter. They will hide the built-in functions carrying the same
|
||||
names, and the usual tests will check them.
|
||||
```
|
||||
make REGRESS=1 TEST_OPTS='--hard --pre-eval=\(load-file\ \"../answer.mal\"\)' test^IMPL^stepA
|
||||
```
|
||||
|
||||
- Implement `nil?`, `true?`, `false?`, `empty?` and `sequential` with
|
||||
another built-in function.
|
||||
|
||||
- Implement `>`, `<=` and `>=` with `<`.
|
||||
|
||||
- Implement `hash-map`, `list`, `prn` and `swap!` as non-recursive
|
||||
functions.
|
||||
|
||||
- Implement `count`, `nth`, `map`, `concat` and `conj` with the empty
|
||||
constructor `()`, `empty?`, `cons`, `first` and `rest`.
|
||||
|
||||
You may use `or` to make the definition of `nth` a bit less ugly,
|
||||
but avoid `cond` because its definition refers to `nth`.
|
||||
|
||||
Let `count` and `nth` benefit from tail call optimization.
|
||||
|
||||
Try to replace explicit recursions with calls to `reduce` and `foldr`.
|
||||
|
||||
Once you have tested your solution, you should comment at least
|
||||
`nth`. Many implementations, for example `foldr` in `core.mal`,
|
||||
rely on an efficient `nth` built-in function.
|
||||
|
||||
- Implement the `do` special as a non-recursive function. The special
|
||||
form will hide your implementation, so in order to test it, you will
|
||||
need to give it another name and adapt the test accordingly.
|
||||
|
||||
- Implement quoting with macros.
|
||||
The same remark applies.
|
||||
|
||||
- Implement most of `let*` as a macro that uses `fn*` and recursion.
|
||||
The same remark applies.
|
||||
A macro is necessary because a function would attempt to evaluate
|
||||
the first argument.
|
||||
|
||||
Once your answer passes most tests and you understand which part is
|
||||
tricky, you should search for black magic recipes on the web. Few of
|
||||
us mortals are known to have invented a full solution on their own.
|
||||
|
||||
- Implement `apply`.
|
||||
|
||||
- Implement maps using lists.
|
||||
- Recall how maps must be evaluated.
|
||||
- In the tests, you may want to replace `{...}` with `(hash-map ...)`.
|
||||
- An easy solution relies on lists alterning keys and values, so
|
||||
that the `hash-map` is only a list in reverse order so that the
|
||||
last definition takes precedence during searches.
|
||||
- As a more performant solution will use lists to construct trees,
|
||||
and ideally keep them balanced. You will find examples in most
|
||||
teaching material about functional languages.
|
||||
- Recall that `dissoc` is an optional feature. One you can implement
|
||||
dissoc is by assoc'ing a replacement value that is a magic delete
|
||||
keyword (e.g.: `__..DELETED..__`) which allows you to shadow
|
||||
values in the lower levels of the structure. The hash map
|
||||
functions have to detect that and do the right thing. e.g. `(keys
|
||||
...)` might have to keep track of deleted values as it is scanning
|
||||
the tree and not add those keys when it finds them further down
|
||||
the tree.
|
||||
|
||||
- Implement macros within MAL.
|
||||
|
||||
## More folds
|
||||
|
||||
- Compute the sum of a sequence of numbers.
|
||||
- Compute the product of a sequence of numbers.
|
||||
|
||||
- Compute the logical conjunction ("and") and disjunction ("or") of a
|
||||
sequence of MAL values interpreted as boolean values. For example,
|
||||
`(conjunction [true 1 0 "" "a" nil true {}])`
|
||||
should evaluate to `false` or `nil` because of the `nil` element.
|
||||
|
||||
Why are folds not the best solution here, in terms of average
|
||||
performances?
|
||||
|
||||
- Does "-2-3-4" translate to `(reduce - 0 [2 3 4])`?
|
||||
|
||||
- Suggest better solutions for
|
||||
`(reduce str "" xs)` and
|
||||
`(reduce concat [] xs)`.
|
||||
|
||||
- What does `(reduce (fn* [acc _] acc) xs)` nil answer?
|
||||
|
||||
- The answer is `(fn* [xs] (reduce (fn* [_ x] x) nil xs))`.
|
||||
What was the question?
|
||||
|
||||
- What is the intent of
|
||||
`(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)`?
|
||||
|
||||
Why is it the wrong answer?
|
||||
|
||||
- Though `(sum (map count xs))` or `(count (apply concat xs))` can be
|
||||
considered more readable, implement the same effect with a single loop.
|
||||
- Compute the maximal length in a list of lists.
|
||||
|
||||
- How would you name
|
||||
`(fn* [& fs] (foldr (fn* [f acc] (fn* [x] (f (acc x)))) identity fs))`?
|
@ -181,9 +181,7 @@
|
||||
|
||||
(rep "(def! not (fn* (a) (if a false true)))")
|
||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
|
||||
(rep "(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)))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
(defun readln (prompt)
|
||||
;; C-d throws an error
|
||||
|
@ -197,9 +197,7 @@
|
||||
|
||||
(rep "(def! not (fn* (a) (if a false true)))")
|
||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
|
||||
(rep "(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)))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
(defun readln (prompt)
|
||||
;; C-d throws an error
|
||||
|
@ -198,12 +198,7 @@
|
||||
|
||||
(rep "(def! not (fn* (a) (if a false true)))")
|
||||
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
|
||||
(rep "(def! inc (fn* [x] (+ x 1)))")
|
||||
(rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
|
||||
|
||||
(rep "(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)))))))")
|
||||
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
|
||||
|
||||
(defun readln (prompt)
|
||||
;; C-d throws an error
|
||||
|
@ -203,6 +203,7 @@ defmodule Mal.Core do
|
||||
|
||||
defp with_meta([{type, ast, _old_meta}, meta]), do: {type, ast, meta}
|
||||
defp with_meta([%Function{} = func, meta]), do: %{func | meta: meta}
|
||||
defp with_meta(_), do: nil
|
||||
|
||||
defp deref(args) do
|
||||
apply(&Mal.Atom.deref/1, args)
|
||||
|
@ -42,17 +42,6 @@ defmodule Mix.Tasks.Step8Macros do
|
||||
(cons 'cond (rest (rest xs)))))))"
|
||||
""", env)
|
||||
|
||||
# or:
|
||||
read_eval_print("""
|
||||
(defmacro! or
|
||||
(fn* (& xs)
|
||||
(if (empty? xs)
|
||||
nil
|
||||
(if (= 1 (count xs))
|
||||
(first xs)
|
||||
`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))
|
||||
""", env)
|
||||
|
||||
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
|
||||
eval(ast, env)
|
||||
end})
|
||||
|
@ -42,17 +42,6 @@ defmodule Mix.Tasks.Step9Try do
|
||||
(cons 'cond (rest (rest xs)))))))"
|
||||
""", env)
|
||||
|
||||
# or:
|
||||
read_eval_print("""
|
||||
(defmacro! or
|
||||
(fn* (& xs)
|
||||
(if (empty? xs)
|
||||
nil
|
||||
(if (= 1 (count xs))
|
||||
(first xs)
|
||||
`(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))
|
||||
""", env)
|
||||
|
||||
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
|
||||
eval(ast, env)
|
||||
end})
|
||||
|
@ -50,28 +50,6 @@ defmodule Mix.Tasks.StepAMal do
|
||||
(cons 'cond (rest (rest xs)))))))"
|
||||
""", env)
|
||||
|
||||
# gensym
|
||||
read_eval_print("(def! inc (fn* [x] (+ x 1)))", env)
|
||||
read_eval_print("""
|
||||
(def! gensym
|
||||
(let* [counter (atom 0)]
|
||||
(fn* []
|
||||
(symbol (str \"G__\" (swap! counter inc))))))
|
||||
""", env)
|
||||
|
||||
# or:
|
||||
read_eval_print("""
|
||||
(defmacro! or
|
||||
(fn* (& xs)
|
||||
(if (empty? xs)
|
||||
nil
|
||||
(if (= 1 (count xs))
|
||||
(first xs)
|
||||
(let* (condvar (gensym))
|
||||
`(let* (~condvar ~(first xs))
|
||||
(if ~condvar ~condvar (or ~@(rest xs)))))))))
|
||||
""", env)
|
||||
|
||||
Mal.Env.set(env, "eval", %Function{value: fn [ast] ->
|
||||
eval(ast, env)
|
||||
end})
|
||||
|
@ -80,14 +80,6 @@ malInit =
|
||||
(nth xs 1)
|
||||
(throw "odd number of forms to cond"))
|
||||
(cons 'cond (rest (rest xs)))))))"""
|
||||
, """(defmacro! or
|
||||
(fn* (& xs)
|
||||
(if (empty? xs)
|
||||
nil
|
||||
(if (= 1 (count xs))
|
||||
(first xs)
|
||||
`(let* (or_FIXME ~(first xs))
|
||||
(if or_FIXME or_FIXME (or ~@(rest xs))))))))"""
|
||||
]
|
||||
|
||||
|
||||
|
@ -80,14 +80,6 @@ malInit =
|
||||
(nth xs 1)
|
||||
(throw "odd number of forms to cond"))
|
||||
(cons 'cond (rest (rest xs)))))))"""
|
||||
, """(defmacro! or
|
||||
(fn* (& xs)
|
||||
(if (empty? xs)
|
||||
nil
|
||||
(if (= 1 (count xs))
|
||||
(first xs)
|
||||
`(let* (or_FIXME ~(first xs))
|
||||
(if or_FIXME or_FIXME (or ~@(rest xs))))))))"""
|
||||
]
|
||||
|
||||
|
||||
|
@ -81,22 +81,6 @@ malInit =
|
||||
(nth xs 1)
|
||||
(throw "odd number of forms to cond"))
|
||||
(cons 'cond (rest (rest xs)))))))"""
|
||||
, """(def! inc (fn* [x] (+ x 1)))"""
|
||||
, """(def! gensym
|
||||
(let* [counter (atom 0)]
|
||||
(fn* []
|
||||
(symbol (str "G__" (swap! counter inc))))))"""
|
||||
, """(defmacro! or
|
||||
(fn* (& xs)
|
||||
(if (empty? xs)
|
||||
nil
|
||||
(if (= 1 (count xs))
|
||||
(first xs)
|
||||
(let* (condvar (gensym))
|
||||
`(let* (~condvar ~(first xs))
|
||||
(if ~condvar
|
||||
~condvar
|
||||
(or ~@(rest xs)))))))))"""
|
||||
]
|
||||
|
||||
|
||||
|
@ -20,7 +20,6 @@ init() ->
|
||||
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
|
||||
eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"), Env),
|
||||
eval(read("(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)))))))"), Env),
|
||||
eval(read("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME \~(first xs)) (if or_FIXME or_FIXME (or \~@(rest xs))))))))"), Env),
|
||||
Env.
|
||||
|
||||
loop(Env) ->
|
||||
|
@ -20,7 +20,6 @@ init() ->
|
||||
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
|
||||
eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"), Env),
|
||||
eval(read("(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)))))))"), Env),
|
||||
eval(read("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME \~(first xs)) (if or_FIXME or_FIXME (or \~@(rest xs))))))))"), Env),
|
||||
Env.
|
||||
|
||||
loop(Env) ->
|
||||
|
@ -22,9 +22,6 @@ init() ->
|
||||
eval(read("(def! not (fn* (a) (if a false true)))"), Env),
|
||||
eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"), Env),
|
||||
eval(read("(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)))))))"), Env),
|
||||
eval(read("(def! inc (fn* [x] (+ x 1)))"), Env),
|
||||
eval(read("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))"), Env),
|
||||
eval(read("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (\~condvar \~(first xs)) (if \~condvar \~condvar (or \~@(rest xs)))))))))"), Env),
|
||||
Env.
|
||||
|
||||
loop(Env) ->
|
||||
|
@ -128,7 +128,6 @@ env_set(repl_env, Symbol.for('*ARGV*'), [])
|
||||
REP('(def! not (fn* (a) (if a false true)))')
|
||||
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
|
||||
REP('(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)))))))')
|
||||
REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))')
|
||||
|
||||
if (process.argv.length > 2) {
|
||||
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
||||
|
@ -139,7 +139,6 @@ env_set(repl_env, Symbol.for('*ARGV*'), [])
|
||||
REP('(def! not (fn* (a) (if a false true)))')
|
||||
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
|
||||
REP('(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)))))))')
|
||||
REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))')
|
||||
|
||||
if (process.argv.length > 2) {
|
||||
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
||||
|
@ -140,9 +140,6 @@ REP('(def! *host-language* "ecmascript6")')
|
||||
REP('(def! not (fn* (a) (if a false true)))')
|
||||
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
|
||||
REP('(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)))))))')
|
||||
REP('(def! inc (fn* [x] (+ x 1)))')
|
||||
REP('(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))')
|
||||
REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))')
|
||||
|
||||
if (process.argv.length > 2) {
|
||||
env_set(repl_env, Symbol.for('*ARGV*'), process.argv.slice(3))
|
||||
|
170
examples/exercises.mal
Normal file
170
examples/exercises.mal
Normal file
@ -0,0 +1,170 @@
|
||||
;; These are the answers to the questions in ../docs/exercise.md.
|
||||
|
||||
;; In order to avoid unexpected circular dependencies among solutions,
|
||||
;; this files attempts to be self-contained.
|
||||
(def! identity (fn* [x] x))
|
||||
(def! reduce (fn* (f init xs)
|
||||
(if (empty? xs) init (reduce f (f init (first xs)) (rest xs)))))
|
||||
(def! foldr (fn* [f init xs]
|
||||
(if (empty? xs) init (f (first xs) (foldr f init (rest xs))))))
|
||||
|
||||
;; Reimplementations.
|
||||
|
||||
(def! nil? (fn* [x] (= x nil )))
|
||||
(def! true? (fn* [x] (= x true )))
|
||||
(def! false? (fn* [x] (= x false)))
|
||||
(def! empty? (fn* [x] (= x [] )))
|
||||
|
||||
(def! sequential?
|
||||
(fn* [x]
|
||||
(if (list? x) true (vector? x))))
|
||||
|
||||
(def! > (fn* [a b] (< b a) ))
|
||||
(def! <= (fn* [a b] (not (< b a))))
|
||||
(def! >= (fn* [a b] (not (< a b))))
|
||||
|
||||
(def! hash-map (fn* [& xs] (apply assoc {} xs)))
|
||||
(def! list (fn* [& xs] xs))
|
||||
(def! prn (fn* [& xs] (println (apply pr-str xs))))
|
||||
(def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs))))
|
||||
|
||||
(def! count
|
||||
(fn* [xs]
|
||||
(if (nil? xs)
|
||||
0
|
||||
(reduce (fn* [acc _] (+ 1 acc)) 0 xs))))
|
||||
(def! nth
|
||||
(fn* [xs index]
|
||||
(if (if (<= 0 index) (not (empty? xs))) ; logical and
|
||||
(if (= 0 index)
|
||||
(first xs)
|
||||
(nth (rest xs) (- index 1)))
|
||||
(throw "nth: index out of range"))))
|
||||
(def! map
|
||||
(fn* [f xs]
|
||||
(foldr (fn* [x acc] (cons (f x) acc)) () xs)))
|
||||
(def! concat
|
||||
(fn* [& xs]
|
||||
(foldr (fn* [xs ys] (foldr cons ys xs)) () xs)))
|
||||
(def! conj
|
||||
(fn* [xs & ys]
|
||||
(if (vector? xs)
|
||||
(apply vector (concat xs ys))
|
||||
(reduce (fn* [xs x] (cons x xs)) xs ys))))
|
||||
|
||||
(def! do2 (fn* [& xs] (nth xs (- (count xs) 1))))
|
||||
(def! do3 (fn* [& xs] (reduce (fn* [acc x] x) nil xs)))
|
||||
;; do2 will probably be more efficient when lists are implemented as
|
||||
;; arrays with direct indexing, but when they are implemented as
|
||||
;; linked lists, do3 may win because it only does one traversal.
|
||||
|
||||
(defmacro! quote (fn* [ast] (list (fn* [] ast))))
|
||||
(def! _quasiquote_iter (fn* [x acc]
|
||||
(if (if (list? x) (= (first x) 'splice-unquote)) ; logical and
|
||||
(list 'concat (first (rest x)) acc)
|
||||
(list 'cons (list 'quasiquote x) acc))))
|
||||
(defmacro! quasiquote (fn* [ast]
|
||||
(if (list? ast)
|
||||
(if (= (first ast) 'unquote)
|
||||
(first (rest ast))
|
||||
(foldr _quasiquote_iter () ast))
|
||||
(if (vector? ast)
|
||||
;; TODO: once tests are fixed, replace 'list with 'vector.
|
||||
(list 'apply 'list (foldr _quasiquote_iter () ast))
|
||||
(list 'quote ast)))))
|
||||
|
||||
(def! _letA_keys (fn* [binds]
|
||||
(if (empty? binds)
|
||||
()
|
||||
(cons (first binds) (_letA_keys (rest (rest binds)))))))
|
||||
(def! _letA_values (fn* [binds]
|
||||
(if (empty? binds)
|
||||
()
|
||||
(_letA_keys (rest binds)))))
|
||||
(def! _letA (fn* [binds form]
|
||||
(cons (list 'fn* (_letA_keys binds) form) (_letA_values binds))))
|
||||
;; Fails for (let* [a 1 b (+ 1 a)] b)
|
||||
(def! _letB (fn* [binds form]
|
||||
(if (empty? binds)
|
||||
form
|
||||
(list (list 'fn* [(first binds)] (_letB (rest (rest binds)) form))
|
||||
(first (rest binds))))))
|
||||
;; Fails for (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1))
|
||||
(def! _c_combinator (fn* [x] (x x)))
|
||||
(def! _d_combinator (fn* [f] (fn* [x] (f (fn* [v] ((x x) v))))))
|
||||
(def! _Y_combinator (fn* [x] (_c_combinator (_d_combinator x))))
|
||||
(def! _letC
|
||||
(fn* [binds form]
|
||||
(if (empty? binds)
|
||||
form
|
||||
(list (list 'fn* [(first binds)] (_letC (rest (rest binds)) form))
|
||||
(list '_Y_combinator (list 'fn* [(first binds)] (first (rest binds))))))))
|
||||
;; Fails for mutual recursion.
|
||||
;; See http://okmij.org/ftp/Computation/fixed-point-combinators.html
|
||||
;; if you are motivated to implement solution D.
|
||||
(defmacro! let* _letC)
|
||||
|
||||
(def! apply
|
||||
;; Replace (f a b [c d]) with ('f 'a 'b 'c 'd) then evaluate the
|
||||
;; resulting function call (the surrounding environment does not
|
||||
;; matter when evaluating a function call).
|
||||
;; Use nil as marker to detect deepest recursive call.
|
||||
(let* [q (fn* [x] (list 'quote x))
|
||||
iter (fn* [x acc]
|
||||
(if (nil? acc) ; x is the last element (a sequence)
|
||||
(map q x)
|
||||
(cons (q x) acc)))]
|
||||
(fn* [& xs] (eval (foldr iter nil xs)))))
|
||||
|
||||
;; Folds
|
||||
|
||||
(def! sum (fn* [xs] (reduce + 0 xs)))
|
||||
(def! product (fn* [xs] (reduce * 1 xs)))
|
||||
|
||||
(def! conjunction
|
||||
(let* [and2 (fn* [acc x] (if acc x false))]
|
||||
(fn* [xs]
|
||||
(reduce and2 true xs))))
|
||||
(def! disjunction
|
||||
(let* [or2 (fn* [acc x] (if acc true x))]
|
||||
(fn* [xs]
|
||||
(reduce or2 false xs))))
|
||||
;; It would be faster to stop the iteration on first failure
|
||||
;; (conjunction) or success (disjunction). Even better, `or` in the
|
||||
;; stepA and `and` in `core.mal` stop evaluating their arguments.
|
||||
|
||||
;; Yes, -2-3-4 means (((0-2)-3)-4).
|
||||
|
||||
;; `(reduce str "" xs)` is equivalent to `apply str xs`
|
||||
;; and `(reduce concat () xs)` is equivalent to `apply concat xs`.
|
||||
;; The built-in iterations are probably faster.
|
||||
|
||||
;; `(reduce (fn* [acc _] acc) nil xs)` is equivalent to `nil`.
|
||||
|
||||
;; For (reduce (fn* [acc x] x) nil xs))), see do3 above.
|
||||
|
||||
;; `(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)` computes the
|
||||
;; maximum of a list of non-negative integers. It is hard to find an
|
||||
;; initial value fitting all purposes.
|
||||
|
||||
(def! sum_len
|
||||
(let* [add_len (fn* [acc x] (+ acc (count x)))]
|
||||
(fn* [xs]
|
||||
(reduce add_len 0 xs))))
|
||||
(def! max_len
|
||||
(let* [update_max (fn* [acc x] (let* [l (count x)] (if (< acc l) l acc)))]
|
||||
(fn* [xs]
|
||||
(reduce update_max 0 xs))))
|
||||
|
||||
(def! compose
|
||||
(let* [compose2 (fn* [f acc] (fn* [x] (f (acc x))))]
|
||||
(fn* [& fs]
|
||||
(foldr compose2 identity fs))))
|
||||
;; ((compose f1 f2) x) is equivalent to (f1 (f2 x))
|
||||
;; This is the mathematical composition. For practical purposes, `->`
|
||||
;; and `->>` defined in `core.mal` are more efficient and general.
|
||||
|
||||
;; This `nil` is intentional so that the result of doing `load-file` is
|
||||
;; `nil` instead of whatever happens to be the last definiton.
|
||||
;; FIXME: can be removed after merge of load-file-trailing-new-line-nil
|
||||
nil
|
@ -141,7 +141,6 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at
|
||||
(def! not (fn* (a) (if a false true)))
|
||||
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
|
||||
(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)))))))
|
||||
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))
|
||||
" string-lines harvest [ REP drop ] each
|
||||
|
||||
MAIN: main
|
||||
|
@ -153,7 +153,6 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at
|
||||
(def! not (fn* (a) (if a false true)))
|
||||
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
|
||||
(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)))))))
|
||||
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))
|
||||
" string-lines harvest [ REP drop ] each
|
||||
|
||||
MAIN: main
|
||||
|
@ -50,8 +50,12 @@ DEFER: EVAL
|
||||
:: eval-try* ( params env -- maltype )
|
||||
[ params first env EVAL ]
|
||||
[
|
||||
params second second env new-env [ env-set ] keep
|
||||
params second third swap EVAL
|
||||
params length 1 > [
|
||||
params second second env new-env [ env-set ] keep
|
||||
params second third swap EVAL
|
||||
] [
|
||||
throw
|
||||
] if
|
||||
] recover ;
|
||||
|
||||
: args-split ( bindlist -- bindlist restbinding/f )
|
||||
@ -121,7 +125,11 @@ M: callable apply call( x -- y ) f ;
|
||||
: PRINT ( maltype -- str ) pr-str ;
|
||||
|
||||
: REP ( str -- str )
|
||||
[ READ repl-env get EVAL ] [ nip ] recover PRINT ;
|
||||
[
|
||||
READ repl-env get EVAL PRINT
|
||||
] [
|
||||
nip pr-str "Error: " swap append
|
||||
] recover ;
|
||||
|
||||
: REPL ( -- )
|
||||
"(println (str \"Mal [\" *host-language* \"]\"))" REP drop
|
||||
@ -147,9 +155,6 @@ command-line get dup empty? [ rest ] unless "*ARGV*" pick set-at
|
||||
(def! not (fn* (a) (if a false true)))
|
||||
(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))
|
||||
(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)))))))
|
||||
(def! inc (fn* [x] (+ x 1)))
|
||||
(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))
|
||||
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))
|
||||
" string-lines harvest [ READ repl-env get EVAL drop ] each
|
||||
|
||||
MAIN: main
|
||||
|
@ -153,7 +153,6 @@ class Main
|
||||
REP("(def! not (fn* (a) (if a false true)))", repl_env)
|
||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env)
|
||||
REP("(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)))))))", repl_env)
|
||||
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env)
|
||||
|
||||
if (!args.isEmpty)
|
||||
{
|
||||
|
@ -165,7 +165,6 @@ class Main
|
||||
REP("(def! not (fn* (a) (if a false true)))", repl_env)
|
||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env)
|
||||
REP("(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)))))))", repl_env)
|
||||
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))", repl_env)
|
||||
|
||||
if (!args.isEmpty)
|
||||
{
|
||||
|
@ -166,9 +166,6 @@ class Main
|
||||
REP("(def! not (fn* (a) (if a false true)))", repl_env)
|
||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env)
|
||||
REP("(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)))))))", repl_env)
|
||||
REP("(def! inc (fn* [x] (+ x 1)))", repl_env)
|
||||
REP("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))", repl_env)
|
||||
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))", repl_env)
|
||||
|
||||
if (!args.isEmpty)
|
||||
{
|
||||
|
@ -310,7 +310,6 @@ defcore swap! { argv argc -- val }
|
||||
s\" (def! not (fn* (x) (if x false true)))" rep 2drop
|
||||
s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
|
||||
s\" (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)))))))" rep 2drop
|
||||
s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" rep 2drop
|
||||
|
||||
: repl ( -- )
|
||||
begin
|
||||
|
@ -353,7 +353,6 @@ defcore map ( argv argc -- list )
|
||||
s\" (def! not (fn* (x) (if x false true)))" rep 2drop
|
||||
s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
|
||||
s\" (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)))))))" rep 2drop
|
||||
s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" rep 2drop
|
||||
|
||||
: repl ( -- )
|
||||
begin
|
||||
|
@ -361,9 +361,6 @@ s\" (def! *host-language* \"forth\")" rep 2drop
|
||||
s\" (def! not (fn* (x) (if x false true)))" rep 2drop
|
||||
s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
|
||||
s\" (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)))))))" rep 2drop
|
||||
s\" (def! inc (fn* [x] (+ x 1)))" rep 2drop
|
||||
s\" (def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))" rep 2drop
|
||||
s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))" rep 2drop
|
||||
|
||||
: repl ( -- )
|
||||
s\" (println (str \"Mal [\" *host-language* \"]\"))" rep 2drop
|
||||
|
@ -186,7 +186,6 @@ module REPL
|
||||
RE env """
|
||||
(def! not (fn* (a) (if a false true)))
|
||||
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
|
||||
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_ ~(first xs)) (if or_ or_ (or ~@(rest xs))))))))
|
||||
(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)))))))
|
||||
""" |> Seq.iter ignore
|
||||
|
||||
|
@ -206,7 +206,6 @@ module REPL
|
||||
RE env """
|
||||
(def! not (fn* (a) (if a false true)))
|
||||
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
|
||||
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_ ~(first xs)) (if or_ or_ (or ~@(rest xs))))))))
|
||||
(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)))))))
|
||||
""" |> Seq.iter ignore
|
||||
|
||||
|
@ -218,9 +218,6 @@ module REPL
|
||||
(def! not (fn* (a) (if a false true)))
|
||||
(def! load-file (fn* (f) (eval (read-string (slurp f)))))
|
||||
(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)))))))
|
||||
(def! inc (fn* [x] (+ x 1)))
|
||||
(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc))))))
|
||||
(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))
|
||||
""" |> Seq.iter ignore
|
||||
|
||||
env
|
||||
|
@ -270,9 +270,7 @@ replEnv set: #'*ARGV*' value: (MALList new: argv).
|
||||
|
||||
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
|
||||
MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
|
||||
|
||||
MAL rep: '(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)))))))' env: replEnv.
|
||||
MAL rep: '(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))' env: replEnv.
|
||||
|
||||
Smalltalk arguments notEmpty ifTrue: [
|
||||
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
||||
|
@ -291,9 +291,7 @@ replEnv set: #'*ARGV*' value: (MALList new: argv).
|
||||
|
||||
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
|
||||
MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
|
||||
|
||||
MAL rep: '(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)))))))' env: replEnv.
|
||||
MAL rep: '(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))' env: replEnv.
|
||||
|
||||
Smalltalk arguments notEmpty ifTrue: [
|
||||
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
||||
|
@ -292,11 +292,7 @@ replEnv set: #'*host-language*' value: (MALString new: 'smalltalk').
|
||||
|
||||
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
|
||||
MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
|
||||
|
||||
MAL rep: '(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)))))))' env: replEnv.
|
||||
MAL rep: '(def! inc (fn* [x] (+ x 1)))' env: replEnv.
|
||||
MAL rep: '(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc))))))' env: replEnv.
|
||||
MAL rep: '(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))' env: replEnv.
|
||||
|
||||
Smalltalk arguments notEmpty ifTrue: [
|
||||
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
||||
|
@ -311,7 +311,6 @@ func main() {
|
||||
rep("(def! not (fn* (a) (if a false true)))")
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
rep("(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)))))))")
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
// called with mal script to load and eval
|
||||
if len(os.Args) > 1 {
|
||||
|
@ -339,7 +339,6 @@ func main() {
|
||||
rep("(def! not (fn* (a) (if a false true)))")
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
rep("(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)))))))")
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
// called with mal script to load and eval
|
||||
if len(os.Args) > 1 {
|
||||
|
@ -340,9 +340,6 @@ func main() {
|
||||
rep("(def! not (fn* (a) (if a false true)))")
|
||||
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
rep("(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)))))))")
|
||||
rep("(def! inc (fn* [x] (+ x 1)))")
|
||||
rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
|
||||
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
|
||||
|
||||
// called with mal script to load and eval
|
||||
if len(os.Args) > 1 {
|
||||
|
@ -150,7 +150,6 @@ repl_env.set(new MalSymbol("*ARGV*"), this.args as List)
|
||||
REP("(def! not (fn* (a) (if a false true)))")
|
||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
REP("(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)))))))");
|
||||
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
|
||||
|
||||
if (this.args.size() > 0) {
|
||||
|
@ -168,7 +168,6 @@ repl_env.set(new MalSymbol("*ARGV*"), this.args as List)
|
||||
REP("(def! not (fn* (a) (if a false true)))")
|
||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
REP("(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)))))))");
|
||||
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
|
||||
|
||||
|
||||
if (this.args.size() > 0) {
|
||||
|
@ -169,10 +169,6 @@ REP("(def! *host-language* \"groovy\")")
|
||||
REP("(def! not (fn* (a) (if a false true)))")
|
||||
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
REP("(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)))))))");
|
||||
REP("(def! inc (fn* [x] (+ x 1)))");
|
||||
REP("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))");
|
||||
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))");
|
||||
|
||||
|
||||
if (this.args.size() > 0) {
|
||||
repl_env.set(new MalSymbol("*ARGV*"), this.args.drop(1) as List)
|
||||
|
@ -150,7 +150,7 @@
|
||||
((callable? c)
|
||||
(let ((cc (make-callable ht
|
||||
(callable-unbox c)
|
||||
(and (hash-table? ht) (hash-ref ht "ismacro"))
|
||||
#f
|
||||
(callable-closure c))))
|
||||
cc))
|
||||
(else
|
||||
|
@ -130,9 +130,4 @@
|
||||
|
||||
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
||||
|
||||
;; NOTE: we have to reduce stack size to pass step5 test
|
||||
((@ (system vm vm) call-with-stack-overflow-handler)
|
||||
1024
|
||||
(lambda () (REPL))
|
||||
(lambda k (throw 'mal-error "stack overflow")))
|
||||
|
||||
(REPL)
|
||||
|
@ -163,7 +163,6 @@
|
||||
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
||||
(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(EVAL-string "(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)))))))")
|
||||
(EVAL-string "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
(let ((args (cdr (command-line))))
|
||||
(cond
|
||||
|
@ -186,7 +186,6 @@
|
||||
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
||||
(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(EVAL-string "(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)))))))")
|
||||
(EVAL-string "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
|
||||
|
||||
(let ((args (cdr (command-line))))
|
||||
(cond
|
||||
|
@ -183,9 +183,6 @@
|
||||
(EVAL-string "(def! not (fn* (x) (if x false true)))")
|
||||
(EVAL-string "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
|
||||
(EVAL-string "(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)))))))")
|
||||
(EVAL-string "(def! inc (fn* [x] (+ x 1)))")
|
||||
(EVAL-string "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
|
||||
(EVAL-string "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))")
|
||||
(EVAL-string "(def! *host-language* \"guile\")")
|
||||
|
||||
(let ((args (cdr (command-line))))
|
||||
|
@ -1,15 +0,0 @@
|
||||
;; Test recursive non-tail call function
|
||||
|
||||
(def! sum-to (fn* (n) (if (= n 0) 0 (+ n (sum-to (- n 1))))))
|
||||
|
||||
(sum-to 10)
|
||||
;=>55
|
||||
|
||||
;;; no try* yet, so test completion of side-effects
|
||||
(def! res1 nil)
|
||||
;=>nil
|
||||
;;; For implementations without their own TCO this should fail and
|
||||
;;; leave res1 unchanged
|
||||
(def! res1 (sum-to 10000))
|
||||
res1
|
||||
;=>nil
|
481
haskell/Core.hs
481
haskell/Core.hs
@ -3,313 +3,384 @@ module Core
|
||||
where
|
||||
|
||||
import System.IO (hFlush, stdout)
|
||||
import Control.Exception (catch)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.Trans (liftIO)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Foldable (foldlM)
|
||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.IORef (newIORef, readIORef, writeIORef)
|
||||
|
||||
import Readline (readline)
|
||||
import Reader (read_str)
|
||||
import Types
|
||||
import Printer (_pr_str, _pr_list)
|
||||
import Printer (_pr_list)
|
||||
|
||||
-- General functions
|
||||
|
||||
equal_Q [a, b] = return $ if a == b then MalTrue else MalFalse
|
||||
equal_Q :: Fn
|
||||
equal_Q [a, b] = return $ MalBoolean $ a == b
|
||||
equal_Q _ = throwStr "illegal arguments to ="
|
||||
|
||||
run_1 :: (MalVal -> MalVal) -> [MalVal] -> IOThrows MalVal
|
||||
run_1 f (x:[]) = return $ f x
|
||||
run_1 _ _ = throwStr "function takes a single argument"
|
||||
|
||||
run_2 :: (MalVal -> MalVal -> MalVal) -> [MalVal] -> IOThrows MalVal
|
||||
run_2 f (x:y:[]) = return $ f x y
|
||||
run_2 _ _ = throwStr "function takes a two arguments"
|
||||
|
||||
-- Error/Exception functions
|
||||
|
||||
throw (mv:[]) = throwMalVal mv
|
||||
throw :: Fn
|
||||
throw [mv] = throwError mv
|
||||
throw _ = throwStr "illegal arguments to throw"
|
||||
|
||||
-- Unary predicates
|
||||
|
||||
pred1 :: (MalVal -> Bool) -> Fn
|
||||
pred1 hostPred [x] = return $ MalBoolean $ hostPred x
|
||||
pred1 _ _ = throwStr "illegal call to unary predicate"
|
||||
|
||||
atom_Q :: MalVal -> Bool
|
||||
atom_Q (MalAtom _ _) = True
|
||||
atom_Q _ = False
|
||||
|
||||
false_Q :: MalVal -> Bool
|
||||
false_Q (MalBoolean False) = True
|
||||
false_Q _ = False
|
||||
|
||||
fn_Q :: MalVal -> Bool
|
||||
fn_Q (MalFunction {macro=False}) = True
|
||||
fn_Q _ = False
|
||||
|
||||
macro_Q :: MalVal -> Bool
|
||||
macro_Q (MalFunction {macro=True}) = True
|
||||
macro_Q _ = False
|
||||
|
||||
map_Q :: MalVal -> Bool
|
||||
map_Q (MalHashMap _ _) = True
|
||||
map_Q _ = False
|
||||
|
||||
keyword_Q :: MalVal -> Bool
|
||||
keyword_Q (MalString (c : _)) = c == keywordMagic
|
||||
keyword_Q _ = False
|
||||
|
||||
list_Q :: MalVal -> Bool
|
||||
list_Q (MalSeq _ (Vect False) _) = True
|
||||
list_Q _ = False
|
||||
|
||||
nil_Q :: MalVal -> Bool
|
||||
nil_Q Nil = True
|
||||
nil_Q _ = False
|
||||
|
||||
number_Q :: MalVal -> Bool
|
||||
number_Q (MalNumber _) = True
|
||||
number_Q _ = False
|
||||
|
||||
string_Q :: MalVal -> Bool
|
||||
string_Q (MalString "") = True
|
||||
string_Q (MalString (c : _)) = c /= keywordMagic
|
||||
string_Q _ = False
|
||||
|
||||
symbol_Q :: MalVal -> Bool
|
||||
symbol_Q (MalSymbol _) = True
|
||||
symbol_Q _ = False
|
||||
|
||||
true_Q :: MalVal -> Bool
|
||||
true_Q (MalBoolean True) = True
|
||||
true_Q _ = False
|
||||
|
||||
vector_Q :: MalVal -> Bool
|
||||
vector_Q (MalSeq _ (Vect True) _) = True
|
||||
vector_Q _ = False
|
||||
|
||||
-- Scalar functions
|
||||
|
||||
symbol (MalString str:[]) = return $ MalSymbol str
|
||||
symbol :: Fn
|
||||
symbol [MalString s] = return $ MalSymbol s
|
||||
symbol _ = throwStr "symbol called with non-string"
|
||||
|
||||
keyword (MalString ('\x029e':str):[]) = return $ MalString $ "\x029e" ++ str
|
||||
keyword (MalString str:[]) = return $ MalString $ "\x029e" ++ str
|
||||
keyword :: Fn
|
||||
keyword [kw@(MalString (c : _))] | c == keywordMagic = return kw
|
||||
keyword [MalString s] = return $ MalString (keywordMagic : s)
|
||||
keyword _ = throwStr "keyword called with non-string"
|
||||
|
||||
|
||||
-- String functions
|
||||
|
||||
pr_str args = do
|
||||
return $ MalString $ _pr_list True " " args
|
||||
pr_str :: Fn
|
||||
pr_str args = liftIO $ MalString <$> _pr_list True " " args
|
||||
|
||||
str args = do
|
||||
return $ MalString $ _pr_list False "" args
|
||||
str :: Fn
|
||||
str args = liftIO $ MalString <$> _pr_list False "" args
|
||||
|
||||
prn args = do
|
||||
liftIO $ putStrLn $ _pr_list True " " args
|
||||
liftIO $ hFlush stdout
|
||||
prn :: Fn
|
||||
prn args = liftIO $ do
|
||||
putStrLn =<< _pr_list True " " args
|
||||
hFlush stdout
|
||||
return Nil
|
||||
|
||||
println args = do
|
||||
liftIO $ putStrLn $ _pr_list False " " args
|
||||
liftIO $ hFlush stdout
|
||||
println :: Fn
|
||||
println args = liftIO $ do
|
||||
putStrLn =<< _pr_list False " " args
|
||||
hFlush stdout
|
||||
return Nil
|
||||
|
||||
slurp ([MalString path]) = do
|
||||
str <- liftIO $ readFile path
|
||||
return $ MalString str
|
||||
slurp :: Fn
|
||||
slurp [MalString path] = MalString <$> liftIO (readFile path)
|
||||
slurp _ = throwStr "invalid arguments to slurp"
|
||||
|
||||
do_readline ([MalString prompt]) = do
|
||||
str <- liftIO $ readline prompt
|
||||
case str of
|
||||
do_readline :: Fn
|
||||
do_readline [MalString prompt] = do
|
||||
maybeLine <- liftIO $ readline prompt
|
||||
case maybeLine of
|
||||
Nothing -> throwStr "readline failed"
|
||||
Just str -> return $ MalString str
|
||||
Just line -> return $ MalString line
|
||||
do_readline _ = throwStr "invalid arguments to readline"
|
||||
|
||||
read_string :: Fn
|
||||
read_string [MalString s] = read_str s
|
||||
read_string _ = throwStr "invalid read-string"
|
||||
|
||||
-- Numeric functions
|
||||
|
||||
num_op op [MalNumber a, MalNumber b] = do
|
||||
return $ MalNumber $ op a b
|
||||
num_op :: (Int -> Int -> Int) -> Fn
|
||||
num_op op [MalNumber a, MalNumber b] = return $ MalNumber $ op a b
|
||||
num_op _ _ = throwStr "illegal arguments to number operation"
|
||||
|
||||
cmp_op op [MalNumber a, MalNumber b] = do
|
||||
return $ if op a b then MalTrue else MalFalse
|
||||
cmp_op :: (Int -> Int -> Bool) -> Fn
|
||||
cmp_op op [MalNumber a, MalNumber b] = return $ MalBoolean $ op a b
|
||||
cmp_op _ _ = throwStr "illegal arguments to comparison operation"
|
||||
|
||||
time_ms _ = do
|
||||
t <- liftIO $ getPOSIXTime
|
||||
return $ MalNumber $ round (t * 1000)
|
||||
time_ms :: Fn
|
||||
time_ms [] = MalNumber . round . (* 1000) <$> liftIO getPOSIXTime
|
||||
time_ms _ = throwStr "invalid time-ms"
|
||||
|
||||
|
||||
-- List functions
|
||||
|
||||
list args = return $ MalList args Nil
|
||||
list :: Fn
|
||||
list = return . toList
|
||||
|
||||
-- Vector functions
|
||||
|
||||
vector args = return $ MalVector args Nil
|
||||
vector :: Fn
|
||||
vector = return . MalSeq (MetaData Nil) (Vect True)
|
||||
|
||||
-- Hash Map functions
|
||||
|
||||
_pairup [x] = throwStr "Odd number of elements to _pairup"
|
||||
_pairup [] = return []
|
||||
_pairup (MalString x:y:xs) = do
|
||||
rest <- _pairup xs
|
||||
return $ (x,y):rest
|
||||
hash_map :: Fn
|
||||
hash_map kvs =
|
||||
case keyValuePairs kvs of
|
||||
Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.fromList pairs
|
||||
Nothing -> throwStr "invalid call to hash-map"
|
||||
|
||||
hash_map args = do
|
||||
pairs <- _pairup args
|
||||
return $ MalHashMap (Map.fromList pairs) Nil
|
||||
|
||||
assoc (MalHashMap hm _:kvs) = do
|
||||
pairs <- _pairup kvs
|
||||
return $ MalHashMap (Map.union (Map.fromList pairs) hm) Nil
|
||||
assoc :: Fn
|
||||
assoc (MalHashMap _ hm : kvs) =
|
||||
case keyValuePairs kvs of
|
||||
Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.union (Map.fromList pairs) hm
|
||||
Nothing -> throwStr "invalid assoc"
|
||||
assoc _ = throwStr "invalid call to assoc"
|
||||
|
||||
dissoc (MalHashMap hm _:ks) = do
|
||||
let remover = (\hm (MalString k) -> Map.delete k hm) in
|
||||
return $ MalHashMap (foldl remover hm ks) Nil
|
||||
remover :: Map.Map String MalVal -> MalVal -> IOThrows (Map.Map String MalVal)
|
||||
remover m (MalString k) = return $ Map.delete k m
|
||||
remover _ _ = throwStr "invalid dissoc"
|
||||
|
||||
dissoc :: Fn
|
||||
dissoc (MalHashMap _ hm : ks) = MalHashMap (MetaData Nil) <$> foldlM remover hm ks
|
||||
dissoc _ = throwStr "invalid call to dissoc"
|
||||
|
||||
get (MalHashMap hm _:MalString k:[]) = do
|
||||
get :: Fn
|
||||
get [MalHashMap _ hm, MalString k] =
|
||||
case Map.lookup k hm of
|
||||
Just mv -> return mv
|
||||
Nothing -> return Nil
|
||||
get (Nil:MalString k:[]) = return Nil
|
||||
get [Nil, MalString _] = return Nil
|
||||
get _ = throwStr "invalid call to get"
|
||||
|
||||
contains_Q (MalHashMap hm _:MalString k:[]) = do
|
||||
if Map.member k hm then return MalTrue
|
||||
else return MalFalse
|
||||
contains_Q (Nil:MalString k:[]) = return MalFalse
|
||||
contains_Q :: Fn
|
||||
contains_Q [MalHashMap _ hm, MalString k] = return $ MalBoolean $ Map.member k hm
|
||||
contains_Q [Nil, MalString _] = return $ MalBoolean False
|
||||
contains_Q _ = throwStr "invalid call to contains?"
|
||||
|
||||
keys (MalHashMap hm _:[]) = do
|
||||
return $ MalList (map MalString (Map.keys hm)) Nil
|
||||
keys :: Fn
|
||||
keys [MalHashMap _ hm] = return $ toList $ MalString <$> Map.keys hm
|
||||
keys _ = throwStr "invalid call to keys"
|
||||
|
||||
vals (MalHashMap hm _:[]) = do
|
||||
return $ MalList (Map.elems hm) Nil
|
||||
vals :: Fn
|
||||
vals [MalHashMap _ hm] = return $ toList $ Map.elems hm
|
||||
vals _ = throwStr "invalid call to vals"
|
||||
|
||||
|
||||
-- Sequence functions
|
||||
|
||||
_sequential_Q (MalList _ _) = MalTrue
|
||||
_sequential_Q (MalVector _ _) = MalTrue
|
||||
_sequential_Q _ = MalFalse
|
||||
sequential_Q :: MalVal -> Bool
|
||||
sequential_Q (MalSeq _ _ _) = True
|
||||
sequential_Q _ = False
|
||||
|
||||
cons x Nil = MalList [x] Nil
|
||||
cons x (MalList lst _) = MalList (x:lst) Nil
|
||||
cons x (MalVector lst _) = MalList (x:lst) Nil
|
||||
cons :: Fn
|
||||
cons [x, Nil ] = return $ toList [x]
|
||||
cons [x, MalSeq _ _ lst] = return $ toList (x : lst)
|
||||
cons _ = throwStr "illegal call to cons"
|
||||
|
||||
concat1 a (MalList lst _) = a ++ lst
|
||||
concat1 a (MalVector lst _) = a ++ lst
|
||||
do_concat args = return $ MalList (foldl concat1 [] args) Nil
|
||||
unwrapSeq :: MalVal -> IOThrows [MalVal]
|
||||
unwrapSeq (MalSeq _ _ xs) = return xs
|
||||
unwrapSeq _ = throwStr "invalid concat"
|
||||
|
||||
nth ((MalList lst _):(MalNumber idx):[]) = do
|
||||
if idx < length lst then return $ lst !! idx
|
||||
else throwStr "nth: index out of range"
|
||||
nth ((MalVector lst _):(MalNumber idx):[]) = do
|
||||
if idx < length lst then return $ lst !! idx
|
||||
else throwStr "nth: index out of range"
|
||||
do_concat :: Fn
|
||||
do_concat args = toList . concat <$> mapM unwrapSeq args
|
||||
|
||||
nth :: Fn
|
||||
nth [MalSeq _ _ lst, MalNumber idx] =
|
||||
case drop idx lst of
|
||||
x : _ -> return x
|
||||
[] -> throwStr "nth: index out of range"
|
||||
-- See https://wiki.haskell.org/Avoiding_partial_functions
|
||||
nth _ = throwStr "invalid call to nth"
|
||||
|
||||
first Nil = Nil
|
||||
first (MalList lst _) = if length lst > 0 then lst !! 0 else Nil
|
||||
first (MalVector lst _) = if length lst > 0 then lst !! 0 else Nil
|
||||
first :: Fn
|
||||
first [Nil ] = return Nil
|
||||
first [MalSeq _ _ [] ] = return Nil
|
||||
first [MalSeq _ _ (x : _)] = return x
|
||||
first _ = throwStr "illegal call to first"
|
||||
|
||||
rest Nil = MalList [] Nil
|
||||
rest (MalList lst _) = MalList (drop 1 lst) Nil
|
||||
rest (MalVector lst _) = MalList (drop 1 lst) Nil
|
||||
rest :: Fn
|
||||
rest [Nil ] = return $ toList []
|
||||
rest [MalSeq _ _ [] ] = return $ toList []
|
||||
rest [MalSeq _ _ (_ : xs)] = return $ toList xs
|
||||
rest _ = throwStr "illegal call to rest"
|
||||
|
||||
empty_Q Nil = MalTrue
|
||||
empty_Q (MalList [] _) = MalTrue
|
||||
empty_Q (MalVector [] _) = MalTrue
|
||||
empty_Q _ = MalFalse
|
||||
empty_Q :: MalVal -> Bool
|
||||
empty_Q Nil = True
|
||||
empty_Q (MalSeq _ _ []) = True
|
||||
empty_Q _ = False
|
||||
|
||||
count (Nil:[]) = return $ MalNumber 0
|
||||
count (MalList lst _:[]) = return $ MalNumber $ length lst
|
||||
count (MalVector lst _:[]) = return $ MalNumber $ length lst
|
||||
count _ = throwStr $ "non-sequence passed to count"
|
||||
count :: Fn
|
||||
count [Nil ] = return $ MalNumber 0
|
||||
count [MalSeq _ _ lst] = return $ MalNumber $ length lst
|
||||
count _ = throwStr "non-sequence passed to count"
|
||||
|
||||
apply args = do
|
||||
f <- _get_call args
|
||||
lst <- _to_list (last args)
|
||||
f $ (init (drop 1 args)) ++ lst
|
||||
concatLast :: [MalVal] -> IOThrows [MalVal]
|
||||
concatLast [MalSeq _ _ lst] = return lst
|
||||
concatLast (a : as) = (a :) <$> concatLast as
|
||||
concatLast _ = throwStr "last argument of apply must be a sequence"
|
||||
|
||||
do_map args = do
|
||||
f <- _get_call args
|
||||
lst <- _to_list (args !! 1)
|
||||
do new_lst <- mapM (\x -> f [x]) lst
|
||||
return $ MalList new_lst Nil
|
||||
apply :: Fn
|
||||
apply (MalFunction {fn=f} : xs) = f =<< concatLast xs
|
||||
apply _ = throwStr "Illegal call to apply"
|
||||
|
||||
conj ((MalList lst _):args) = return $ MalList ((reverse args) ++ lst) Nil
|
||||
conj ((MalVector lst _):args) = return $ MalVector (lst ++ args) Nil
|
||||
conj _ = throwStr $ "illegal arguments to conj"
|
||||
do_map :: Fn
|
||||
do_map [MalFunction {fn=f}, MalSeq _ _ args] = toList <$> mapM (\x -> f [x]) args
|
||||
do_map _ = throwStr "Illegal call to map"
|
||||
|
||||
do_seq (l@(MalList [] _):[]) = return $ Nil
|
||||
do_seq (l@(MalList lst m):[]) = return $ l
|
||||
do_seq (MalVector [] _:[]) = return $ Nil
|
||||
do_seq (MalVector lst _:[]) = return $ MalList lst Nil
|
||||
do_seq (MalString []:[]) = return $ Nil
|
||||
do_seq (MalString s:[]) = return $ MalList [MalString [c] | c <- s] Nil
|
||||
do_seq (Nil:[]) = return $ Nil
|
||||
do_seq _ = throwStr $ "seq: called on non-sequence"
|
||||
conj :: Fn
|
||||
conj (MalSeq _ (Vect False) lst : args) = return $ toList $ reverse args ++ lst
|
||||
conj (MalSeq _ (Vect True) lst : args) = return $ MalSeq (MetaData Nil) (Vect True) $ lst ++ args
|
||||
conj _ = throwStr "illegal arguments to conj"
|
||||
|
||||
do_seq :: Fn
|
||||
do_seq [Nil ] = return Nil
|
||||
do_seq [MalSeq _ _ [] ] = return Nil
|
||||
do_seq [MalSeq _ _ lst ] = return $ toList lst
|
||||
do_seq [MalString "" ] = return Nil
|
||||
do_seq [MalString s ] = return $ toList $ MalString <$> pure <$> s
|
||||
do_seq _ = throwStr "seq: called on non-sequence"
|
||||
|
||||
-- Metadata functions
|
||||
|
||||
with_meta ((MalList lst _):m:[]) = return $ MalList lst m
|
||||
with_meta ((MalVector lst _):m:[]) = return $ MalVector lst m
|
||||
with_meta ((MalHashMap hm _):m:[]) = return $ MalHashMap hm m
|
||||
with_meta ((MalAtom atm _):m:[]) = return $ MalAtom atm m
|
||||
with_meta ((Func f _):m:[]) = return $ Func f m
|
||||
with_meta ((MalFunc {fn=f, ast=a, env=e, params=p, macro=mc}):m:[]) = do
|
||||
return $ MalFunc {fn=f, ast=a, env=e, params=p, macro=mc, meta=m}
|
||||
with_meta _ = throwStr $ "invalid with-meta call"
|
||||
with_meta :: Fn
|
||||
with_meta [MalSeq _ v x, m] = return $ MalSeq (MetaData m) v x
|
||||
with_meta [MalHashMap _ x, m] = return $ MalHashMap (MetaData m) x
|
||||
with_meta [MalAtom _ x, m] = return $ MalAtom (MetaData m) x
|
||||
with_meta [f@(MalFunction {}), m] = return $ f {meta=m}
|
||||
with_meta _ = throwStr "invalid with-meta call"
|
||||
|
||||
do_meta ((MalList _ m):[]) = return m
|
||||
do_meta ((MalVector _ m):[]) = return m
|
||||
do_meta ((MalHashMap _ m):[]) = return m
|
||||
do_meta ((MalAtom _ m):[]) = return m
|
||||
do_meta ((Func _ m):[]) = return m
|
||||
do_meta ((MalFunc {meta=m}):[]) = return m
|
||||
do_meta _ = throwStr $ "invalid meta call"
|
||||
do_meta :: Fn
|
||||
do_meta [MalSeq (MetaData m) _ _ ] = return m
|
||||
do_meta [MalHashMap (MetaData m) _] = return m
|
||||
do_meta [MalAtom (MetaData m) _ ] = return m
|
||||
do_meta [MalFunction {meta=m} ] = return m
|
||||
do_meta _ = throwStr "invalid meta call"
|
||||
|
||||
-- Atom functions
|
||||
|
||||
atom (val:[]) = do
|
||||
ref <- liftIO $ newIORef val
|
||||
return $ MalAtom ref Nil
|
||||
atom :: Fn
|
||||
atom [val] = MalAtom (MetaData Nil) <$> liftIO (newIORef val)
|
||||
atom _ = throwStr "invalid atom call"
|
||||
|
||||
deref (MalAtom ref _:[]) = do
|
||||
val <- liftIO $ readIORef ref
|
||||
return val
|
||||
deref :: Fn
|
||||
deref [MalAtom _ ref] = liftIO $ readIORef ref
|
||||
deref _ = throwStr "invalid deref call"
|
||||
|
||||
reset_BANG (MalAtom ref _:val:[]) = do
|
||||
reset_BANG :: Fn
|
||||
reset_BANG [MalAtom _ ref, val] = do
|
||||
liftIO $ writeIORef ref $ val
|
||||
return val
|
||||
reset_BANG _ = throwStr "invalid deref call"
|
||||
reset_BANG _ = throwStr "invalid reset!"
|
||||
|
||||
swap_BANG (MalAtom ref _:args) = do
|
||||
swap_BANG :: Fn
|
||||
swap_BANG (MalAtom _ ref : MalFunction {fn=f} : args) = do
|
||||
val <- liftIO $ readIORef ref
|
||||
f <- _get_call args
|
||||
new_val <- f $ [val] ++ (tail args)
|
||||
_ <- liftIO $ writeIORef ref $ new_val
|
||||
new_val <- f (val : args)
|
||||
liftIO $ writeIORef ref new_val
|
||||
return new_val
|
||||
swap_BANG _ = throwStr "Illegal swap!"
|
||||
|
||||
ns :: [(String, Fn)]
|
||||
ns = [
|
||||
("=", _func equal_Q),
|
||||
("throw", _func throw),
|
||||
("nil?", _func $ run_1 $ _nil_Q),
|
||||
("true?", _func $ run_1 $ _true_Q),
|
||||
("false?", _func $ run_1 $ _false_Q),
|
||||
("string?", _func $ run_1 $ _string_Q),
|
||||
("symbol", _func $ symbol),
|
||||
("symbol?", _func $ run_1 $ _symbol_Q),
|
||||
("keyword", _func $ keyword),
|
||||
("keyword?", _func $ run_1 $ _keyword_Q),
|
||||
("number?", _func $ run_1 $ _number_Q),
|
||||
("fn?", _func $ run_1 $ _fn_Q),
|
||||
("macro?", _func $ run_1 $ _macro_Q),
|
||||
("=", equal_Q),
|
||||
("throw", throw),
|
||||
("nil?", pred1 nil_Q),
|
||||
("true?", pred1 true_Q),
|
||||
("false?", pred1 false_Q),
|
||||
("string?", pred1 string_Q),
|
||||
("symbol", symbol),
|
||||
("symbol?", pred1 symbol_Q),
|
||||
("keyword", keyword),
|
||||
("keyword?", pred1 keyword_Q),
|
||||
("number?", pred1 number_Q),
|
||||
("fn?", pred1 fn_Q),
|
||||
("macro?", pred1 macro_Q),
|
||||
|
||||
("pr-str", _func pr_str),
|
||||
("str", _func str),
|
||||
("prn", _func prn),
|
||||
("println", _func println),
|
||||
("readline", _func do_readline),
|
||||
("read-string", _func (\[(MalString s)] -> read_str s)),
|
||||
("slurp", _func slurp),
|
||||
("pr-str", pr_str),
|
||||
("str", str),
|
||||
("prn", prn),
|
||||
("println", println),
|
||||
("readline", do_readline),
|
||||
("read-string", read_string),
|
||||
("slurp", slurp),
|
||||
|
||||
("<", _func $ cmp_op (<)),
|
||||
("<=", _func $ cmp_op (<=)),
|
||||
(">", _func $ cmp_op (>)),
|
||||
(">=", _func $ cmp_op (>=)),
|
||||
("+", _func $ num_op (+)),
|
||||
("-", _func $ num_op (-)),
|
||||
("*", _func $ num_op (*)),
|
||||
("/", _func $ num_op (div)),
|
||||
("time-ms", _func $ time_ms),
|
||||
("<", cmp_op (<)),
|
||||
("<=", cmp_op (<=)),
|
||||
(">", cmp_op (>)),
|
||||
(">=", cmp_op (>=)),
|
||||
("+", num_op (+)),
|
||||
("-", num_op (-)),
|
||||
("*", num_op (*)),
|
||||
("/", num_op (div)),
|
||||
("time-ms", time_ms),
|
||||
|
||||
("list", _func $ list),
|
||||
("list?", _func $ run_1 _list_Q),
|
||||
("vector", _func $ vector),
|
||||
("vector?", _func $ run_1 _vector_Q),
|
||||
("hash-map", _func $ hash_map),
|
||||
("map?", _func $ run_1 _hash_map_Q),
|
||||
("assoc", _func $ assoc),
|
||||
("dissoc", _func $ dissoc),
|
||||
("get", _func $ get),
|
||||
("contains?",_func $ contains_Q),
|
||||
("keys", _func $ keys),
|
||||
("vals", _func $ vals),
|
||||
("list", list),
|
||||
("list?", pred1 list_Q),
|
||||
("vector", vector),
|
||||
("vector?", pred1 vector_Q),
|
||||
("hash-map", hash_map),
|
||||
("map?", pred1 map_Q),
|
||||
("assoc", assoc),
|
||||
("dissoc", dissoc),
|
||||
("get", get),
|
||||
("contains?", contains_Q),
|
||||
("keys", keys),
|
||||
("vals", vals),
|
||||
|
||||
("sequential?", _func $ run_1 _sequential_Q),
|
||||
("cons", _func $ run_2 $ cons),
|
||||
("concat", _func $ do_concat),
|
||||
("nth", _func nth),
|
||||
("first", _func $ run_1 $ first),
|
||||
("rest", _func $ run_1 $ rest),
|
||||
("empty?", _func $ run_1 $ empty_Q),
|
||||
("count", _func $ count),
|
||||
("apply", _func $ apply),
|
||||
("map", _func $ do_map),
|
||||
("sequential?", pred1 sequential_Q),
|
||||
("cons", cons),
|
||||
("concat", do_concat),
|
||||
("nth", nth),
|
||||
("first", first),
|
||||
("rest", rest),
|
||||
("empty?", pred1 empty_Q),
|
||||
("count", count),
|
||||
("apply", apply),
|
||||
("map", do_map),
|
||||
|
||||
("conj", _func $ conj),
|
||||
("seq", _func $ do_seq),
|
||||
("conj", conj),
|
||||
("seq", do_seq),
|
||||
|
||||
("with-meta", _func $ with_meta),
|
||||
("meta", _func $ do_meta),
|
||||
("atom", _func $ atom),
|
||||
("atom?", _func $ run_1 _atom_Q),
|
||||
("deref", _func $ deref),
|
||||
("reset!", _func $ reset_BANG),
|
||||
("swap!", _func $ swap_BANG)]
|
||||
("with-meta", with_meta),
|
||||
("meta", do_meta),
|
||||
("atom", atom),
|
||||
("atom?", pred1 atom_Q),
|
||||
("deref", deref),
|
||||
("reset!", reset_BANG),
|
||||
("swap!", swap_BANG)]
|
||||
|
@ -1,65 +1,36 @@
|
||||
module Env
|
||||
( Env, env_new, null_env, env_bind, env_find, env_get, env_set )
|
||||
( Env, env_new, env_bind, env_get, env_set )
|
||||
where
|
||||
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Control.Monad.Trans (liftIO)
|
||||
import Data.List (elemIndex)
|
||||
import Data.IORef (modifyIORef, newIORef, readIORef)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Types
|
||||
import Printer
|
||||
|
||||
-- These Env types are defined in Types module to avoid dep cycle
|
||||
--data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal))
|
||||
--type Env = IORef EnvData
|
||||
-- The Env type si defined in Types module to avoid dep cycle.
|
||||
|
||||
env_new :: Maybe Env -> IO Env
|
||||
env_new outer = newIORef $ EnvPair (outer, (Map.fromList []))
|
||||
env_new :: Env -> IO Env
|
||||
env_new outer = (: outer) <$> newIORef (Map.fromList [])
|
||||
|
||||
null_env = env_new Nothing
|
||||
-- True means that the actual arguments match the signature.
|
||||
env_bind :: Env -> [String] -> [MalVal] -> IO Bool
|
||||
env_bind env (k : ks) (v : vs) | k /= "&" = do
|
||||
env_set env k v
|
||||
env_bind env ks vs
|
||||
env_bind env ["&", k] vs = do
|
||||
env_set env k $ toList vs
|
||||
return True
|
||||
env_bind _ [] [] = return True
|
||||
env_bind _ _ _ = return False
|
||||
|
||||
env_bind :: Env -> [MalVal] -> [MalVal] -> IO Env
|
||||
env_bind envRef binds exprs = do
|
||||
case (elemIndex (MalSymbol "&") binds) of
|
||||
Nothing -> do
|
||||
-- bind binds to exprs
|
||||
_ <- mapM (\(b,e) -> env_set envRef b e) $ zip binds exprs
|
||||
return envRef
|
||||
Just idx -> do
|
||||
-- Varargs binding
|
||||
_ <- mapM (\(b,e) -> env_set envRef b e) $
|
||||
zip (take idx binds) (take idx exprs)
|
||||
_ <- env_set envRef (binds !! (idx + 1))
|
||||
(MalList (drop idx exprs) Nil)
|
||||
return envRef
|
||||
env_get :: Env -> String -> IO (Maybe MalVal)
|
||||
env_get [] _ = return Nothing
|
||||
env_get (ref : outer) key = do
|
||||
hm <- readIORef ref
|
||||
case Map.lookup key hm of
|
||||
Nothing -> env_get outer key
|
||||
justVal -> return justVal
|
||||
|
||||
env_find :: Env -> MalVal -> IO (Maybe Env)
|
||||
env_find envRef sym@(MalSymbol key) = do
|
||||
e <- readIORef envRef
|
||||
case e of
|
||||
EnvPair (o, m) -> case Map.lookup key m of
|
||||
Nothing -> case o of
|
||||
Nothing -> return Nothing
|
||||
Just o -> env_find o sym
|
||||
Just val -> return $ Just envRef
|
||||
|
||||
env_get :: Env -> MalVal -> IOThrows MalVal
|
||||
env_get envRef sym@(MalSymbol key) = do
|
||||
e1 <- liftIO $ env_find envRef sym
|
||||
case e1 of
|
||||
Nothing -> throwStr $ "'" ++ key ++ "' not found"
|
||||
Just eRef -> do
|
||||
e2 <- liftIO $ readIORef eRef
|
||||
case e2 of
|
||||
EnvPair (o,m) -> case Map.lookup key m of
|
||||
Nothing -> throwStr $ "env_get error"
|
||||
Just val -> return val
|
||||
|
||||
|
||||
env_set :: Env -> MalVal -> MalVal -> IO MalVal
|
||||
env_set envRef (MalSymbol key) val = do
|
||||
e <- readIORef envRef
|
||||
case e of
|
||||
EnvPair (o,m) -> writeIORef envRef $ EnvPair (o, (Map.insert key val m))
|
||||
return val
|
||||
env_set :: Env -> String -> MalVal -> IO ()
|
||||
env_set (ref : _) key val = modifyIORef ref $ Map.insert key val
|
||||
env_set [] _ _ = error "assertion failed in env_set"
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user