Commit | Line | Data |
---|---|---|
31690700 JM |
1 | (ns step9-interop |
2 | (:refer-clojure :exclude [macroexpand]) | |
3 | (:require [clojure.repl] | |
31690700 | 4 | [readline] |
ea81a808 JM |
5 | [reader] |
6 | [printer] | |
7 | [env] | |
8 | [core])) | |
31690700 JM |
9 | |
10 | ;; read | |
11 | (defn READ [& [strng]] | |
12 | (let [line (if strng strng (read-line))] | |
13 | (reader/read-string strng))) | |
14 | ||
15 | ;; eval | |
ea81a808 | 16 | (declare EVAL) |
31690700 JM |
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)) | |
ea81a808 JM |
37 | (env/env-find env (first ast)) |
38 | (:ismacro (meta (env/env-get env (first ast)))))) | |
31690700 JM |
39 | |
40 | (defn macroexpand [ast env] | |
41 | (loop [ast ast] | |
42 | (if (is-macro-call ast env) | |
ea81a808 | 43 | (let [mac (env/env-get env (first ast))] |
31690700 JM |
44 | (recur (apply mac (rest ast)))) |
45 | ast))) | |
46 | ||
47 | (defn eval-ast [ast env] | |
48 | (cond | |
ea81a808 | 49 | (symbol? ast) (env/env-get env ast) |
31690700 JM |
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! | |
ea81a808 | 75 | (env/env-set env a1 (EVAL a2 env)) |
31690700 JM |
76 | |
77 | 'let* | |
ea81a808 | 78 | (let [let-env (env/env env)] |
31690700 | 79 | (doseq [[b e] (partition 2 a1)] |
ea81a808 | 80 | (env/env-set let-env b (EVAL e let-env))) |
31690700 JM |
81 | (EVAL a2 let-env)) |
82 | ||
83 | 'quote | |
84 | a1 | |
85 | ||
86 | 'quasiquote | |
87 | (EVAL (quasiquote a1) env) | |
88 | ||
89 | 'defmacro! | |
90 | (let [func (with-meta (EVAL a2 env) | |
91 | {:ismacro true})] | |
ea81a808 | 92 | (env/env-set env a1 func)) |
31690700 JM |
93 | |
94 | 'macroexpand | |
95 | (macroexpand a1 env) | |
96 | ||
97 | 'clj* | |
98 | (eval (reader/read-string a1)) | |
99 | ||
100 | 'do | |
101 | (do (eval-ast (->> ast (drop-last) (drop 1)) env) | |
102 | (recur (last ast) env)) | |
103 | ||
104 | 'if | |
105 | (let [cond (EVAL a1 env)] | |
106 | (if (or (= cond nil) (= cond false)) | |
107 | (if (> (count ast) 2) | |
108 | (recur a3 env) | |
109 | nil) | |
110 | (recur a2 env))) | |
111 | ||
112 | 'fn* | |
a34b0200 JM |
113 | (with-meta |
114 | (fn [& args] | |
115 | (EVAL a2 (env/env env a1 args))) | |
116 | {:expression a2 | |
117 | :environment env | |
118 | :parameters a1}) | |
31690700 JM |
119 | |
120 | ;; apply | |
121 | (let [el (eval-ast ast env) | |
122 | f (first el) | |
123 | args (rest el) | |
124 | {:keys [expression environment parameters]} (meta f)] | |
125 | (if expression | |
ea81a808 | 126 | (recur expression (env/env environment parameters args)) |
31690700 JM |
127 | (apply f args)))))))))) |
128 | ||
129 | ||
130 | (defn PRINT [exp] (pr-str exp)) | |
131 | ||
132 | ;; repl | |
ea81a808 | 133 | (def repl-env (env/env)) |
31690700 JM |
134 | (defn rep |
135 | [strng] | |
136 | (PRINT (EVAL (READ strng) repl-env))) | |
137 | ||
8cb5cda4 JM |
138 | ;; core.clj: defined using Clojure |
139 | (doseq [[k v] core/core_ns] (env/env-set repl-env k v)) | |
140 | (env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env))) | |
31690700 | 141 | |
8cb5cda4 | 142 | ;; core.mal: defined using the language itself |
31690700 | 143 | (rep "(def! not (fn* [a] (if a false true)))") |
1617910a | 144 | (rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))") |
8cb5cda4 JM |
145 | (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)))))))") |
146 | (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))))))))") | |
31690700 JM |
147 | |
148 | (defn -main [& args] | |
149 | (if args | |
150 | (rep (str "(load-file \"" (first args) "\")")) | |
151 | (loop [] | |
152 | (let [line (readline/readline "user> ")] | |
153 | (when line | |
154 | (when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment | |
155 | (try | |
156 | (println (rep line)) | |
157 | (catch Throwable e | |
158 | (clojure.repl/pst e)))) | |
159 | (recur)))))) |