mal/stepA_mal.mal

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