clojure/src/stepA_more.clj

   1 (ns stepA-more
   2     (:refer-clojure :exclude [macroexpand])
   3     (:require [clojure.repl]
   4               [readline]
   5               [reader]
   6               [printer]
   7               [env]
   8               [core]))
   9
  10 ;; read
  11 (defn READ [& [strng]]
  12   (let [line (if strng strng (read-line))]
  13     (reader/read-string strng)))
  14
  15 ;; eval
  16 (declare EVAL)
  17 (defn is-pair [x]
  18   (and (sequential? x) (> (count x) 0)))
  19
  20 (defn quasiquote [ast]
  21   (cond
  22     (not (is-pair ast))
  23     (list 'quote ast)
  24
  25     (= 'unquote (first ast))
  26     (second ast)
  27
  28     (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
  29     (list 'concat (-> ast first second) (quasiquote (rest ast)))
  30
  31     :else
  32     (list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
  33
  34 (defn is-macro-call [ast env]
  35   (and (seq? ast)
  36        (symbol? (first ast))
  37        (env/env-find env (first ast))
  38        (:ismacro (meta (env/env-get env (first ast))))))
  39
  40 (defn macroexpand [ast env]
  41   (loop [ast ast]
  42     (if (is-macro-call ast env)
  43       (let [mac (env/env-get env (first ast))]
  44         (recur (apply mac (rest ast))))
  45       ast)))
  46
  47 (defn eval-ast [ast env]
  48   (cond
  49     (symbol? ast) (env/env-get env ast)
  50
  51     (seq? ast)    (doall (map #(EVAL % env) ast))
  52
  53     (vector? ast) (vec (doall (map #(EVAL % env) ast)))
  54
  55     (map? ast)    (apply hash-map (doall (map #(EVAL % env)
  56                                               (mapcat identity ast))))
  57
  58     :else         ast))
  59
  60 (defn EVAL [ast env]
  61   (loop [ast ast
  62          env env]
  63     ;;(prn "EVAL" ast (keys @env)) (flush)
  64     (if (not (seq? ast))
  65       (eval-ast ast env)
  66
  67       ;; apply list
  68       (let [ast (macroexpand ast env)]
  69         (if (not (seq? ast))
  70           ast
  71
  72           (let [[a0 a1 a2 a3] ast]
  73             (condp = a0
  74               'def!
  75               (env/env-set env a1 (EVAL a2 env))
  76
  77               'let*
  78               (let [let-env (env/env env)]
  79                 (doseq [[b e] (partition 2 a1)]
  80                   (env/env-set let-env b (EVAL e let-env)))
  81                 (recur a2 let-env))
  82
  83               'quote
  84               a1
  85
  86               'quasiquote
  87               (recur (quasiquote a1) env)
  88
  89               'defmacro!
  90               (let [func (with-meta (EVAL a2 env)
  91                                     {:ismacro true})]
  92                 (env/env-set env a1 func))
  93
  94               'macroexpand
  95               (macroexpand a1 env)
  96
  97               'clj*
  98               (eval (reader/read-string a1))
  99
 100               'try*
 101               (if (= 'catch* (nth a2 0))
 102                 (try
 103                   (EVAL a1 env)
 104                   (catch clojure.lang.ExceptionInfo ei
 105                     (EVAL (nth a2 2) (env/env env
 106                                               [(nth a2 1)]
 107                                               [(:data (ex-data ei))])))
 108                   (catch Throwable t
 109                     (EVAL (nth a2 2) (env/env env
 110                                               [(nth a2 1)]
 111                                               [(.getMessage t)]))))
 112                 (EVAL a1 env))
 113
 114               'do
 115               (do (eval-ast (->> ast (drop-last) (drop 1)) env)
 116                   (recur (last ast) env))
 117
 118               'if
 119               (let [cond (EVAL a1 env)]
 120                 (if (or (= cond nil) (= cond false))
 121                   (if (> (count ast) 2)
 122                     (recur a3 env)
 123                     nil)
 124                   (recur a2 env)))
 125
 126               'fn*
 127               (with-meta
 128                 (fn [& args]
 129                   (EVAL a2 (env/env env a1 args)))
 130                 {:expression a2
 131                  :environment env
 132                  :parameters a1})
 133
 134               ;; apply
 135               (let [el (eval-ast ast env)
 136                        f (first el)
 137                        args (rest el)
 138                        {:keys [expression environment parameters]} (meta f)]
 139                 (if expression
 140                   (recur expression (env/env environment parameters args))
 141                   (apply f args))))))))))
 142
 143 ;; print
 144 (defn PRINT [exp] (pr-str exp))
 145
 146 ;; repl
 147 (def repl-env (env/env))
 148 (defn rep
 149   [strng]
 150   (PRINT (EVAL (READ strng) repl-env)))
 151
 152 ;; core.clj: defined using Clojure
 153 (doseq [[k v] core/core_ns] (env/env-set repl-env k v))
 154 (env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env)))
 155 (env/env-set repl-env '*ARGV* ())
 156
 157 ;; core.mal: defined using the language itself
 158 (rep "(def! *host-language* \"clojure\")")
 159 (rep "(def! not (fn* [a] (if a false true)))")
 160 (rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
 161 (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)))))))")
 162 (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))))))))")
 163
 164 ;; repl loop
 165 (defn repl-loop []
 166   (let [line (readline/readline "user> ")]
 167     (when line
 168       (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment
 169         (try
 170           (println (rep line))
 171           (catch Throwable e
 172             (clojure.repl/pst e))))
 173       (recur))))
 174
 175 (defn -main [& args]
 176   (env/env-set repl-env '*ARGV* (rest args))
 177   (if args
 178     (rep (str "(load-file \"" (first args) "\")"))
 179     (do
 180       (rep "(println (str \"Mal [\" *host-language* \"]\"))")
 181       (repl-loop))))