(load-file "../mal/env.mal") (load-file "../mal/core.mal") ;; read (def! READ (fn* [strng] (read-string strng))) ;; eval (def! is-pair (fn* [x] (if (sequential? x) (if (> (count x) 0) true)))) (def! QUASIQUOTE (fn* [ast] (cond (not (is-pair ast)) (list 'quote ast) (= 'unquote (first ast)) (nth ast 1) (if (is-pair (first ast)) (if (= 'splice-unquote (first (first ast))) true)) (list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast))) "else" (list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast)))))) (def! is-macro-call (fn* [ast env] (if (list? ast) (let* [a0 (first ast)] (if (symbol? a0) (if (env-find env a0) (let* [m (meta (env-get env a0))] (if m (if (get m "ismacro") true))))))))) (def! MACROEXPAND (fn* [ast env] (if (is-macro-call ast env) (let* [mac (env-get env (first ast))] (MACROEXPAND (apply mac (rest ast)) env)) ast))) (def! eval-ast (fn* [ast env] (do ;;(do (prn "eval-ast" ast "/" (keys env)) ) (cond (symbol? ast) (env-get env ast) (list? ast) (map (fn* [exp] (EVAL exp env)) ast) (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) "else" ast)))) (def! LET (fn* [env args] (if (> (count args) 0) (do (env-set env (nth args 0) (EVAL (nth args 1) env)) (LET env (rest (rest args))))))) (def! EVAL (fn* [ast env] (do ;;(do (prn "EVAL" ast "/" (keys @env)) ) (if (not (list? ast)) (eval-ast ast env) ;; apply list (let* [ast (MACROEXPAND ast env)] (if (not (list? ast)) (eval-ast ast env) (let* [a0 (first ast)] (cond (nil? a0) ast (= 'def! a0) (env-set env (nth ast 1) (EVAL (nth ast 2) env)) (= 'let* a0) (let* [let-env (new-env env)] (do (LET let-env (nth ast 1)) (EVAL (nth ast 2) let-env))) (= 'quote a0) (nth ast 1) (= 'quasiquote a0) (let* [a1 (nth ast 1)] (EVAL (QUASIQUOTE a1) env)) (= 'defmacro! a0) (let* [a1 (nth ast 1) a2 (nth ast 2) f (EVAL a2 env) m (or (meta f) {}) mac (with-meta f (assoc m "ismacro" true))] (env-set env a1 mac)) (= 'macroexpand a0) (let* [a1 (nth ast 1)] (MACROEXPAND a1 env)) (= 'try* a0) (if (or (< (count ast) 3) (not (= 'catch* (nth (nth ast 2) 0)))) (EVAL (nth ast 1) env) (try* (EVAL (nth ast 1) env) (catch* exc (EVAL (nth (nth ast 2) 2) (new-env env [(nth (nth ast 2)1)] [exc]))))) (= 'do a0) (let* [el (eval-ast (rest ast) env)] (nth el (- (count el) 1))) (= 'if a0) (let* [cond (EVAL (nth ast 1) env)] (if (or (= cond nil) (= cond false)) (if (> (count ast) 3) (EVAL (nth ast 3) env) nil) (EVAL (nth ast 2) env))) (= 'fn* a0) (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) "else" (let* [el (eval-ast ast env) f (first el) args (rest el)] (apply f args)))))))))) ;; print (def! PRINT (fn* [exp] (pr-str exp))) ;; repl (def! repl-env (new-env)) (def! rep (fn* [strng] (PRINT (EVAL (READ strng) repl-env)))) ;; core.mal: defined directly using mal (map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns) (env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env))) (env-set repl-env '*ARGV* (rest *ARGV*)) ;; core.mal: defined using the new language itself (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 (def! repl-loop (fn* [] (let* [line (readline "mal-user> ")] (if line (do (if (not (= "" line)) (try* (println (rep line)) (catch* exc (println "Uncaught exception:" exc)))) (repl-loop)))))) (def! -main (fn* [& args] (if (> (count args) 0) (rep (str "(load-file \"" (first args) "\")")) (repl-loop)))) (apply -main *ARGV*)