All: move some fns to core. Major cleanup.
[jackhill/mal.git] / clojure / src / step4_if_fn_do.clj
CommitLineData
31690700
JM
1(ns step4-if-fn-do
2 (:require [clojure.repl]
31690700 3 [readline]
ea81a808
JM
4 [reader]
5 [printer]
6 [env]
7 [core]))
31690700
JM
8
9;; read
10(defn READ [& [strng]]
11 (let [line (if strng strng (read-line))]
12 (reader/read-string strng)))
13
14;; eval
ea81a808 15(declare EVAL)
31690700
JM
16(defn eval-ast [ast env]
17 (cond
ea81a808 18 (symbol? ast) (env/env-get env ast)
31690700
JM
19
20 (seq? ast) (doall (map #(EVAL % env) ast))
21
22 (vector? ast) (vec (doall (map #(EVAL % env) ast)))
23
24 (map? ast) (apply hash-map (doall (map #(EVAL % env)
25 (mapcat identity ast))))
26
27 :else ast))
28
29(defn EVAL [ast env]
30 ;;(prn "EVAL" ast (keys @env)) (flush)
31 (if (not (seq? ast))
32 (eval-ast ast env)
33
34 ;; apply list
35 (let [[a0 a1 a2 a3] ast]
36 (condp = a0
37 'def!
ea81a808 38 (env/env-set env a1 (EVAL a2 env))
31690700
JM
39
40 'let*
ea81a808 41 (let [let-env (env/env env)]
31690700 42 (doseq [[b e] (partition 2 a1)]
ea81a808 43 (env/env-set let-env b (EVAL e let-env)))
31690700
JM
44 (EVAL a2 let-env))
45
46 'do
47 (last (eval-ast (rest ast) env))
48
49 'if
50 (let [cond (EVAL a1 env)]
51 (if (or (= cond nil) (= cond false))
52 (if (> (count ast) 2)
53 (EVAL a3 env)
54 nil)
55 (EVAL a2 env)))
56
57 'fn*
58 (fn [& args]
ea81a808 59 (EVAL a2 (env/env env a1 args)))
31690700
JM
60
61 ;; apply
62 (let [el (eval-ast ast env)
63 f (first el)
64 args (rest el)]
65 (apply f args))))))
66
67;; print
68(defn PRINT [exp] (pr-str exp))
69
70;; repl
ea81a808 71(def repl-env (env/env))
31690700
JM
72(defn rep
73 [strng]
a34b0200 74 (PRINT (EVAL (READ strng) repl-env)))
31690700 75
8cb5cda4
JM
76;; core.clj: defined using Clojure
77(doseq [[k v] core/core_ns] (env/env-set repl-env k v))
78(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env)))
31690700 79
8cb5cda4 80;; core.mal: defined using the language itself
31690700
JM
81(rep "(def! not (fn* [a] (if a false true)))")
82
83(defn -main [& args]
84 (loop []
85 (let [line (readline/readline "user> ")]
86 (when line
87 (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment
88 (try
89 (println (rep line))
90 (catch Throwable e
91 (clojure.repl/pst e))))
92 (recur)))))