(in-package :hu.dwim.excosy)

;; KLUDGE: add as extra argument
(def special-variable *environment* nil)

(def (function e) interpret (form &optional (continuation 'identity))
  (iter (for (values next-form next-continuation) = (%interpret form continuation))
        (while next-continuation)
        (setf form next-form)
        (setf continuation next-continuation)
        (finally (return form))))

(def function %interpret (form continuation)
  (cond ((integerp form)
         (interpret-integer form continuation))
        ((typep form 'boolean)
         (interpret-boolean form continuation))
        ((and (consp form)
              (eq (first form) 'if))
         (interpret-if form continuation))
        ((and (consp form)
              (eq (first form) 'progn))
         (interpret-progn form continuation))
        ((and (consp form)
              (eq (first form) 'tagbody))
         (interpret-tagbody form continuation))
        ((and (consp form)
              (eq (first form) 'go))
         (interpret-go form continuation))
        ((and (consp form)
              (eq (first form) 'block))
         (interpret-block form continuation))
        ((and (consp form)
              (eq (first form) 'return-from))
         (interpret-return-from form continuation))
        ((consp form)
         (interpret-function-call form continuation))))

(def function find-continuation (label)
  (getf *environment* label))

(def function (setf find-continuation) (continuation label)
  (push continuation *environment*)
  (push label *environment*))

(def function interpret-integer (form continuation)
  (funcall continuation form))

(def function interpret-boolean (form continuation)
  (funcall continuation form))

(def function interpret-if (form continuation)
  (values (second form)
          (lambda (value)
            (values (if value
                        (third form)
                        (fourth form))
                    continuation))))

(def function interpret-progn (form continuation)
  (if (length= 1 form)
      (values nil continuation)
      (values (second form)
              (if (length= 2 form)
                  continuation
                  (lambda (value)
                    (declare (ignore value))
                    (values `(progn ,@(cddr form)) continuation))))))

(def function interpret-tagbody (form continuation)
  (iter (for element-cell :on (cdr form))
        (for element = (car element-cell))
        (when (symbolp element)
          (bind ((form `(progn ,@(remove-if 'symbolp (cdr element-cell)) nil)))
            (setf (find-continuation element)
                  (lambda (value)
                    (declare (ignore value))
                    (values form  continuation))))))
  (values `(progn ,@(remove-if 'symbolp form) nil) continuation))

(def function interpret-go (form continuation)
  (declare (ignore continuation))
  (values nil (find-continuation (second form))))

(def function interpret-block (form continuation)
  (setf (find-continuation (second form)) continuation)
  (values `(progn ,@(cddr form)) continuation))

(def function interpret-return-from (form continuation)
  (declare (ignore continuation))
  (values (third form) (find-continuation (second form))))

(def function interpret-function-call (form continuation)
  (values (second form)
          (lambda (value)
            (funcall continuation (funcall (first form) value))))
  ;; TODO: multiple arguments
  #+nil
  (labels ((interpret-arguments (argument-forms evaluated-arguments)
             (values (first argument-forms)
                     (if (length= 1 argument-forms)
                         (lambda (value)
                           (values (apply (first form) (reverse (cons value evaluated-arguments))) continuation))
                         (lambda (value)
                           (interpret-arguments (cdr argument-forms) (cons value evaluated-arguments)))))))
    (interpret-arguments (cdr form) nil)))