diff --git a/impls/mal/env.mal b/impls/mal/env.mal index 8692eef88b..dc0ee2ef75 100644 --- a/impls/mal/env.mal +++ b/impls/mal/env.mal @@ -5,11 +5,21 @@ ;; Private helper for new-env. (def! bind-env (fn* [env b e] (if (empty? b) - env + (if (empty? e) + env + (throw "too many arguments in function call")) (let* [b0 (first b)] (if (= '& b0) - (assoc env (str (nth b 1)) e) - (bind-env (assoc env (str b0) (first e)) (rest b) (rest e))))))) + (if (= 2 (count b)) + (if (symbol? (nth b 1)) + (assoc env (str (nth b 1)) e) + (throw "formal parameters must be symbols")) + (throw "misplaced '&' construct")) + (if (empty? e) + (throw "too few arguments in function call") + (if (symbol? b0) + (bind-env (assoc env (str b0) (first e)) (rest b) (rest e)) + (throw "formal parameters must be symbols")))))))) (def! new-env (fn* [& args] (if (<= (count args) 1) diff --git a/impls/mal/step2_eval.mal b/impls/mal/step2_eval.mal index 4aa16dd82f..4d40f94270 100644 --- a/impls/mal/step2_eval.mal +++ b/impls/mal/step2_eval.mal @@ -28,7 +28,9 @@ (let* [a0 (first ast) f (EVAL a0 env) args (rest ast)] - (apply f (map (fn* [exp] (EVAL exp env)) args)))) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))) "else" ast) diff --git a/impls/mal/step3_env.mal b/impls/mal/step3_env.mal index 012caac8b5..dee30434f8 100644 --- a/impls/mal/step3_env.mal +++ b/impls/mal/step3_env.mal @@ -12,9 +12,11 @@ (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) - (do - (env-set env (first binds) (EVAL (nth binds 1) env)) - (LET env (rest (rest binds)) form))))) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) (def! EVAL (fn* [ast env] (do @@ -38,18 +40,24 @@ (let* [a0 (first ast)] (cond (= 'def! a0) - (let* [val (EVAL (nth ast 2) env)] + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] (do (env-set env (nth ast 1) val) val)) + (throw "bad arguments")) (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) "else" (let* [f (EVAL a0 env) args (rest ast)] - (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))))) "else" ast) @@ -67,10 +75,10 @@ (def! rep (fn* [strng] (PRINT (EVAL (READ strng) repl-env)))) -(env-set repl-env "+" +) -(env-set repl-env "-" -) -(env-set repl-env "*" *) -(env-set repl-env "/" /) +(env-set repl-env '+ +) +(env-set repl-env '- -) +(env-set repl-env '* *) +(env-set repl-env '/ /) ;; repl loop (def! repl-loop (fn* [line] diff --git a/impls/mal/step4_if_fn_do.mal b/impls/mal/step4_if_fn_do.mal index e3523f1b17..2f92abede5 100644 --- a/impls/mal/step4_if_fn_do.mal +++ b/impls/mal/step4_if_fn_do.mal @@ -13,9 +13,11 @@ (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) - (do - (env-set env (first binds) (EVAL (nth binds 1) env)) - (LET env (rest (rest binds)) form))))) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) (def! EVAL (fn* [ast env] (do @@ -39,30 +41,42 @@ (let* [a0 (first ast)] (cond (= 'def! a0) - (let* [val (EVAL (nth ast 2) env)] + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] (do (env-set env (nth ast 1) val) val)) + (throw "bad arguments")) (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) (= 'do a0) - (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) "else" (let* [f (EVAL a0 env) args (rest ast)] - (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))))) "else" ast) diff --git a/impls/mal/step6_file.mal b/impls/mal/step6_file.mal index 99576015d3..41e980c905 100644 --- a/impls/mal/step6_file.mal +++ b/impls/mal/step6_file.mal @@ -13,9 +13,11 @@ (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) - (do - (env-set env (first binds) (EVAL (nth binds 1) env)) - (LET env (rest (rest binds)) form))))) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) (def! EVAL (fn* [ast env] (do @@ -39,30 +41,42 @@ (let* [a0 (first ast)] (cond (= 'def! a0) - (let* [val (EVAL (nth ast 2) env)] + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] (do (env-set env (nth ast 1) val) val)) + (throw "bad arguments")) (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) (= 'do a0) - (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) "else" (let* [f (EVAL a0 env) args (rest ast)] - (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))))) "else" ast) diff --git a/impls/mal/step7_quote.mal b/impls/mal/step7_quote.mal index 449c2fc3d5..a2dd20f2c9 100644 --- a/impls/mal/step7_quote.mal +++ b/impls/mal/step7_quote.mal @@ -13,7 +13,9 @@ (def! qq-loop (fn* [elt acc] (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' - (list 'concat (nth elt 1) acc) + (if (= 2 (count elt)) + (list 'concat (nth elt 1) acc) + (throw "splice-unquote expects 1 argument")) (list 'cons (QUASIQUOTE elt) acc)))) (def! qq-foldr (fn* [xs] (if (empty? xs) @@ -25,15 +27,19 @@ (map? ast) (list 'quote ast) (symbol? ast) (list 'quote ast) (not (list? ast)) ast - (= (first ast) 'unquote) (nth ast 1) + (= (first ast) 'unquote) (if (= 2 (count ast)) + (nth ast 1) + (throw "unquote expects 1 argument")) "else" (qq-foldr ast)))) (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) - (do - (env-set env (first binds) (EVAL (nth binds 1) env)) - (LET env (rest (rest binds)) form))))) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) (def! EVAL (fn* [ast env] (do @@ -57,36 +63,52 @@ (let* [a0 (first ast)] (cond (= 'def! a0) - (let* [val (EVAL (nth ast 2) env)] + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] (do (env-set env (nth ast 1) val) val)) + (throw "bad arguments")) (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) (= 'quote a0) - (nth ast 1) + (if (= 2 (count ast)) + (nth ast 1) + (throw "bad argument count")) (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) + (if (= 2 (count ast)) + (EVAL (QUASIQUOTE (nth ast 1)) env) + (throw "bad argument count")) (= 'do a0) - (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) "else" (let* [f (EVAL a0 env) args (rest ast)] - (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions")))))) "else" ast) diff --git a/impls/mal/step8_macros.mal b/impls/mal/step8_macros.mal index 8bad3f51b9..b5592c5f73 100644 --- a/impls/mal/step8_macros.mal +++ b/impls/mal/step8_macros.mal @@ -13,7 +13,9 @@ (def! qq-loop (fn* [elt acc] (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' - (list 'concat (nth elt 1) acc) + (if (= 2 (count elt)) + (list 'concat (nth elt 1) acc) + (throw "splice-unquote expects 1 argument")) (list 'cons (QUASIQUOTE elt) acc)))) (def! qq-foldr (fn* [xs] (if (empty? xs) @@ -25,15 +27,19 @@ (map? ast) (list 'quote ast) (symbol? ast) (list 'quote ast) (not (list? ast)) ast - (= (first ast) 'unquote) (nth ast 1) + (= (first ast) 'unquote) (if (= 2 (count ast)) + (nth ast 1) + (throw "unquote expects 1 argument")) "else" (qq-foldr ast)))) (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) - (do - (env-set env (first binds) (EVAL (nth binds 1) env)) - (LET env (rest (rest binds)) form))))) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) (def! EVAL (fn* [ast env] (do @@ -57,44 +63,65 @@ (let* [a0 (first ast)] (cond (= 'def! a0) - (let* [val (EVAL (nth ast 2) env)] + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] (do (env-set env (nth ast 1) val) val)) + (throw "bad arguments")) (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) (= 'quote a0) - (nth ast 1) + (if (= 2 (count ast)) + (nth ast 1) + (throw "bad argument count")) (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) + (if (= 2 (count ast)) + (EVAL (QUASIQUOTE (nth ast 1)) env) + (throw "bad argument count")) (= 'defmacro! a0) - (let* [fun (defmacro! _ (EVAL (nth ast 2) env))] - (do - (env-set env (nth ast 1) fun) - fun)) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [f (EVAL (nth ast 2) env)] + (if (fn? f) + (let* [m (defmacro! _ f)] + (do + (env-set env (nth ast 1) m) + m)) + (throw "a macro must be constructed from a function"))) + (throw "bad arguments")) (= 'do a0) - (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) "else" (let* [f (EVAL a0 env) args (rest ast)] (if (macro? f) (EVAL (apply f args) env) - (apply f (map (fn* [exp] (EVAL exp env)) args))))))) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions"))))))) "else" ast) diff --git a/impls/mal/step9_try.mal b/impls/mal/step9_try.mal index 1c62bf9d4b..f3eb10ae84 100644 --- a/impls/mal/step9_try.mal +++ b/impls/mal/step9_try.mal @@ -13,7 +13,9 @@ (def! qq-loop (fn* [elt acc] (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' - (list 'concat (nth elt 1) acc) + (if (= 2 (count elt)) + (list 'concat (nth elt 1) acc) + (throw "splice-unquote expects 1 argument")) (list 'cons (QUASIQUOTE elt) acc)))) (def! qq-foldr (fn* [xs] (if (empty? xs) @@ -25,15 +27,19 @@ (map? ast) (list 'quote ast) (symbol? ast) (list 'quote ast) (not (list? ast)) ast - (= (first ast) 'unquote) (nth ast 1) + (= (first ast) 'unquote) (if (= 2 (count ast)) + (nth ast 1) + (throw "unquote expects 1 argument")) "else" (qq-foldr ast)))) (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) - (do - (env-set env (first binds) (EVAL (nth binds 1) env)) - (LET env (rest (rest binds)) form))))) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) (def! EVAL (fn* [ast env] (do @@ -57,55 +63,83 @@ (let* [a0 (first ast)] (cond (= 'def! a0) - (let* [val (EVAL (nth ast 2) env)] + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] (do (env-set env (nth ast 1) val) val)) + (throw "bad arguments")) (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) (= 'quote a0) - (nth ast 1) + (if (= 2 (count ast)) + (nth ast 1) + (throw "bad argument count")) (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) + (if (= 2 (count ast)) + (EVAL (QUASIQUOTE (nth ast 1)) env) + (throw "bad argument count")) (= 'defmacro! a0) - (let* [fun (defmacro! _ (EVAL (nth ast 2) env))] - (do - (env-set env (nth ast 1) fun) - fun)) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [f (EVAL (nth ast 2) env)] + (if (fn? f) + (let* [m (defmacro! _ f)] + (do + (env-set env (nth ast 1) m) + m)) + (throw "a macro must be constructed from a function"))) + (throw "bad arguments")) (= 'try* a0) - (if (< (count ast) 3) + (if (= 2 (count ast)) (EVAL (nth ast 1) env) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (do - (reset! trace "") - (let* [a2 (nth ast 2)] - (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) + (if (= 3 (count ast)) + (let* [a2 (nth ast 2)] + (if (if (list? a2) + (if (= 3 (count a2)) + (if (= 'catch* (first a2)) + (symbol? (nth a2 1))))) + (try* + (EVAL (nth ast 1) env) + (catch* exc + (do + (reset! trace "") + (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))) + (throw "invalid catch* list"))) + (throw "bad argument count"))) (= 'do a0) - (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) "else" (let* [f (EVAL a0 env) args (rest ast)] (if (macro? f) (EVAL (apply f args) env) - (apply f (map (fn* [exp] (EVAL exp env)) args))))))) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions"))))))) "else" ast) diff --git a/impls/mal/stepA_mal.mal b/impls/mal/stepA_mal.mal index b287c630e9..1c62f375fe 100644 --- a/impls/mal/stepA_mal.mal +++ b/impls/mal/stepA_mal.mal @@ -13,7 +13,9 @@ (def! qq-loop (fn* [elt acc] (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' - (list 'concat (nth elt 1) acc) + (if (= 2 (count elt)) + (list 'concat (nth elt 1) acc) + (throw "splice-unquote expects 1 argument")) (list 'cons (QUASIQUOTE elt) acc)))) (def! qq-foldr (fn* [xs] (if (empty? xs) @@ -25,15 +27,19 @@ (map? ast) (list 'quote ast) (symbol? ast) (list 'quote ast) (not (list? ast)) ast - (= (first ast) 'unquote) (nth ast 1) + (= (first ast) 'unquote) (if (= 2 (count ast)) + (nth ast 1) + (throw "unquote expects 1 argument")) "else" (qq-foldr ast)))) (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) - (do - (env-set env (first binds) (EVAL (nth binds 1) env)) - (LET env (rest (rest binds)) form))))) + (if (if (< 1 (count binds)) (symbol? (first binds))) + (do + (env-set env (first binds) (EVAL (nth binds 1) env)) + (LET env (rest (rest binds)) form)) + (throw "invalid binds"))))) (def! EVAL (fn* [ast env] (do @@ -57,55 +63,83 @@ (let* [a0 (first ast)] (cond (= 'def! a0) - (let* [val (EVAL (nth ast 2) env)] + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [val (EVAL (nth ast 2) env)] (do (env-set env (nth ast 1) val) val)) + (throw "bad arguments")) (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (LET (new-env env) (nth ast 1) (nth ast 2)) + (throw "bad arguments")) (= 'quote a0) - (nth ast 1) + (if (= 2 (count ast)) + (nth ast 1) + (throw "bad argument count")) (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) + (if (= 2 (count ast)) + (EVAL (QUASIQUOTE (nth ast 1)) env) + (throw "bad argument count")) (= 'defmacro! a0) - (let* [fun (defmacro! _ (EVAL (nth ast 2) env))] - (do - (env-set env (nth ast 1) fun) - fun)) + (if (if (= 3 (count ast)) (symbol? (nth ast 1))) + (let* [f (EVAL (nth ast 2) env)] + (if (fn? f) + (let* [m (defmacro! _ f)] + (do + (env-set env (nth ast 1) m) + m)) + (throw "a macro must be constructed from a function"))) + (throw "bad arguments")) (= 'try* a0) - (if (< (count ast) 3) + (if (= 2 (count ast)) (EVAL (nth ast 1) env) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (do - (reset! trace "") - (let* [a2 (nth ast 2)] - (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) + (if (= 3 (count ast)) + (let* [a2 (nth ast 2)] + (if (if (list? a2) + (if (= 3 (count a2)) + (if (= 'catch* (first a2)) + (symbol? (nth a2 1))))) + (try* + (EVAL (nth ast 1) env) + (catch* exc + (do + (reset! trace "") + (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))) + (throw "invalid catch* list"))) + (throw "bad argument count"))) (= 'do a0) - (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (if (<= 2 (count ast)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + (throw "bad argument count")) (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (if (if (<= 3 (count ast)) (<= (count ast) 4)) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (= 4 (count ast)) + (EVAL (nth ast 3) env))) + (throw "bad argument count")) (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (if (if (= 3 (count ast)) (sequential? (nth ast 1))) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + (throw "bad arguments")) "else" (let* [f (EVAL a0 env) args (rest ast)] (if (macro? f) (EVAL (apply f args) env) - (apply f (map (fn* [exp] (EVAL exp env)) args))))))) + (if (fn? f) + (apply f (map (fn* [exp] (EVAL exp env)) args)) + (throw "can only apply functions"))))))) "else" ast)