X-Git-Url: http://git.hcoop.net/jackhill/mal.git/blobdiff_plain/ece70f970306f819b148979c3d17f266c7e08146..fbfe6784d2db983018340e4e1492d8d017029867:/impls/elisp/step6_file.el

diff --git a/impls/elisp/step6_file.el b/impls/elisp/step6_file.el
index 9a7ea686..88d09d0e 100644
--- 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))
-                 (a0 (car a))
-                 (a0* (mal-value a0))
                  (a1 (cadr a))
                  (a2 (nth 2 a))
                  (a3 (nth 3 a)))
-            (cond
-             ((eq a0* 'def!)
+            (cl-case (mal-value (car a))
+             (def!
               (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
-             ((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
-             ((eq a0* 'if)
+             (if
               (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)))))
-             ((eq a0* 'fn*)
+             (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)
-  (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"))))
-     ((eq type 'list)
+     (list
       (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
-     ((eq type 'vector)
+     (vector
       (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
-     ((eq type 'map)
+     (map
       (let ((map (copy-hash-table value)))
-        (maphash (lambda (key value)
-                   (puthash key (EVAL value env) map))
+        (maphash (lambda (key val)
+                   (puthash key (EVAL val env) map))
                  map)
         (mal-map map)))
      (t
@@ -136,14 +131,12 @@
       ;; 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)))))