Merge branch 'master' into bjh21-unterminated-strings

This should fix ocaml.

.travis.yml

@@ -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}

.travis_test.sh

@@ -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

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

ada.2/core.adb

@@ -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,
+      Err.Check (Args'Length = 1
-                 "expected a string");
+                   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;
 

ada.2/step8_macros.adb

@@ -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)))))))"
+     & "      (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))))))))";
    Repl : constant Envs.Ptr := Envs.New_Env;
    function Eval_Builtin (Args : in Types.T_Array) return Types.T is
    begin

ada.2/step9_try.adb

@@ -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)))))))"
+     & "      (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))))))))";
    Repl : constant Envs.Ptr := Envs.New_Env;
    function Eval_Builtin (Args : in Types.T_Array) return Types.T is
    begin

ada.2/stepa_mal.adb

@@ -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

ada/step8_macros.adb

@@ -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.
 

ada/step9_try.adb

@@ -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.
 

ada/stepa_mal.adb

@@ -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.
 

awk/step8_macros.awk

@@ -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)

awk/step9_try.awk

@@ -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)

awk/stepA_mal.awk

@@ -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)

bash/step8_macros.sh

@@ -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

bash/step9_try.sh

@@ -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

bash/stepA_mal.sh

@@ -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

basic/step8_macros.in.bas

@@ -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

basic/step9_try.in.bas

@@ -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

basic/stepA_mal.in.bas

@@ -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

bbc-basic/step8_macros.bbc

@@ -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$

bbc-basic/step9_try.bbc

@@ -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$

bbc-basic/stepA_mal.bbc

@@ -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

c/step8_macros.c

@@ -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[])

c/step9_try.c

@@ -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[])

c/stepA_mal.c

@@ -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[])

chuck/step8_macros.ck

@@ -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()
 {

chuck/step9_try.ck

@@ -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()
 {

chuck/stepA_mal.ck

@@ -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;

clojure/src/mal/step8_macros.cljc

@@ -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 []

clojure/src/mal/step9_try.cljc

@@ -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 []

clojure/src/mal/stepA_mal.cljc

@@ -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 []

coffee/step8_macros.coffee

@@ -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..]

coffee/step9_try.coffee

@@ -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..]

coffee/stepA_mal.coffee

@@ -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..]

common-lisp/src/step8_macros.lisp

@@ -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)
 

common-lisp/src/step9_try.lisp

@@ -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)
 

common-lisp/src/stepA_mal.lisp

@@ -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)
 

cpp/step8_macros.cpp

@@ -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) \")\")))))",

cpp/step9_try.cpp

@@ -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) \")\")))))",

cpp/stepA_mal.cpp

@@ -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++\")",
 };
 

crystal/step8_macros.cr

@@ -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)

crystal/step9_try.cr

@@ -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)

crystal/stepA_mal.cr

@@ -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

cs/step8_macros.cs

@@ -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] + "\")");

cs/step9_try.cs

@@ -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] + "\")");

cs/stepA_mal.cs

@@ -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] + "\")");

d/step8_macros.d

