(in-package #:chains)

(defparameter *default-environment* '()
  "")

(let ((true (make-object :symbol (intern "TRUE" *interpreter-package*)))
      (false (make-object :symbol (intern "FALSE" *interpreter-package*))))
  (push (cons (intern "TRUE" *interpreter-package*) true) *default-environment*)
  (push (cons (intern "FALSE" *interpreter-package*) false) *default-environment*))

(defun get-var (env key)
  (if-let ((slot (assoc key env)))
    (cdr slot)
    (error "var ~A not found~% ~A~%" key env)))

;; Built-in functions and variables used inside the interpreter use their own
;; package. This allows the language to have keywords like lambda which
;; otherwise would be reserved words from the cl package

(defmacro define (name arguments
                  (environment &key specialp siblings group-predicate)
                  &body body)
  (setf name (intern (symbol-name name) *interpreter-package*))
  `(push (cons ',name
               (make-closure #'(lambda (,environment ,siblings)
                                 (declare (ignorable ,siblings))
                                 (let ,(mapcar #'(lambda (x)
                                                   `(,x (get-var ,environment (find-symbol (symbol-name ',x) *interpreter-package*))))
                                        arguments)
                                   ,@body))
                             ',(mapcar #'(lambda (x) (intern (symbol-name x) *interpreter-package*))
                                       arguments)
                             ,(if group-predicate
                                  group-predicate
                                  '(complement #'identity))
                             nil
                             ,specialp))
         *default-environment*))

(defmacro define-function (name arguments &body body)
  (let ((environment (gensym)))
    `(define ,name ,arguments (,environment) ,@body)))

(defmacro define-special (name arguments &body body)
  (let ((environment (gensym)))
    `(define ,name ,arguments (,environment :specialp t) ,@body)))

(defmacro clambda ((environment lambda-list) &body body)
  (let ((siblings (gensym)))
    `(make-instance 'closure :function #'(lambda (,environment ,siblings)
                                           (declare (ignorable ,siblings))
                                           ,@body)
                             :lambda-list ,lambda-list
                             :groupp (complement #'identity)
                             :environment nil
                             :specialp nil)))

(define lambda (lambda-list body)
    (captured-environment :siblings siblings :specialp t)
  (setf lambda-list (remove-if #'whitespace-text-p lambda-list))
  (assert (every #'object-symbol-p lambda-list))
  (setf lambda-list (mapcar #'object-value lambda-list))
  (clambda (environment lambda-list)
    ;; Splice arguments into resulting link
    (flatten (eval-tree (append environment captured-environment) body))))

;; (define-special lambda* (arglist group-predicate body)
;;   (setf arglist (remove-if #'whitespace-text-p arglist))
;;   (assert (every #'object-symbol-p arglist))
;;   (setf arglist (mapcar #'object-value arglist))

;;   (cond ((and (listp group-predicate))
;;          ;; TODO: Check arglist of predicate
;;          (setf group-predicate (first (eval-tree environment group-predicate)))

;;          (assert (closurep group-predicate))
;;          (let ((function (closure-function group-predicate)))
;;            (setf group-predicate #'(lambda (object)
;;                                      (funcall function nil nil (list object))))))
;;         ((not (functionp group-predicate))
;;          (error "~A" group-predicate)))

;;   (let ((env environment))
;;     (make-closure  #'(lambda (environment siblings &rest args)
;;                        (eval-tree (append (pairlis arglist args)
;;                                           (list (cons (intern "SIBLINGS" *interpreter-package*)
;;                                                       siblings))
;;                                           env
;;                                           environment)
;;                                   body))
;;                    arglist group-predicate
;;                    env nil)))

(define define (name value)
    (environment :siblings siblings :group-predicate #'identity :specialp t)
  (assert (object-symbol-p (first name)))
  (setf name (object-value (first name)))
  (setf value (first (eval-tree environment value)))
  (eval-tree (acons name value environment)
             siblings))

;;; TODO: Macro for checking arguments types, eliminate whitespace and so on
;;; TODO: Docstrings for functions
;;; TODO: More advance lambda-lists (optional values, etc)