* Initial commit

1 files changed, 44 insertions, 0 deletions

diff --git a/src/eval.lisp b/src/eval.lisp
new file mode 100644
index 0000000..4962ade
--- /dev/null
+++ b/src/eval.lisp
@@ -0,0 +1,44 @@
+(in-package #:chains)
+
+(defun chainp (object)
+  (and (consp object) (eq (first object) 'chain)))
+
+(defun chain-links (chain)
+  (rest chain))
+
+(defun object-symbolp (object)
+  (and (consp object) (eq (first object) 'symbol)))
+
+(defun tree-eval (environment node)
+  (cond ((null node)
+         nil)
+        ((object-symbolp node)
+         (get-var environment (cdr node)))
+        ((not (consp node))
+         node)
+        ((chainp (first node))
+         (destructuring-bind (flink &rest rlinks) (chain-links (first node))
+           (setf flink (tree-eval environment flink))
+           (assert (and (consp flink)
+                        (closurep (first flink))
+                        (null (rest flink)))
+                   (flink)
+                   "~A ~A" flink (content (second flink)))
+           (let* ((closure (first flink))
+                  (function (closure-function closure))
+                  (group-predicate (closure-group-p closure)))
+             (multiple-value-bind (siblings rest)
+                 (group-if group-predicate (rest node))
+               (append
+                ;; 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))))))
+                (tree-eval environment rest))))))
+        (t
+         (cons (tree-eval environment (first node))
+               (tree-eval environment (rest node))))))