* Initial commit

1 files changed, 76 insertions, 0 deletions

diff --git a/src/core.lisp b/src/core.lisp
new file mode 100644
index 0000000..6c151ce
--- /dev/null
+++ b/src/core.lisp
@@ -0,0 +1,76 @@
+(in-package #:chains)
+
+(defun get-var (env key)
+  (if-let ((slot (assoc key env)))
+    (cdr slot)
+    (error "var ~A not found~% ~A~%" key env)))
+
+;; Built-in functions and variables used inside the interpreter use their own
+;; package. This allows the language to have keywords like lambda which
+;; otherwise would be reserved words from the cl package
+
+(defmacro define-function (name (&rest args) &body body)
+  (let ((siblings (gensym)))
+    `(make-closure #'(lambda (environment ,siblings ,@args)
+                       (declare (ignore ,siblings))
+                       ,@body)
+                   ',args
+                   nil
+                   (complement #'identity))))
+
+(defmacro define-function* (name (&rest args) (siblings group-predicate)
+                            &body body)
+  `(make-closure #'(lambda (environment ,siblings ,@args)
+                     ,@body)
+                 ',args
+                 nil
+                 ,group-predicate))
+
+(defmacro define-syntax (name (&rest args) &body body)
+  `(make-closure #'(lambda (environment siblings ,@args)
+                     ,@body)
+                 ',args
+                 t
+                 (complement #'identity)))
+
+(defmacro define-syntax* (name (&rest args) (siblings group-predicate)
+                          &body body)
+  `(make-closure #'(lambda (environment ,siblings ,@args)
+                     ,@body)
+                 ',args
+                 t
+                 ,group-predicate))
+
+(defparameter *lambda*
+  (define-syntax lambda (arglist body)
+    (setf arglist (remove-if #'whitespace-text-p arglist))
+    (assert (every #'object-symbolp arglist))
+    (setf arglist (mapcar #'cdr arglist))
+    (let ((env environment))
+      (make-closure  #'(lambda (environment siblings &rest args)
+                         (tree-eval (append (pairlis arglist args)
+                                            env
+                                            environment)
+                                    body))
+                     arglist nil (complement #'identity) env))))
+
+(defparameter *syntax*
+  (define-syntax syntax (arglist body)
+    (setf arglist (remove-if #'whitespace-text-p arglist))
+    (assert (every #'object-symbolp arglist))
+    (setf arglist (mapcar #'cdr arglist))
+    (let ((env environment))
+      (make-closure  #'(lambda (environment siblings &rest args)
+                         (tree-eval (append (pairlis arglist args)
+                                            env
+                                            environment)
+                                    body))
+                     arglist t (complement #'identity) env))))
+
+(defparameter *define*
+  (define-syntax* define (name value) (siblings #'identity)
+    (assert (object-symbolp (first name)))
+    (setf name (cdr (first name)))
+    (setf value (first (tree-eval environment value)))
+    (tree-eval (acons name value environment)
+               siblings)))