(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))))))