HCoop
/
jackhill
/
mal.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Change quasiquote algorithm
[jackhill/mal.git]
/
impls
/
elisp
/
step6_file.el
diff --git
a/impls/elisp/step6_file.el
b/impls/elisp/step6_file.el
index
9a7ea68
..
88d09d0
100644
(file)
--- a/
impls/elisp/step6_file.el
+++ b/
impls/elisp/step6_file.el
@@
-22,36
+22,32
@@
(while t
(if (and (mal-list-p ast) (mal-value ast))
(let* ((a (mal-value ast))
(while t
(if (and (mal-list-p ast) (mal-value ast))
(let* ((a (mal-value ast))
- (a0 (car a))
- (a0* (mal-value a0))
(a1 (cadr a))
(a2 (nth 2 a))
(a3 (nth 3 a)))
(a1 (cadr a))
(a2 (nth 2 a))
(a3 (nth 3 a)))
- (c
ond
- (
(eq a0* 'def!)
+ (c
l-case (mal-value (car a))
+ (
def!
(let ((identifier (mal-value a1))
(value (EVAL a2 env)))
(throw 'return (mal-env-set env identifier value))))
(let ((identifier (mal-value a1))
(value (EVAL a2 env)))
(throw 'return (mal-env-set env identifier value))))
- ((eq a0* 'let*)
- (let* ((env* (mal-env env))
- (bindings (mal-value a1))
- (form a2))
- (when (vectorp bindings)
- (setq bindings (append bindings nil)))
+ (let*
+ (let ((env* (mal-env env))
+ (bindings (mal-listify a1))
+ (form a2))
(while bindings
(let ((key (mal-value (pop bindings)))
(value (EVAL (pop bindings) env*)))
(mal-env-set env* key value)))
(setq env env*
ast form))) ; TCO
(while bindings
(let ((key (mal-value (pop bindings)))
(value (EVAL (pop bindings) env*)))
(mal-env-set env* key value)))
(setq env env*
ast form))) ; TCO
- (
(eq a0* 'do)
+ (
do
(let* ((a0... (cdr a))
(butlast (butlast a0...))
(last (car (last a0...))))
(when butlast
(eval-ast (mal-list butlast) env))
(setq ast last))) ; TCO
(let* ((a0... (cdr a))
(butlast (butlast a0...))
(last (car (last a0...))))
(when butlast
(eval-ast (mal-list butlast) env))
(setq ast last))) ; TCO
- (
(eq a0* 'if)
+ (
if
(let* ((condition (EVAL a1 env))
(condition-type (mal-type condition))
(then a2)
(let* ((condition (EVAL a1 env))
(condition-type (mal-type condition))
(then a2)
@@
-62,7
+58,7
@@
(if else
(setq ast else) ; TCO
(throw 'return mal-nil)))))
(if else
(setq ast else) ; TCO
(throw 'return mal-nil)))))
- (
(eq a0* 'fn*)
+ (
fn*
(let* ((binds (mapcar 'mal-value (mal-value a1)))
(body a2)
(fn (mal-fn
(let* ((binds (mapcar 'mal-value (mal-value a1)))
(body a2)
(fn (mal-fn
@@
-87,20
+83,19
@@
(throw 'return (eval-ast ast env))))))
(defun eval-ast (ast env)
(throw 'return (eval-ast ast env))))))
(defun eval-ast (ast env)
- (let ((type (mal-type ast))
- (value (mal-value ast)))
- (cond
- ((eq type 'symbol)
+ (let ((value (mal-value ast)))
+ (cl-case (mal-type ast)
+ (symbol
(let ((definition (mal-env-get env value)))
(or definition (error "Definition not found"))))
(let ((definition (mal-env-get env value)))
(or definition (error "Definition not found"))))
- (
(eq type 'list)
+ (
list
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
- (
(eq type 'vector)
+ (
vector
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
- (
(eq type 'map)
+ (
map
(let ((map (copy-hash-table value)))
(let ((map (copy-hash-table value)))
- (maphash (lambda (key val
ue
)
- (puthash key (EVAL val
ue
env) map))
+ (maphash (lambda (key val)
+ (puthash key (EVAL val env) map))
map)
(mal-map map)))
(t
map)
(mal-map map)))
(t
@@
-136,14
+131,12
@@
;; empty input, carry on
)
(unterminated-sequence
;; empty input, carry on
)
(unterminated-sequence
- (let* ((type (cadr err))
- (end
- (cond
- ((eq type 'string) ?\")
- ((eq type 'list) ?\))
- ((eq type 'vector) ?\])
- ((eq type 'map) ?}))))
- (princ (format "Expected '%c', got EOF\n" end))))
+ (princ (format "Expected '%c', got EOF\n"
+ (cl-case (cadr err)
+ (string ?\")
+ (list ?\))
+ (vector ?\])
+ (map ?})))))
(error ; catch-all
(println (error-message-string err)))))
(error ; catch-all
(println (error-message-string err)))))