1 files changed, 181 insertions, 0 deletions
diff --git a/clojure/src/stepA_mal.clj b/clojure/src/stepA_mal.clj
new file mode 100644
index 0000000..6ed9964
--- /dev/null
+++ b/clojure/src/stepA_mal.clj
@@ -0,0 +1,181 @@
+(ns stepA-interop
+    (:refer-clojure :exclude [macroexpand])
+    (:require [clojure.repl]
+              [readline]
+              [reader]
+              [printer]
+              [env]
+              [core]))
+
+;; read
+(defn READ [& [strng]]
+  (let [line (if strng strng (read-line))]
+    (reader/read-string strng)))
+
+;; eval
+(declare EVAL)
+(defn is-pair [x]
+  (and (sequential? x) (> (count x) 0)))
+
+(defn quasiquote [ast]
+  (cond
+    (not (is-pair ast))
+    (list 'quote ast)
+
+    (= 'unquote (first ast))
+    (second ast)
+
+    (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
+    (list 'concat (-> ast first second) (quasiquote (rest ast)))
+
+    :else
+    (list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
+
+(defn is-macro-call [ast env]
+  (and (seq? ast)
+       (symbol? (first ast))
+       (env/env-find env (first ast))
+       (:ismacro (meta (env/env-get env (first ast))))))
+
+(defn macroexpand [ast env]
+  (loop [ast ast]
+    (if (is-macro-call ast env)
+      (let [mac (env/env-get env (first ast))]
+        (recur (apply mac (rest ast))))
+      ast)))
+
+(defn eval-ast [ast env]
+  (cond
+    (symbol? ast) (env/env-get env ast)
+   
+    (seq? ast)    (doall (map #(EVAL % env) ast))
+
+    (vector? ast) (vec (doall (map #(EVAL % env) ast)))
+   
+    (map? ast)    (apply hash-map (doall (map #(EVAL % env)
+                                              (mapcat identity ast))))
+
+    :else         ast))
+
+(defn EVAL [ast env]
+  (loop [ast ast
+         env env]
+    ;;(prn "EVAL" ast (keys @env)) (flush)
+    (if (not (seq? ast))
+      (eval-ast ast env)
+  
+      ;; apply list
+      (let [ast (macroexpand ast env)]
+        (if (not (seq? ast))
+          ast
+
+          (let [[a0 a1 a2 a3] ast]
+            (condp = a0
+              'def!
+              (env/env-set env a1 (EVAL a2 env))
+      
+              'let*
+              (let [let-env (env/env env)]
+                (doseq [[b e] (partition 2 a1)]
+                  (env/env-set let-env b (EVAL e let-env)))
+                (recur a2 let-env))
+    
+              'quote
+              a1
+    
+              'quasiquote
+              (recur (quasiquote a1) env)
+    
+              'defmacro!
+              (let [func (with-meta (EVAL a2 env)
+                                    {:ismacro true})]
+                (env/env-set env a1 func))
+    
+              'macroexpand
+              (macroexpand a1 env)
+      
+              'clj*
+              (eval (reader/read-string a1))
+      
+              'try*
+              (if (= 'catch* (nth a2 0))
+                (try
+                  (EVAL a1 env)
+                  (catch clojure.lang.ExceptionInfo ei
+                    (EVAL (nth a2 2) (env/env env
+                                              [(nth a2 1)]
+                                              [(:data (ex-data ei))])))
+                  (catch Throwable t
+                    (EVAL (nth a2 2) (env/env env
+                                              [(nth a2 1)]
+                                              [(.getMessage t)]))))
+                (EVAL a1 env))
+    
+              'do
+              (do (eval-ast (->> ast (drop-last) (drop 1)) env)
+                  (recur (last ast) env))
+      
+              'if
+              (let [cond (EVAL a1 env)]
+                (if (or (= cond nil) (= cond false))
+                  (if (> (count ast) 2)
+                    (recur a3 env)
+                    nil)
+                  (recur a2 env)))
+      
+              'fn*
+              (with-meta
+                (fn [& args]
+                  (EVAL a2 (env/env env a1 args)))
+                {:expression a2
+                 :environment env
+                 :parameters a1})
+      
+              ;; apply
+              (let [el (eval-ast ast env)
+                       f (first el)
+                       args (rest el)
+                       {:keys [expression environment parameters]} (meta f)]
+                (if expression
+                  (recur expression (env/env environment parameters args))
+                  (apply f args))))))))))
+
+;; print
+(defn PRINT [exp] (pr-str exp))
+
+;; repl
+(def repl-env (env/env))
+(defn rep
+  [strng]
+  (PRINT (EVAL (READ strng) repl-env)))
+
+;; core.clj: defined using Clojure
+(doseq [[k v] core/core_ns] (env/env-set repl-env k v))
+(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env)))
+(env/env-set repl-env '*ARGV* ())
+
+;; core.mal: defined using the language itself
+(rep "(def! *host-language* \"clojure\")")
+(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 []
+  (let [line (readline/readline "user> ")]
+    (when line
+      (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment
+        (try
+          (println (rep line))
+          (catch Throwable e
+            (clojure.repl/pst e))))
+      (recur))))
+
+(defn -main [& args]
+  (env/env-set repl-env '*ARGV* (rest args))
+  (if args
+    (rep (str "(load-file \"" (first args) "\")"))
+    (do
+      (rep "(println (str \"Mal [\" *host-language* \"]\"))")
+      (repl-loop))))