@@ -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)
     {

d/step9_try.d

@@ -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)
     {

d/stepA_mal.d

@@ -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)
     {

dart/step8_macros.dart

@@ -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.

dart/step9_try.dart

@@ -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);
+            return macroexpand(args.first, env);
-            continue;
           } else if (symbol.value == 'try*') {
             var body = args.first;
             if (args.length < 2) {

dart/stepA_mal.dart

@@ -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);
+            return macroexpand(args.first, env);
-            continue;
           } else if (symbol.value == 'try*') {
             var body = args.first;
             if (args.length < 2) {

docs/cheatsheet.html

@@ -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>

docs/exercises.md

@@ -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))`?

elisp/step8_macros.el

@@ -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

elisp/step9_try.el

@@ -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

elisp/stepA_mal.el

@@ -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

elixir/lib/mal/core.ex

@@ -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)

elixir/lib/mix/tasks/step8_macros.ex

@@ -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})

elixir/lib/mix/tasks/step9_try.ex

@@ -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})

elixir/lib/mix/tasks/stepA_mal.ex

@@ -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})

elm/step8_macros.elm

@@ -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))))))))"""
     ]
 
 

elm/step9_try.elm

@@ -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))))))))"""
     ]
 
 

elm/stepA_mal.elm

@@ -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)))))))))"""
     ]
 
 

erlang/src/step8_macros.erl

@@ -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) ->

erlang/src/step9_try.erl

@@ -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) ->

erlang/src/stepA_mal.erl

@@ -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) ->

es6/step8_macros.mjs

@@ -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))

es6/step9_try.mjs

@@ -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))

es6/stepA_mal.mjs

@@ -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))

examples/exercises.mal

@@ -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

factor/step8_macros/step8_macros.factor

@@ -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

factor/step9_try/step9_try.factor

@@ -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

factor/stepA_mal/stepA_mal.factor

@@ -50,8 +50,12 @@ DEFER: EVAL
 :: eval-try* ( params env -- maltype )
     [ params first env 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

fantom/src/step8_macros/fan/main.fan

@@ -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)
     {

fantom/src/step9_try/fan/main.fan

@@ -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)
     {

fantom/src/stepA_mal/fan/main.fan

@@ -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)
     {

forth/step8_macros.fs

@@ -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

forth/step9_try.fs

@@ -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

forth/stepA_mal.fs

@@ -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

fsharp/step8_macros.fs

@@ -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
 

fsharp/step9_try.fs

@@ -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
 

fsharp/stepA_mal.fs

@@ -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

gnu-smalltalk/step8_macros.st

@@ -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

gnu-smalltalk/step9_try.st

@@ -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

gnu-smalltalk/stepA_mal.st

@@ -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

go/src/step8_macros/step8_macros.go

@@ -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 {

go/src/step9_try/step9_try.go

@@ -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 {

go/src/stepA_mal/stepA_mal.go

@@ -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 {

groovy/step8_macros.groovy

@@ -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) {

groovy/step9_try.groovy

@@ -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) {

groovy/stepA_mal.groovy

@@ -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)

guile/core.scm

@@ -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

guile/step5_tco.scm

@@ -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
+(REPL)
-((@ (system vm vm) call-with-stack-overflow-handler)
- 1024
- (lambda () (REPL))
- (lambda k (throw 'mal-error "stack overflow")))
-

guile/step8_macros.scm

@@ -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

guile/step9_try.scm

@@ -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

guile/stepA_mal.scm

@@ -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))))

guile/tests/step5_tco.mal

@@ -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

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 :: Fn
-keyword (MalString str:[]) = return $ MalString $ "\x029e" ++ str
+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
+pr_str :: Fn
-    return $ MalString $ _pr_list True " " args
+pr_str args = liftIO $ MalString <$> _pr_list True " " args
 
-str args = do
+str :: Fn
-    return $ MalString $ _pr_list False "" args
+str args = liftIO $ MalString <$> _pr_list False "" args
 
-prn args = do
+prn :: Fn
-    liftIO $ putStrLn $ _pr_list True " " args
+prn args = liftIO $ do
-    liftIO $ hFlush stdout
+    putStrLn =<< _pr_list True " " args
+    hFlush stdout
     return Nil
 
-println args = do
+println :: Fn
-    liftIO $ putStrLn $ _pr_list False " " args
+println args = liftIO $ do
-    liftIO $ hFlush stdout
+    putStrLn =<< _pr_list False " " args
+    hFlush stdout
     return Nil
 
-slurp ([MalString path]) = do
+slurp :: Fn
-    str <- liftIO $ readFile path
+slurp [MalString path] = MalString <$> liftIO (readFile path)
-    return $ MalString str
 slurp _ = throwStr "invalid arguments to slurp"
 
-do_readline ([MalString prompt]) = do
+do_readline :: Fn
-    str <- liftIO $ readline prompt
+do_readline [MalString prompt] = do
-    case str of
+    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
+num_op :: (Int -> Int -> Int) -> Fn
-    return $ MalNumber $ op a b
+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
+cmp_op :: (Int -> Int -> Bool) -> Fn
-    return $ if op a b then MalTrue else MalFalse
+cmp_op op [MalNumber a, MalNumber b] = return $ MalBoolean $ op a b
 cmp_op _ _ = throwStr "illegal arguments to comparison operation"
 
-time_ms _ = do
+time_ms :: Fn
-   t <- liftIO $ getPOSIXTime
+time_ms [] = MalNumber . round . (* 1000) <$> liftIO getPOSIXTime
-   return $ MalNumber $ round (t * 1000)
+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"
+hash_map :: Fn
-_pairup [] = return []
+hash_map kvs =
-_pairup (MalString x:y:xs) = do
+    case keyValuePairs kvs of
-    rest <- _pairup xs
+        Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.fromList pairs
-    return $ (x,y):rest
+        Nothing    -> throwStr "invalid call to hash-map"
 
-hash_map args = do
+assoc :: Fn
-    pairs <- _pairup args
+assoc (MalHashMap _ hm : kvs) =
-    return $ MalHashMap (Map.fromList pairs) Nil
+    case keyValuePairs kvs of
-
+        Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.union (Map.fromList pairs) hm
-assoc (MalHashMap hm _:kvs) = do
+        Nothing    -> throwStr "invalid assoc"
-    pairs <- _pairup kvs
-    return $ MalHashMap (Map.union (Map.fromList pairs) hm) Nil
 assoc _ = throwStr "invalid call to assoc"
 
-dissoc (MalHashMap hm _:ks) = do
+remover :: Map.Map String MalVal -> MalVal -> IOThrows (Map.Map String MalVal)
-    let remover = (\hm (MalString k) -> Map.delete k hm) in
+remover m (MalString k) = return $ Map.delete k m
-        return $ MalHashMap (foldl remover  hm ks) Nil
+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
+contains_Q :: Fn
-    if Map.member k hm then return MalTrue
+contains_Q [MalHashMap _ hm, MalString k] = return $ MalBoolean $ Map.member k hm
-    else return MalFalse
+contains_Q [Nil,             MalString _] = return $ MalBoolean False
-contains_Q (Nil:MalString k:[]) = return MalFalse
 contains_Q _ = throwStr "invalid call to contains?"
 
-keys (MalHashMap hm _:[]) = do
+keys :: Fn
-    return $ MalList (map MalString (Map.keys hm)) Nil
+keys [MalHashMap _ hm] = return $ toList $ MalString <$> Map.keys hm
 keys _ = throwStr "invalid call to keys"
 
-vals (MalHashMap hm _:[]) = do
+vals :: Fn
-    return $ MalList (Map.elems hm) Nil
+vals [MalHashMap _ hm] = return $ toList $ Map.elems hm
 vals _ = throwStr "invalid call to vals"
 
-
 -- Sequence functions
 
-_sequential_Q (MalList _ _) = MalTrue
+sequential_Q :: MalVal -> Bool
-_sequential_Q (MalVector _ _) = MalTrue
+sequential_Q (MalSeq _ _ _) = True
-_sequential_Q _ = MalFalse
+sequential_Q _              = False
 
-cons x Nil = MalList [x] Nil
+cons :: Fn
-cons x (MalList lst _) = MalList (x:lst) Nil
+cons [x, Nil           ] = return $ toList [x]
-cons x (MalVector lst _) = MalList (x:lst) Nil
+cons [x, MalSeq _ _ lst] = return $ toList (x : lst)
+cons _ = throwStr "illegal call to cons"
 
-concat1 a (MalList lst _) = a ++ lst
+unwrapSeq :: MalVal -> IOThrows [MalVal]
-concat1 a (MalVector lst _) = a ++ lst
+unwrapSeq (MalSeq _ _ xs) = return xs
-do_concat args = return $ MalList (foldl concat1 [] args) Nil
+unwrapSeq _ = throwStr "invalid concat"
 
-nth ((MalList lst _):(MalNumber idx):[]) = do
+do_concat :: Fn
-    if idx < length lst then return $ lst !! idx
+do_concat args = toList . concat <$> mapM unwrapSeq args
-    else throwStr "nth: index out of range"
+
-nth ((MalVector lst _):(MalNumber idx):[]) = do
+nth :: Fn
-    if idx < length lst then return $ lst !! idx
+nth [MalSeq _ _ lst, MalNumber idx] =
-    else throwStr "nth: index out of range"
+    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 :: Fn
-first (MalList lst _) = if length lst > 0 then lst !! 0 else Nil
+first [Nil               ] = return Nil
-first (MalVector lst _) = if length lst > 0 then lst !! 0 else Nil
+first [MalSeq _ _ []     ] = return Nil
+first [MalSeq _ _ (x : _)] = return x
+first _ = throwStr "illegal call to first"
 
-rest Nil = MalList [] Nil
+rest :: Fn
-rest (MalList lst _) = MalList (drop 1 lst) Nil
+rest [Nil                ] = return $ toList []
-rest (MalVector lst _) = MalList (drop 1 lst) Nil
+rest [MalSeq _ _ []      ] = return $ toList []
+rest [MalSeq _ _ (_ : xs)] = return $ toList xs
+rest _ = throwStr "illegal call to rest"
 
-empty_Q Nil              = MalTrue
+empty_Q :: MalVal -> Bool
-empty_Q (MalList [] _)   = MalTrue
+empty_Q Nil             = True
-empty_Q (MalVector [] _) = MalTrue
+empty_Q (MalSeq _ _ []) = True
-empty_Q _                = MalFalse
+empty_Q _               = False
 
-count (Nil:[])             = return $ MalNumber 0
+count :: Fn
-count (MalList lst _:[])   = return $ MalNumber $ length lst
+count [Nil           ] = return $ MalNumber 0
-count (MalVector lst _:[]) = return $ MalNumber $ length lst
+count [MalSeq _ _ lst] = return $ MalNumber $ length lst
-count _ = throwStr $ "non-sequence passed to count"
+count _ = throwStr "non-sequence passed to count"
 
-apply args = do
+concatLast :: [MalVal] -> IOThrows [MalVal]
-    f <- _get_call args
+concatLast [MalSeq _ _ lst] = return lst
-    lst <- _to_list (last args)
+concatLast (a : as)         = (a :) <$> concatLast as
-    f $ (init (drop 1 args)) ++ lst
+concatLast _ = throwStr "last argument of apply must be a sequence"
 
-do_map args = do
+apply :: Fn
-    f <- _get_call args
+apply (MalFunction {fn=f} : xs) = f =<< concatLast xs
-    lst <- _to_list (args !! 1)
+apply _ = throwStr "Illegal call to apply"
-    do new_lst <- mapM (\x -> f [x]) lst
-       return $ MalList new_lst Nil
 
-conj ((MalList lst _):args) = return $ MalList ((reverse args) ++ lst) Nil
+do_map :: Fn
-conj ((MalVector lst _):args) = return $ MalVector (lst ++ args) Nil
+do_map [MalFunction {fn=f}, MalSeq _ _ args] = toList <$> mapM (\x -> f [x]) args
-conj _ = throwStr $ "illegal arguments to conj"
+do_map _ = throwStr "Illegal call to map"
 
-do_seq (l@(MalList [] _):[])  = return $ Nil
+conj :: Fn
-do_seq (l@(MalList lst m):[]) = return $ l
+conj (MalSeq _ (Vect False) lst : args) = return $ toList $ reverse args ++ lst
-do_seq (MalVector [] _:[])    = return $ Nil
+conj (MalSeq _ (Vect True)  lst : args) = return $ MalSeq (MetaData Nil) (Vect True) $ lst ++ args
-do_seq (MalVector lst _:[])   = return $ MalList lst Nil
+conj _ = throwStr "illegal arguments to conj"
-do_seq (MalString []:[])      = return $ Nil
+
-do_seq (MalString s:[])       = return $ MalList [MalString [c] | c <- s] Nil
+do_seq :: Fn
-do_seq (Nil:[])               = return $ Nil
+do_seq [Nil            ] = return Nil
-do_seq _                      = throwStr $ "seq: called on non-sequence"
+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 :: Fn
-with_meta ((MalVector lst _):m:[]) = return $ MalVector lst m
+with_meta [MalSeq _ v x,       m] = return $ MalSeq (MetaData m) v x
-with_meta ((MalHashMap hm _):m:[]) = return $ MalHashMap hm m
+with_meta [MalHashMap _ x,     m] = return $ MalHashMap (MetaData m) x
-with_meta ((MalAtom atm _):m:[])   = return $ MalAtom atm m
+with_meta [MalAtom _ x,        m] = return $ MalAtom (MetaData m) x
-with_meta ((Func f _):m:[])        = return $ Func f m
+with_meta [f@(MalFunction {}), m] = return $ f {meta=m}
-with_meta ((MalFunc {fn=f, ast=a, env=e, params=p, macro=mc}):m:[]) = do
+with_meta _ = throwStr "invalid with-meta call"
-    return $ MalFunc {fn=f, ast=a, env=e, params=p, macro=mc, meta=m}
-with_meta _ = throwStr $ "invalid with-meta call"
 
-do_meta ((MalList _ m):[])      = return m
+do_meta :: Fn
-do_meta ((MalVector _ m):[])    = return m
+do_meta [MalSeq (MetaData m) _ _  ] = return m
-do_meta ((MalHashMap _ m):[])   = return m
+do_meta [MalHashMap (MetaData m) _] = return m
-do_meta ((MalAtom _ m):[])      = return m
+do_meta [MalAtom (MetaData m) _   ] = return m
-do_meta ((Func _ m):[])         = return m
+do_meta [MalFunction {meta=m}     ] = return m
-do_meta ((MalFunc {meta=m}):[]) = return m
+do_meta _ = throwStr "invalid meta call"
-do_meta _ = throwStr $ "invalid meta call"
 
 -- Atom functions
 
-atom (val:[]) = do
+atom :: Fn
-    ref <- liftIO $ newIORef val
+atom [val] = MalAtom (MetaData Nil) <$> liftIO (newIORef val)
-    return $ MalAtom ref Nil
 atom _ = throwStr "invalid atom call"
 
-deref (MalAtom ref _:[]) = do
+deref :: Fn
-    val <- liftIO $ readIORef ref
+deref [MalAtom _ ref] = liftIO $ readIORef ref
-    return val
 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 : args)
-    new_val <- f $ [val] ++ (tail args)
+    liftIO $ writeIORef ref new_val
-    _ <- liftIO $ writeIORef ref $ new_val
     return new_val
+swap_BANG _ = throwStr "Illegal swap!"
 
+ns :: [(String, Fn)]
 ns = [
-    ("=",  _func equal_Q),
+    ("=",           equal_Q),
-    ("throw", _func throw),
+    ("throw",       throw),
-    ("nil?", _func $ run_1 $ _nil_Q),
+    ("nil?",        pred1 nil_Q),
-    ("true?", _func $ run_1 $ _true_Q),
+    ("true?",       pred1 true_Q),
-    ("false?", _func $ run_1 $ _false_Q),
+    ("false?",      pred1 false_Q),
-    ("string?", _func $ run_1 $ _string_Q),
+    ("string?",     pred1 string_Q),
-    ("symbol", _func $ symbol),
+    ("symbol",      symbol),
-    ("symbol?", _func $ run_1 $ _symbol_Q),
+    ("symbol?",     pred1 symbol_Q),
-    ("keyword", _func $ keyword),
+    ("keyword",     keyword),
-    ("keyword?", _func $ run_1 $ _keyword_Q),
+    ("keyword?",    pred1 keyword_Q),
-    ("number?", _func $ run_1 $ _number_Q),
+    ("number?",     pred1 number_Q),
-    ("fn?", _func $ run_1 $ _fn_Q),
+    ("fn?",         pred1 fn_Q),
-    ("macro?", _func $ run_1 $ _macro_Q),
+    ("macro?",      pred1 macro_Q),
 
-    ("pr-str", _func pr_str),
+    ("pr-str",      pr_str),
-    ("str", _func str),
+    ("str",         str),
-    ("prn", _func prn),
+    ("prn",         prn),
-    ("println", _func println),
+    ("println",     println),
-    ("readline", _func do_readline),
+    ("readline",    do_readline),
-    ("read-string", _func (\[(MalString s)] -> read_str s)),
+    ("read-string", read_string),
-    ("slurp", _func slurp),
+    ("slurp",       slurp),
 
-    ("<",  _func $ cmp_op (<)),
+    ("<",           cmp_op (<)),
-    ("<=", _func $ cmp_op (<=)),
+    ("<=",          cmp_op (<=)),
-    (">",  _func $ cmp_op (>)),
+    (">",           cmp_op (>)),
-    (">=", _func $ cmp_op (>=)),
+    (">=",          cmp_op (>=)),
-    ("+",  _func $ num_op (+)),
+    ("+",           num_op (+)),
-    ("-",  _func $ num_op (-)),
+    ("-",           num_op (-)),
-    ("*",  _func $ num_op (*)),
+    ("*",           num_op (*)),
-    ("/",  _func $ num_op (div)),
+    ("/",           num_op (div)),
-    ("time-ms", _func $ time_ms),
+    ("time-ms",     time_ms),
 
-    ("list",     _func $ list),
+    ("list",        list),
-    ("list?",    _func $ run_1 _list_Q),
+    ("list?",       pred1 list_Q),
-    ("vector",   _func $ vector),
+    ("vector",      vector),
-    ("vector?",  _func $ run_1 _vector_Q),
+    ("vector?",     pred1 vector_Q),
-    ("hash-map", _func $ hash_map),
+    ("hash-map",    hash_map),
-    ("map?",     _func $ run_1 _hash_map_Q),
+    ("map?",        pred1 map_Q),
-    ("assoc",    _func $ assoc),
+    ("assoc",       assoc),
-    ("dissoc",   _func $ dissoc),
+    ("dissoc",      dissoc),
-    ("get",      _func $ get),
+    ("get",         get),
-    ("contains?",_func $ contains_Q),
+    ("contains?",   contains_Q),
-    ("keys",     _func $ keys),
+    ("keys",        keys),
-    ("vals",     _func $ vals),
+    ("vals",        vals),
 
-    ("sequential?", _func $ run_1 _sequential_Q),
+    ("sequential?", pred1 sequential_Q),
-    ("cons", _func $ run_2 $ cons),
+    ("cons",        cons),
-    ("concat", _func $ do_concat),
+    ("concat",      do_concat),
-    ("nth", _func nth),
+    ("nth",         nth),
-    ("first", _func $ run_1 $ first),
+    ("first",       first),
-    ("rest", _func $ run_1 $ rest),
+    ("rest",        rest),
-    ("empty?", _func $ run_1 $ empty_Q),
+    ("empty?",      pred1 empty_Q),
-    ("count", _func $ count),
+    ("count",       count),
-    ("apply", _func $ apply),
+    ("apply",       apply),
-    ("map", _func $ do_map),
+    ("map",         do_map),
 
-    ("conj", _func $ conj),
+    ("conj",        conj),
-    ("seq", _func $ do_seq),
+    ("seq",         do_seq),
 
-    ("with-meta", _func $ with_meta),
+    ("with-meta",   with_meta),
-    ("meta",      _func $ do_meta),
+    ("meta",        do_meta),
-    ("atom",      _func $ atom),
+    ("atom",        atom),
-    ("atom?",     _func $ run_1 _atom_Q),
+    ("atom?",       pred1 atom_Q),
-    ("deref",     _func $ deref),
+    ("deref",       deref),
-    ("reset!",    _func $ reset_BANG),
+    ("reset!",      reset_BANG),
-    ("swap!",     _func $ swap_BANG)]
+    ("swap!",       swap_BANG)]

haskell/Env.hs

@@ -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 Data.IORef (modifyIORef, newIORef, readIORef)
-import Control.Monad.Trans (liftIO)
-import Data.List (elemIndex)
 import qualified Data.Map  as Map
 
 import Types
-import Printer
 
--- These Env types are defined in Types module to avoid dep cycle
+-- The Env type si defined in Types module to avoid dep cycle.
---data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal))
---type Env = IORef EnvData
 
-env_new :: Maybe Env -> IO Env
+env_new :: Env -> IO Env
-env_new outer  = newIORef $ EnvPair (outer, (Map.fromList []))
+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_get :: Env -> String -> IO (Maybe MalVal)
-env_bind envRef binds exprs = do
+env_get [] _ = return Nothing
-    case (elemIndex (MalSymbol "&") binds) of
+env_get (ref : outer) key = do
-        Nothing  -> do
+    hm <- readIORef ref
-            -- bind binds to exprs
+    case Map.lookup key hm of
-            _ <- mapM (\(b,e) -> env_set envRef b e) $ zip binds exprs
+        Nothing -> env_get outer key
-            return envRef
+        justVal -> return justVal
-        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_find :: Env -> MalVal -> IO (Maybe Env)
+env_set :: Env -> String -> MalVal -> IO ()
-env_find envRef sym@(MalSymbol key) = do
+env_set (ref : _) key val = modifyIORef ref $ Map.insert key val
-    e <- readIORef envRef
+env_set [] _ _ = error "assertion failed in env_set"
-    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