Commit | Line | Data |
---|---|---|
1ade7f90 VS |
1 | (defun load-relative (file) |
2 | (let* ((current-file (or load-file-name buffer-file-name)) | |
3 | (current-file-directory (file-name-directory current-file))) | |
4 | (load (expand-file-name file current-file-directory) nil t))) | |
5 | ||
6 | (load-relative "types.el") | |
7 | (load-relative "env.el") | |
8 | (load-relative "reader.el") | |
9 | (load-relative "printer.el") | |
10 | ||
11 | (defvar repl-env (mal-env)) | |
12 | (mal-env-set repl-env '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) | |
13 | (mal-env-set repl-env '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) | |
14 | (mal-env-set repl-env '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) | |
15 | (mal-env-set repl-env '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))) | |
16 | ||
17 | (defun READ (input) | |
18 | (read-str input)) | |
19 | ||
20 | (defun EVAL (ast env) | |
ecb8de2d | 21 | (if (and (mal-list-p ast) (mal-value ast)) |
1ade7f90 VS |
22 | (let* ((a (mal-value ast)) |
23 | (a0 (car a)) | |
24 | (a0* (mal-value a0)) | |
25 | (a1 (cadr a)) | |
26 | (a1* (mal-value a1)) | |
27 | (a2 (nth 2 a))) | |
28 | (cond | |
29 | ((eq a0* 'def!) | |
30 | (let ((identifier a1*) | |
31 | (value (EVAL a2 env))) | |
32 | (mal-env-set env identifier value))) | |
33 | ((eq a0* 'let*) | |
34 | (let ((env* (mal-env env)) | |
35 | (bindings (if (vectorp a1*) (append a1* nil) a1*)) | |
36 | (form a2)) | |
37 | (while bindings | |
38 | (let ((key (mal-value (pop bindings))) | |
39 | (value (EVAL (pop bindings) env*))) | |
40 | (mal-env-set env* key value))) | |
41 | (EVAL form env*))) | |
42 | (t | |
43 | ;; not a special form | |
44 | (let* ((ast* (mal-value (eval-ast ast env))) | |
45 | (fn (car ast*)) | |
46 | (args (cdr ast*))) | |
47 | (apply fn args))))) | |
48 | (eval-ast ast env))) | |
49 | ||
50 | (defun eval-ast (ast env) | |
51 | (let ((type (mal-type ast)) | |
52 | (value (mal-value ast))) | |
53 | (cond | |
54 | ((eq type 'symbol) | |
55 | (let ((definition (mal-env-get env value))) | |
56 | (or definition (error "Definition not found")))) | |
57 | ((eq type 'list) | |
58 | (mal-list (mapcar (lambda (item) (EVAL item env)) value))) | |
59 | ((eq type 'vector) | |
60 | (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) | |
61 | ((eq type 'map) | |
62 | (let ((map (copy-hash-table value))) | |
63 | (maphash (lambda (key value) | |
64 | (puthash key (EVAL value env) map)) | |
65 | map) | |
66 | (mal-map map))) | |
67 | (t | |
68 | ;; return as is | |
69 | ast)))) | |
70 | ||
71 | (defun PRINT (input) | |
72 | (pr-str input t)) | |
73 | ||
74 | (defun rep (input) | |
75 | (PRINT (EVAL (READ input) repl-env))) | |
76 | ||
77 | (defun readln (prompt) | |
78 | ;; C-d throws an error | |
79 | (ignore-errors (read-from-minibuffer prompt))) | |
80 | ||
81 | (defun println (format-string &rest args) | |
82 | (if (not args) | |
83 | (princ format-string) | |
84 | (princ (apply 'format format-string args))) | |
85 | (terpri)) | |
86 | ||
87 | (defun main () | |
88 | (let (eof) | |
89 | (while (not eof) | |
90 | (let ((input (readln "user> "))) | |
91 | (if input | |
92 | (condition-case err | |
93 | (println (rep input)) | |
94 | (end-of-token-stream | |
95 | ;; empty input, carry on | |
96 | ) | |
97 | (unterminated-sequence | |
98 | (let* ((type (cadr err)) | |
99 | (end | |
100 | (cond | |
101 | ((eq type 'string) ?\") | |
102 | ((eq type 'list) ?\)) | |
103 | ((eq type 'vector) ?\]) | |
104 | ((eq type 'map) ?})))) | |
105 | (princ (format "Expected '%c', got EOF\n" end)))) | |
106 | (error ; catch-all | |
107 | (println (error-message-string err)))) | |
108 | (setq eof t) | |
109 | ;; print final newline | |
110 | (terpri)))))) | |
111 | ||
112 | (main) |