Commit | Line | Data |
---|---|---|
32a75b86 VS |
1 | (de load-relative (Path) |
2 | (load (pack (car (file)) Path)) ) | |
3 | ||
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") | |
11 | ||
12 | (de READ (String) | |
13 | (read-str String) ) | |
14 | ||
15 | (def '*ReplEnv (MAL-env NIL)) | |
16 | (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) | |
17 | ||
18 | (de is-pair (Ast) | |
19 | (and (memq (MAL-type Ast) '(list vector)) (MAL-value Ast) T) ) | |
20 | ||
21 | (de quasiquote (Ast) | |
22 | (if (not (is-pair Ast)) | |
23 | (MAL-list (list (MAL-symbol 'quote) Ast)) | |
24 | (let A (MAL-value Ast) | |
25 | (cond | |
26 | ((= (MAL-value (car A)) 'unquote) | |
27 | (cadr A) ) | |
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))) ) ) ) | |
33 | (T | |
34 | (MAL-list (list (MAL-symbol 'cons) | |
35 | (quasiquote (car A)) | |
36 | (quasiquote (MAL-list (cdr A))) ) ) ) ) ) ) ) | |
37 | ||
38 | (de EVAL (Ast Env) | |
39 | (catch 'done | |
40 | (while t | |
41 | (if (and (= (MAL-type Ast) 'list) (MAL-value Ast)) | |
42 | (let (Ast* (MAL-value Ast) | |
43 | A0* (MAL-value (car Ast*)) | |
44 | A1 (cadr Ast*) | |
45 | A1* (MAL-value A1) | |
46 | A2 (caddr Ast*) | |
47 | A3 (cadddr Ast*) ) | |
48 | (cond | |
49 | ((= A0* 'def!) | |
50 | (throw 'done (set> Env A1* (EVAL A2 Env))) ) | |
51 | ((= A0* 'quote) | |
52 | (throw 'done A1) ) | |
53 | ((= A0* 'quasiquote) | |
54 | (setq Ast (quasiquote A1)) ) # TCO | |
55 | ((= A0* 'let*) | |
56 | (let Env* (MAL-env Env) | |
57 | (for (Bindings A1* Bindings) | |
58 | (let (Key (MAL-value (pop 'Bindings)) | |
59 | Value (EVAL (pop 'Bindings) Env*) ) | |
60 | (set> Env* Key Value) ) ) | |
61 | (setq Env Env* Ast A2) ) ) # TCO | |
62 | ((= A0* 'do) | |
63 | (mapc '((Form) (EVAL Form Env)) (head -1 (cdr Ast*))) | |
64 | (setq Ast (last Ast*)) ) # TCO | |
65 | ((= A0* 'if) | |
66 | (if (not (memq (MAL-type (EVAL A1 Env)) '(nil false))) | |
67 | (setq Ast A2) # TCO | |
68 | (if A3 | |
69 | (setq Ast A3) # TCO | |
70 | (throw 'done *MAL-nil) ) ) ) | |
71 | ((= A0* 'fn*) | |
72 | (let (Binds (mapcar MAL-value A1*) | |
73 | Body A2 | |
74 | Fn (MAL-fn | |
75 | (curry (Env Binds Body) @ | |
76 | (let Env* (MAL-env Env Binds (rest)) | |
77 | (EVAL Body Env*) ) ) ) ) | |
78 | (throw 'done (MAL-func Env Body Binds Fn)) ) ) | |
79 | (T | |
80 | (let (Ast* (MAL-value (eval-ast Ast Env)) | |
81 | Fn (car Ast*) | |
82 | Args (cdr Ast*) ) | |
83 | (if (isa '+MALFn Fn) | |
84 | (throw 'done (apply (MAL-value Fn) Args)) | |
85 | (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) | |
86 | (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) | |
87 | (throw 'done (eval-ast Ast Env)) ) ) ) ) | |
88 | ||
89 | (de eval-ast (Ast Env) | |
90 | (let Value (MAL-value Ast) | |
91 | (case (MAL-type Ast) | |
92 | (symbol (get> Env Value)) | |
93 | (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) | |
94 | (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) | |
95 | (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) | |
96 | (T Ast) ) ) ) | |
97 | ||
98 | (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) | |
fbe5bd7a | 99 | (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) |
32a75b86 VS |
100 | |
101 | (de PRINT (Ast) | |
102 | (pr-str Ast T) ) | |
103 | ||
104 | (de rep (String) | |
105 | (PRINT (EVAL (READ String) *ReplEnv)) ) | |
106 | ||
107 | (rep "(def! not (fn* (a) (if a false true)))") | |
e6d41de4 | 108 | (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") |
32a75b86 VS |
109 | |
110 | (load-history ".mal_history") | |
111 | ||
112 | (if (argv) | |
fbe5bd7a | 113 | (rep (pack "(load-file \"" (car (argv)) "\")")) |
32a75b86 VS |
114 | (use Input |
115 | (until (=0 (setq Input (readline "user> "))) | |
116 | (let Output (catch 'err (rep Input)) | |
117 | (if (isa '+MALError Output) | |
118 | (let Message (MAL-value Output) | |
1809f9ba VS |
119 | (unless (= (MAL-value Message) "end of token stream") |
120 | (prinl "[error] " (pr-str Message)) ) ) | |
32a75b86 VS |
121 | (prinl Output) ) ) ) ) ) |
122 | ||
123 | (prinl) | |
124 | (bye) |