(in-package #:chains)

(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-function (name (&rest args) &body body)
  (let ((siblings (gensym)))
    `(make-closure #'(lambda (environment ,siblings ,@args)
                       (declare (ignore ,siblings))
                       ,@body)
                   ',args
                   nil
                   (complement #'identity)
                   nil
                   :function)))

(defmacro define-function* (name (&rest args) (siblings group-predicate)
                            &body body)
  `(make-closure #'(lambda (environment ,siblings ,@args)
                     ,@body)
                 ',args
                 nil
                 ,group-predicate
                 nil
                 :function))

(defmacro define-syntax (name (&rest args) &body body)
  `(make-closure #'(lambda (environment siblings ,@args)
                     ,@body)
                 ',args
                 t
                 (complement #'identity)
                 nil
                 :special))

(defmacro define-syntax* (name (&rest args) (siblings group-predicate)
                          &body body)
  `(make-closure #'(lambda (environment ,siblings ,@args)
                     ,@body)
                 ',args
                 t
                 ,group-predicate
                 nil
                 :special))

(defparameter *lambda*
  (define-syntax lambda (arglist body)
    (setf arglist (remove-if #'whitespace-text-p arglist))
    (assert (every #'object-symbolp arglist))
    (setf arglist (mapcar #'cdr arglist))
    (let ((env environment))
      (make-closure  #'(lambda (environment siblings &rest args)
                         (tree-eval (append (pairlis arglist args)
                                            env
                                            environment)
                                    body))
                     arglist nil (complement #'identity) env :function))))

;; Is this basically quasiquote?
(defparameter *syntax*
  (define-syntax syntax (arglist body)
    (setf arglist (remove-if #'whitespace-text-p arglist))
    (assert (every #'object-symbolp arglist))
    (setf arglist (mapcar #'cdr arglist))
    (let ((env environment))
      (make-closure  #'(lambda (environment siblings &rest args)
                         (mapc #'(lambda (pair)
                                   (setf body (nsubst (cdr pair)
                                                      `((symbol . ,(car pair)))
                                                      body
                                                      :test #'equal)))
                               (pairlis arglist args))
                         body)
                     arglist t (complement #'identity) env :syntax))))

(defparameter *define*
  (define-syntax* define (name value) (siblings #'identity)
    (assert (object-symbolp (first name)))
    (setf name (cdr (first name)))
    (setf value (first (tree-eval environment value)))
    (tree-eval (acons name value environment)
               siblings)))