(in-package #:chains)

(defun group-if (predicate sequence)
  (loop :for (head . tail) :on sequence
        :while (funcall predicate head)
        :collect head :into group
        :finally
           (return (values group (if (not (funcall predicate head))
                                     (cons head tail)
                                     tail)))))

(defun group (item sequence &key (test #'eql))
  (group-if #'(lambda (x) (funcall test item x)) sequence))

(defun group-if-not (predicate sequence)
  (group-if (complement predicate) sequence))

(defun link-closure (link)
  "Returns the function object inside the first link of a chain"
  (setf link (remove-if #'whitespace-text-p link))
  (assert (and (not (null link))
               (closurep (first link))
               (null (rest link)))
          (link)
          "Link is not callable: ~A" link)
  (first link))

(defun bind-arguments (environment lambda-list arguments specialp)
  (unless specialp
    (map-into arguments (curry #'eval-tree environment) arguments))
  (append (mapcar #'cons lambda-list arguments)
          environment))

(defun eval-chain (environment chain siblings)
  "Evaluate CHAIN inside ENVIRONMENT and possibly consume SIBLINGS. Returns a
link with the evaluated body of the function under the ENVIRONMENT"
  (destructuring-bind (head &rest arguments)
      (chain-links chain)
    (with-accessors ((function closure-function)
                     (special closure-special-p)
                     (lambda-list closure-lambda-list)
                     (group-predicate closure-group-p))
        ;; Evaluate all elements of first link and get closure object
        (link-closure (eval-tree environment head))
      (multiple-value-bind (consumed-siblings rest)
          (group-if group-predicate siblings)
        (values
         (funcall function
                  (bind-arguments environment lambda-list arguments special)
                  consumed-siblings)
         rest)))))

(defun eval-tree (environment node)
  (typecase node
    (object-symbol
     (get-var environment (object-value node)))
    (cons
     (destructuring-bind (head &rest tail)
         node
       (if (chainp head)
           (multiple-value-bind (result rest)
               (eval-chain environment head tail)
             (append (ensure-list result) (eval-tree environment rest)))
           (cons (eval-tree environment head) (eval-tree environment tail)))))
    (t
     node)))