From 5b518ad7205b3432d95ff2b3757e49914233d913 Mon Sep 17 00:00:00 2001
From: Thomas Albers Raviola <thomas@thomaslabs.org>
Date: Sun, 5 Jan 2025 16:55:51 +0100
Subject: Clean up eval-tree

---
 src/core.lisp | 40 +++++++++++++++++++++-------------------
 1 file changed, 21 insertions(+), 19 deletions(-)

(limited to 'src/core.lisp')

diff --git a/src/core.lisp b/src/core.lisp
index 1a1a3b8..87d9755 100644
--- a/src/core.lisp
+++ b/src/core.lisp
@@ -70,10 +70,12 @@
   (setf arglist (mapcar #'object-value arglist))
   (let ((env environment))
     (make-closure  #'(lambda (environment siblings &rest args)
-                       (tree-eval (append (pairlis arglist args)
-                                          env
-                                          environment)
-                                  body))
+                       ;; Splice arguments into resulting link
+                       (flatten
+                        (eval-tree (append (pairlis arglist args)
+                                           env
+                                           environment)
+                                   body)))
                    arglist (complement #'identity) env :function)))
 
 (define-special lambda* (arglist group-predicate body)
@@ -83,7 +85,7 @@
 
   (cond ((and (listp group-predicate))
          ;; TODO: Check arglist of predicate
-         (setf group-predicate (first (tree-eval environment group-predicate)))
+         (setf group-predicate (first (eval-tree environment group-predicate)))
 
          (assert (closurep group-predicate))
          (let ((function (closure-function group-predicate)))
@@ -94,7 +96,7 @@
 
   (let ((env environment))
     (make-closure  #'(lambda (environment siblings &rest args)
-                       (tree-eval (append (pairlis arglist args)
+                       (eval-tree (append (pairlis arglist args)
                                           (list (cons (intern "SIBLINGS" *interpreter-package*)
                                                       siblings))
                                           env
@@ -121,24 +123,24 @@ respectives values"
          body)))
 
 ;; Is this basically quasiquote?
-(define-special syntax (arglist body)
-  (setf arglist (remove-if #'whitespace-text-p arglist))
-  (assert (every #'object-symbol-p arglist))
-  (setf arglist (mapcar #'object-value arglist))
-  (make-closure  #'(lambda (environment siblings &rest args)
-                     (declare (ignorable environment siblings))
-                     (syntax-expand (pairlis arglist args) body))
-                 arglist (complement #'identity) environment :syntax))
-
+;; (define-special syntax (arglist body)
+;;   (setf arglist (remove-if #'whitespace-text-p arglist))
+;;   (assert (every #'object-symbol-p arglist))
+;;   (setf arglist (mapcar #'object-value arglist))
+;;   (make-closure  #'(lambda (environment siblings &rest args)
+;;                      (declare (ignorable environment siblings))
+;;                      (syntax-expand (pairlis arglist args) body))
+;;                  arglist (complement #'identity) environment :syntax))
+
+;;; TODO: require single element list
 (define-special* define (name value) (siblings #'identity)
   (assert (object-symbol-p (first name)))
   (setf name (object-value (first name)))
-  (setf value (first (tree-eval environment value)))
-  (tree-eval (acons name value environment)
+  (setf value (first (eval-tree environment value)))
+  (eval-tree (acons name value environment)
              siblings))
 
-;; TODO: Restrict chain link's length to avoid so many asserts
-
+;;; TODO: Restrict chain link's length to avoid so many asserts
 (define-function gp (symbol)
   (assert (object-symbol-p (first symbol)) nil "a")
   (setf symbol (first symbol))
-- 
cgit v1.2.3