mal/step9_try.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         (eval-ast ast env)
  78
  79         (let* [a0 (first ast)]
  80           (cond
  81             (nil? a0)
  82             ast
  83
  84             (= 'def! a0)
  85             (env-set env (nth ast 1) (EVAL (nth ast 2) env))
  86
  87             (= 'let* a0)
  88             (let* [let-env (new-env env)]
  89               (do
  90                 (LET let-env (nth ast 1))
  91                 (EVAL (nth ast 2) let-env)))
  92
  93             (= 'quote a0)
  94             (nth ast 1)
  95
  96             (= 'quasiquote a0)
  97             (let* [a1 (nth ast 1)]
  98               (EVAL (QUASIQUOTE a1) env))
  99
 100             (= 'defmacro! a0)
 101             (let* [a1 (nth ast 1)
 102                    a2 (nth ast 2)
 103                    f (EVAL a2 env)
 104                    m (or (meta f) {})
 105                    mac (with-meta f (assoc m "ismacro" true))]
 106               (env-set env a1 mac))
 107
 108             (= 'macroexpand a0)
 109             (let* [a1 (nth ast 1)]
 110               (MACROEXPAND a1 env))
 111
 112             (= 'try* a0)
 113             (if (= 'catch* (nth (nth ast 2) 0))
 114               (try*
 115                 (EVAL (nth ast 1) env)
 116                 (catch* exc
 117                   (EVAL (nth (nth ast 2) 2)
 118                         (new-env env
 119                                  [(nth (nth ast 2)1)]
 120                                  [exc]))))
 121               (EVAL (nth ast 1) env))
 122
 123             (= 'do a0)
 124             (let* [el (eval-ast (rest ast) env)]
 125               (nth el (- (count el) 1)))
 126
 127             (= 'if a0)
 128             (let* [cond (EVAL (nth ast 1) env)]
 129               (if (or (= cond nil) (= cond false))
 130                 (if (> (count ast) 3)
 131                   (EVAL (nth ast 3) env)
 132                   nil)
 133                 (EVAL (nth ast 2) env)))
 134
 135             (= 'fn* a0)
 136             (fn* [& args]
 137               (EVAL (nth ast 2) (new-env env (nth ast 1) args)))
 138
 139             "else"
 140             (let* [el (eval-ast ast env)
 141                   f (first el)
 142                   args (rest el)]
 143               (apply f args))))))))))
 144
 145
 146 ;; print
 147 (def! PRINT (fn* [exp] (pr-str exp)))
 148
 149 ;; repl
 150 (def! repl-env (new-env))
 151 (def! rep (fn* [strng]
 152   (PRINT (EVAL (READ strng) repl-env))))
 153
 154 ;; core.mal: defined directly using mal
 155 (map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns)
 156 (env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env)))
 157 (env-set repl-env '*ARGV* (rest *ARGV*))
 158
 159 ;; core.mal: defined using the new language itself
 160 (rep "(def! not (fn* [a] (if a false true)))")
 161 (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
 162 (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)))))))")
 163 (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))))))))")
 164
 165 ;; repl loop
 166 (def! repl-loop (fn* []
 167   (let* [line (readline "mal-user> ")]
 168     (if line
 169       (do
 170         (if (not (= "" line))
 171           (try*
 172             (println (rep line))
 173             (catch* exc
 174               (println "Uncaught exception:" exc))))
 175         (repl-loop))))))
 176
 177 (def! -main (fn* [& args]
 178   (if (> (count args) 0)
 179     (rep (str "(load-file \"" (first args) "\")"))
 180     (repl-loop))))
 181 (apply -main *ARGV*)