Implement step 4

diff --git a/elisp/core.el b/elisp/core.el
new file mode 100644 (file)
index 0000000..fadc817
--- /dev/null
+++ b/elisp/core.el
@@ -0,0 +1,60 @@
+(defun mal-seq-p (mal-object)
+  (let ((type (mal-type mal-object)))
+    (if (or (eq type 'list) (eq type 'vector))
+        (mal-true)
+      (mal-false))))
+
+(defun mal-listify (mal-object)
+  (let ((type (mal-type mal-object)))
+    (if (eq type 'vector)
+        (mal-list (append (mal-value mal-object) nil))
+      mal-object)))
+
+(defun everyp (predicate list-a list-b)
+  (let ((everyp t))
+    (while (and everyp list-a list-b)
+      (let ((item-a (pop list-a))
+            (item-b (pop list-b)))
+        (when (not (funcall predicate item-a item-b))
+          (setq everyp nil))))
+    everyp))
+
+(defun mal-= (a b)
+  (let ((mal-seq-a-p (mal-true-p (mal-seq-p a)))
+        (mal-seq-b-p (mal-true-p (mal-seq-p b))))
+    (cond
+     ((and (not mal-seq-a-p) (not mal-seq-b-p))
+      (equal (mal-value a) (mal-value b)))
+     ((or (and (not mal-seq-a-p) mal-seq-b-p)
+          (and mal-seq-a-p (not mal-seq-b-p)))
+      nil)
+     ((and mal-seq-a-p mal-seq-b-p
+           (= (length (mal-value a))
+              (length (mal-value b))))
+      (if (everyp 'mal-= (mal-value (mal-listify a)) (mal-value (mal-listify b)))
+          t
+        nil)))))
+
+(defvar core-ns
+  '((+ . (lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))))
+    (- . (lambda (a b) (mal-number (- (mal-value a) (mal-value b)))))
+    (* . (lambda (a b) (mal-number (* (mal-value a) (mal-value b)))))
+    (/ . (lambda (a b) (mal-number (/ (mal-value a) (mal-value b)))))
+
+    (< . (lambda (a b) (if (< (mal-value a) (mal-value b)) (mal-true) (mal-false))))
+    (<= . (lambda (a b) (if (<= (mal-value a) (mal-value b)) (mal-true) (mal-false))))
+    (> . (lambda (a b) (if (> (mal-value a) (mal-value b)) (mal-true) (mal-false))))
+    (>= . (lambda (a b) (if (>= (mal-value a) (mal-value b)) (mal-true) (mal-false))))
+
+    (= . (lambda (a b) (if (mal-= a b) (mal-true) (mal-false))))
+
+    (list . (lambda (&rest args) (mal-list args)))
+    (list? . (lambda (mal-object) (if (mal-list-p mal-object) (mal-true) (mal-false))))
+    (empty? . (lambda (seq) (if (zerop (length (mal-value seq))) (mal-true) (mal-false))))
+    (count . (lambda (seq) (mal-number (if (mal-seq-p seq) (length (mal-value seq)) 0))))
+
+    (pr-str . (lambda (&rest args) (mal-string (mapconcat (lambda (item) (pr-str item t)) args " "))))
+    (str . (lambda (&rest args) (mal-string (mapconcat 'pr-str args ""))))
+    (prn . (lambda (&rest args) (println (mapconcat (lambda (item) (pr-str item t)) args " ")) (mal-nil)))
+    (println . (lambda (&rest args) (println (mapconcat 'pr-str args " ")) (mal-nil)))
+    ))

diff --git a/elisp/env.el b/elisp/env.el
index c59d0c8..99b32b6 100644 (file)
--- a/elisp/env.el
+++ b/elisp/env.el
@@ -1,5 +1,16 @@
-(defun mal-env (&optional outer)
-  (vector 'env (vector (make-hash-table :test 'eq) outer)))
+(defun mal-env (&optional outer binds exprs)
+  (let ((env (vector 'env (vector (make-hash-table :test 'eq) outer))))
+    (while binds
+      (let ((key (pop binds)))
+        (if (eq key '&)
+            (let ((key (pop binds))
+                  (value (mal-list exprs)))
+              (mal-env-set env key value)
+              (setq binds nil
+                    exprs nil))
+          (let ((value (pop exprs)))
+            (mal-env-set env key value)))))
+    env))
 
 (defun mal-env-set (env key value)
   (let ((data (aref (aref env 1) 0)))

diff --git a/elisp/printer.el b/elisp/printer.el
index b425a26..c355405 100644 (file)
--- a/elisp/printer.el
+++ b/elisp/printer.el
@@ -22,7 +22,11 @@
      ((eq type 'vector)
       (pr-vector value print-readably))
      ((eq type 'map)
-      (pr-map value print-readably)))))
+      (pr-map value print-readably))
+     ((eq type 'fn)
+      "#<fn>")
+     ((eq type 'func)
+      "#<func>"))))
 
 (defun pr-list (form print-readably)
   (let ((items (mapconcat

diff --git a/elisp/step4_if_fn_do.el b/elisp/step4_if_fn_do.el
new file mode 100644 (file)
index 0000000..6870b42
--- /dev/null
+++ b/elisp/step4_if_fn_do.el
@@ -0,0 +1,144 @@
+;; -*- lexical-binding: t; -*-
+
+(defun load-relative (file)
+  (let* ((current-file (or load-file-name buffer-file-name))
+         (current-file-directory (file-name-directory current-file)))
+    (load (expand-file-name file current-file-directory) nil t)))
+
+(load-relative "types.el")
+(load-relative "env.el")
+(load-relative "reader.el")
+(load-relative "printer.el")
+(load-relative "core.el")
+
+(defvar repl-env (mal-env))
+
+(dolist (binding core-ns)
+  (let ((symbol (car binding))
+        (fn (cdr binding)))
+    (mal-env-set repl-env symbol fn)))
+
+(defun READ (input)
+  (read-str input))
+
+(defun EVAL (ast env)
+  (if (mal-list-p 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!)
+          (let ((identifier (mal-value a1))
+                (value (EVAL a2 env)))
+            (mal-env-set env identifier value)))
+         ((eq a0* 'let*)
+          (let* ((env* (mal-env env))
+                 (a1* (mal-value a1))
+                 (bindings (if (vectorp a1*) (append a1* nil) a1*))
+                 (form a2))
+            (while bindings
+              (let ((key (mal-value (pop bindings)))
+                    (value (EVAL (pop bindings) env*)))
+                (mal-env-set env* key value)))
+            (EVAL form env*)))
+         ((eq a0* 'do)
+          (car (last (mal-value (eval-ast (mal-list (cdr a)) env)))))
+         ((eq a0* 'if)
+          (let* ((condition (EVAL a1 env))
+                 (condition-type (mal-type condition))
+                 (then a2)
+                 (else a3))
+            (if (and (not (eq condition-type 'false))
+                     (not (eq condition-type 'nil)))
+                (EVAL then env)
+              (if else
+                  (EVAL else env)
+                (mal-nil)))))
+         ((eq a0* 'fn*)
+          (let ((binds (mapcar 'mal-value (mal-value a1)))
+                (body a2))
+            (mal-fn
+             (lambda (&rest args)
+               (let ((env* (mal-env env binds args)))
+                 (EVAL body env*))))))
+         (t
+          ;; not a special form
+          (let* ((ast* (mal-value (eval-ast ast env)))
+                 (fn (car ast*))
+                 (fn* (cond
+                       ((functionp fn)
+                        fn)
+                       ((mal-fn-p fn)
+                        (mal-value fn))))
+                 (args (cdr ast*)))
+            (apply fn* args)))))
+    (eval-ast ast env)))
+
+(defun eval-ast (ast env)
+  (let ((type (mal-type ast))
+        (value (mal-value ast)))
+    (cond
+     ((eq type 'symbol)
+      (let ((definition (mal-env-get env value)))
+        (or definition (error "Definition not found"))))
+     ((eq type 'list)
+      (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
+     ((eq type 'vector)
+      (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
+     ((eq type 'map)
+      (let ((map (copy-hash-table value)))
+        (maphash (lambda (key value)
+                   (puthash key (EVAL value env) map))
+                 map)
+        (mal-map map)))
+     (t
+      ;; return as is
+      ast))))
+
+(defun PRINT (input)
+  (pr-str input t))
+
+(defun rep (input)
+  (PRINT (EVAL (READ input) repl-env)))
+
+(rep "(def! not (fn* (a) (if a false true)))")
+
+(defun readln (prompt)
+  ;; C-d throws an error
+  (ignore-errors (read-from-minibuffer prompt)))
+
+(defun println (format-string &rest args)
+  (if (not args)
+      (princ format-string)
+    (princ (apply 'format format-string args)))
+  (terpri))
+
+(defun main ()
+  (let (eof)
+    (while (not eof)
+      (let ((input (readln "user> ")))
+        (if input
+            (condition-case err
+                (println (rep input))
+              (end-of-token-stream
+               ;; 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))))
+              (error ; catch-all
+               (println (error-message-string err))))
+          (setq eof t)
+          ;; print final newline
+          (terpri))))))
+
+(main)

diff --git a/elisp/types.el b/elisp/types.el
index a10e8e1..c150b4d 100644 (file)
--- a/elisp/types.el
+++ b/elisp/types.el
@@ -35,6 +35,8 @@
 
 (mal-object env)
 (mal-object atom)
+
+(mal-object fn)
 (mal-object func)
 
 ;;; regex