mal/step7_quote.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! eval-ast (fn* [ast env] (do
  32   ;;(do (prn "eval-ast" ast "/" (keys env)) )
  33   (cond
  34     (symbol? ast) (env-get env ast)
  35
  36     (list? ast)   (map (fn* [exp] (EVAL exp env)) ast)
  37
  38     (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast))
  39
  40     (map? ast)    (apply hash-map
  41                       (apply concat
  42                         (map (fn* [k] [k (EVAL (get ast k) env)])
  43                              (keys ast))))
  44
  45     "else"        ast))))
  46
  47 (def! LET (fn* [env args]
  48   (if (> (count args) 0)
  49     (do
  50       (env-set env (nth args 0) (EVAL (nth args 1) env))
  51       (LET env (rest (rest args)))))))
  52
  53 (def! EVAL (fn* [ast env] (do
  54   ;;(do (prn "EVAL" ast "/" (keys @env)) )
  55   (if (not (list? ast))
  56     (eval-ast ast env)
  57
  58     ;; apply list
  59     (let* [a0 (first ast)]
  60       (cond
  61         (nil? a0)
  62         ast
  63
  64         (= 'def! a0)
  65         (env-set env (nth ast 1) (EVAL (nth ast 2) env))
  66
  67         (= 'let* a0)
  68         (let* [let-env (new-env env)]
  69           (do
  70             (LET let-env (nth ast 1))
  71             (EVAL (nth ast 2) let-env)))
  72
  73         (= 'quote a0)
  74         (nth ast 1)
  75
  76         (= 'quasiquote a0)
  77         (let* [a1 (nth ast 1)]
  78           (EVAL (QUASIQUOTE a1) env))
  79
  80         (= 'do a0)
  81         (let* [el (eval-ast (rest ast) env)]
  82           (nth el (- (count el) 1)))
  83
  84         (= 'if a0)
  85         (let* [cond (EVAL (nth ast 1) env)]
  86           (if (or (= cond nil) (= cond false))
  87             (if (> (count ast) 3)
  88               (EVAL (nth ast 3) env)
  89               nil)
  90             (EVAL (nth ast 2) env)))
  91
  92         (= 'fn* a0)
  93         (fn* [& args]
  94           (EVAL (nth ast 2) (new-env env (nth ast 1) args)))
  95
  96         "else"
  97         (let* [el (eval-ast ast env)
  98               f (first el)
  99               args (rest el)]
 100           (apply f args))))))))
 101
 102
 103 ;; print
 104 (def! PRINT (fn* [exp] (pr-str exp)))
 105
 106 ;; repl
 107 (def! repl-env (new-env))
 108 (def! rep (fn* [strng]
 109   (PRINT (EVAL (READ strng) repl-env))))
 110
 111 ;; core.mal: defined directly using mal
 112 (map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns)
 113 (env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env)))
 114 (env-set repl-env '*ARGV* (rest *ARGV*))
 115
 116 ;; core.mal: defined using the new language itself
 117 (rep "(def! not (fn* [a] (if a false true)))")
 118 (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
 119
 120 ;; repl loop
 121 (def! repl-loop (fn* []
 122   (let* [line (readline "mal-user> ")]
 123     (if line
 124       (do
 125         (if (not (= "" line))
 126           (try*
 127             (println (rep line))
 128             (catch* exc
 129               (println "Uncaught exception:" exc))))
 130         (repl-loop))))))
 131
 132 (def! -main (fn* [& args]
 133   (if (> (count args) 0)
 134     (rep (str "(load-file \"" (first args) "\")"))
 135     (repl-loop))))
 136 (apply -main *ARGV*)