(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)
                   "1~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)))
                   (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))
               (tree-eval environment (rest node))))))