diff options
author | Thomas Albers Raviola <thomas@thomaslabs.org> | 2024-05-15 16:21:29 +0200 |
---|---|---|
committer | Thomas Albers Raviola <thomas@thomaslabs.org> | 2024-05-15 16:21:29 +0200 |
commit | d917f41beca176b8f2b682ac3a2c25b148752b71 (patch) | |
tree | 7dca0da8e57841f2f8efa31783196888511002cd /src/eval.lisp | |
parent | f5cb35b87255ebbe2d322bcedde6bc7d5f6aebae (diff) |
Add syntax form for writing macros
* src/core.lisp (syntax): Change evaluation rules to replace arguments inside
macro expansion.
* src/eval.lisp (tree-eval): Add Evaluation route for chains with a syntax
closure.
* t/test4.chn: New file.
Diffstat (limited to 'src/eval.lisp')
-rw-r--r-- | src/eval.lisp | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/src/eval.lisp b/src/eval.lisp index 4962ade..eede4ad 100644 --- a/src/eval.lisp +++ b/src/eval.lisp @@ -23,7 +23,7 @@ (closurep (first flink)) (null (rest flink))) (flink) - "~A ~A" flink (content (second flink))) + "1~A ~A" flink (content (second flink))) (let* ((closure (first flink)) (function (closure-function closure)) (group-predicate (closure-group-p closure))) @@ -33,11 +33,20 @@ ;; Evaluating a function returns a sublink, flatten all sublink (flatten (let ((eval-with-environment (curry #'tree-eval environment))) - (if (closure-special-p closure) - (ensure-list (apply function environment siblings rlinks)) - (let ((args (mapcar eval-with-environment rlinks)) - (siblings (funcall eval-with-environment siblings))) - (ensure-list (apply function environment siblings args)))))) + (case (closure-type closure) + (:syntax + (let ((body (ensure-list (apply function environment siblings rlinks))) + (ret nil)) + ;; (format t "~&Body: ~A~%" body) + (setf ret (tree-eval environment (append body (rest node)))) + (setf rest nil) + ret)) + (:special + (ensure-list (apply function environment siblings rlinks))) + (:function + (let ((args (mapcar eval-with-environment rlinks)) + (siblings (funcall eval-with-environment siblings))) + (ensure-list (apply function environment siblings args))))))) (tree-eval environment rest)))))) (t (cons (tree-eval environment (first node)) |