diff options
author | Thomas Albers Raviola <thomas@thomaslabs.org> | 2025-01-05 16:55:51 +0100 |
---|---|---|
committer | Thomas Albers Raviola <thomas@thomaslabs.org> | 2025-01-05 17:11:20 +0100 |
commit | 5b518ad7205b3432d95ff2b3757e49914233d913 (patch) | |
tree | c4abb63c32cc1821a1f072a9e6487d067a873bc3 /src/core.lisp | |
parent | bc69faaa5bbd8a2d8afb9ab81882b1ba21c4bb8e (diff) |
Clean up eval-tree
Diffstat (limited to 'src/core.lisp')
-rw-r--r-- | src/core.lisp | 40 |
1 files changed, 21 insertions, 19 deletions
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)) |