1 (de load-relative (Path)
2 (load (pack (car (file)) Path)) )
4 (load-relative "readline.l")
5 (load-relative "types.l")
6 (load-relative "reader.l")
7 (load-relative "printer.l")
8 (load-relative "env.l")
9 (load-relative "func.l")
10 (load-relative "core.l")
15 (def '*ReplEnv (MAL-env NIL))
16 (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind)))
19 (and (memq (MAL-type Ast) '(list vector)) (MAL-value Ast) T) )
22 (if (not (is-pair Ast))
23 (MAL-list (list (MAL-symbol 'quote) Ast))
24 (let A (MAL-value Ast)
26 ((= (MAL-value (car A)) 'unquote)
28 ((and (is-pair (car A))
29 (= (MAL-value (car (MAL-value (car A)))) 'splice-unquote) )
30 (MAL-list (list (MAL-symbol 'concat)
31 (cadr (MAL-value (car A)))
32 (quasiquote (MAL-list (cdr A))) ) ) )
34 (MAL-list (list (MAL-symbol 'cons)
36 (quasiquote (MAL-list (cdr A))) ) ) ) ) ) ) )
38 (de is-macro-call (Ast Env)
39 (when (= (MAL-type Ast) 'list)
40 (let A0 (car (MAL-value Ast))
41 (when (= (MAL-type A0) 'symbol)
42 (let Value (find> Env (MAL-value A0))
43 (and (isa '+Func Value) (get Value 'is-macro) T) ) ) ) ) )
45 (de macroexpand (Ast Env)
46 (while (is-macro-call Ast Env)
47 (let (Ast* (MAL-value Ast)
48 Macro (get (find> Env (MAL-value (car Ast*))) 'fn)
50 (setq Ast (apply (MAL-value Macro) Args)) ) )
56 (when (not (= (MAL-type Ast) 'list))
57 (throw 'done (eval-ast Ast Env)) )
58 (setq Ast (macroexpand Ast Env))
59 (when (or (not (= (MAL-type Ast) 'list)) (not (MAL-value Ast)))
60 (throw 'done (eval-ast Ast Env)) )
61 (let (Ast* (MAL-value Ast)
62 A0* (MAL-value (car Ast*))
69 (throw 'done (set> Env A1* (EVAL A2 Env))) )
73 (setq Ast (quasiquote A1)) ) # TCO
75 (let Form (EVAL A2 Env)
76 (put Form 'is-macro T)
77 (throw 'done (set> Env A1* Form)) ) )
79 (throw 'done (macroexpand A1 Env)) )
81 (let Result (catch 'err (throw 'done (EVAL A1 Env)))
82 (if (isa '+MALError Result)
84 (if (and (= (MAL-type A2) 'list)
85 (= (MAL-value (car A)) 'catch*) )
86 (let (Bind (MAL-value (cadr A))
87 Exc (MAL-value Result)
89 Env* (MAL-env Env (list Bind) (list Exc)) )
90 (throw 'done (EVAL Form Env*)) )
91 (throw 'err Result) ) )
92 (throw 'done Result) ) ) )
94 (let Env* (MAL-env Env)
95 (for (Bindings A1* Bindings)
96 (let (Key (MAL-value (pop 'Bindings))
97 Value (EVAL (pop 'Bindings) Env*) )
98 (set> Env* Key Value) ) )
99 (setq Env Env* Ast A2) ) ) # TCO
101 (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*)))
102 (setq Ast (last Ast*)) ) # TCO
104 (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false)))
108 (throw 'done *MAL-nil) ) ) )
110 (let (Binds (mapcar MAL-value A1*)
113 (curry (Env Binds Body) @
114 (let Env* (MAL-env Env Binds (rest))
115 (EVAL Body Env*) ) ) ) )
116 (throw 'done (MAL-func Env Body Binds Fn)) ) )
118 (let (Ast* (MAL-value (eval-ast Ast Env))
122 (throw 'done (apply (MAL-value Fn) Args))
123 (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args)
124 (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) )
126 (de eval-ast (Ast Env)
127 (let Value (MAL-value Ast)
129 (symbol (get> Env Value))
130 (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value)))
131 (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value)))
132 (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value)))
135 (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv))))
136 (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv)))))
142 (PRINT (EVAL (READ String) *ReplEnv)) )
144 (rep "(def! not (fn* (a) (if a false true)))")
145 (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))")
146 (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)))))))")
148 (load-history ".mal_history")
151 (rep (pack "(load-file \"" (car (argv)) "\")"))
153 (until (=0 (setq Input (readline "user> ")))
154 (let Output (catch 'err (rep Input))
155 (if (isa '+MALError Output)
156 (let Message (MAL-value Output)
157 (unless (= (MAL-value Message) "end of token stream")
158 (prinl "[error] " (pr-str Message)) ) )
159 (prinl Output) ) ) ) ) )