blob: b8b55dc8fcc7298f4824d73d0ebd078ed6573571 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
(ns step8-macros
(:refer-clojure :exclude [macroexpand])
(:require [clojure.repl]
[readline]
[reader]
[printer]
[env]
[core]))
;; read
(defn READ [& [strng]]
(let [line (if strng strng (read-line))]
(reader/read-string strng)))
;; eval
(declare EVAL)
(defn is-pair [x]
(and (sequential? x) (> (count x) 0)))
(defn quasiquote [ast]
(cond
(not (is-pair ast))
(list 'quote ast)
(= 'unquote (first ast))
(second ast)
(and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
(list 'concat (-> ast first second) (quasiquote (rest ast)))
:else
(list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
(defn is-macro-call [ast env]
(and (seq? ast)
(symbol? (first ast))
(env/env-find env (first ast))
(:ismacro (meta (env/env-get env (first ast))))))
(defn macroexpand [ast env]
(loop [ast ast]
(if (is-macro-call ast env)
(let [mac (env/env-get env (first ast))]
(recur (apply mac (rest ast))))
ast)))
(defn eval-ast [ast env]
(cond
(symbol? ast) (env/env-get env ast)
(seq? ast) (doall (map #(EVAL % env) ast))
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
(map? ast) (apply hash-map (doall (map #(EVAL % env)
(mapcat identity ast))))
:else ast))
(defn EVAL [ast env]
(loop [ast ast
env env]
;;(prn "EVAL" ast (keys @env)) (flush)
(if (not (seq? ast))
(eval-ast ast env)
;; apply list
(let [ast (macroexpand ast env)]
(if (not (seq? ast))
ast
(let [[a0 a1 a2 a3] ast]
(condp = a0
'def!
(env/env-set env a1 (EVAL a2 env))
'let*
(let [let-env (env/env env)]
(doseq [[b e] (partition 2 a1)]
(env/env-set let-env b (EVAL e let-env)))
(recur a2 let-env))
'quote
a1
'quasiquote
(recur (quasiquote a1) env)
'defmacro!
(let [func (with-meta (EVAL a2 env)
{:ismacro true})]
(env/env-set env a1 func))
'macroexpand
(macroexpand a1 env)
'do
(do (eval-ast (->> ast (drop-last) (drop 1)) env)
(recur (last ast) env))
'if
(let [cond (EVAL a1 env)]
(if (or (= cond nil) (= cond false))
(if (> (count ast) 2)
(recur a3 env)
nil)
(recur a2 env)))
'fn*
(with-meta
(fn [& args]
(EVAL a2 (env/env env a1 args)))
{:expression a2
:environment env
:parameters a1})
;; apply
(let [el (eval-ast ast env)
f (first el)
args (rest el)
{:keys [expression environment parameters]} (meta f)]
(if expression
(recur expression (env/env environment parameters args))
(apply f args))))))))))
;; print
(defn PRINT [exp] (pr-str exp))
;; repl
(def repl-env (env/env))
(defn rep
[strng]
(PRINT (EVAL (READ strng) repl-env)))
;; core.clj: defined using Clojure
(doseq [[k v] core/core_ns] (env/env-set repl-env k v))
(env/env-set repl-env 'eval (fn [ast] (EVAL ast repl-env)))
(env/env-set repl-env '*ARGV* ())
;; core.mal: defined using the language itself
(rep "(def! not (fn* [a] (if a false true)))")
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(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)))))))")
(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))))))))")
;; repl loop
(defn repl-loop []
(let [line (readline/readline "user> ")]
(when line
(when-not (re-seq #"^\s*$|^\s*;.*$" line) ; blank/comment
(try
(println (rep line))
(catch Throwable e
(clojure.repl/pst e))))
(recur))))
(defn -main [& args]
(env/env-set repl-env '*ARGV* (rest args))
(if args
(rep (str "(load-file \"" (first args) "\")"))
(repl-loop)))
|
