;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.projectional-editor)

;;;;;;
;;; Projection

(def (projection e) walked-lisp-form/constant-form->lisp-form/string ()
  ())

(def (projection e) walked-lisp-form/variable-reference-form->lisp-form/string ()
  ())

(def (projection e) walked-lisp-form/if-form->lisp-form/list ()
  ())

(def (projection e) walked-lisp-form/the-form->lisp-form/list ()
  ())

(def (projection e) walked-lisp-form/application-form->lisp-form/list ()
  ())

(def (projection e) walked-lisp-form/function-definition-form->lisp-form/list ()
  ())

(def (projection e) walked-lisp-form/lambda-function-form->lisp-form/list ()
  ())

(def (projection e) walked-lisp-form/function-argument-form->lisp-form/string ()
  ())

;;;;;;
;;; Construction

(def (function e) make-projection/walked-lisp-form/constant-form->lisp-form/string ()
  (make-projection 'walked-lisp-form/constant-form->lisp-form/string))

(def (function e) make-projection/walked-lisp-form/variable-reference-form->lisp-form/string ()
  (make-projection 'walked-lisp-form/variable-reference-form->lisp-form/string))

(def (function e) make-projection/walked-lisp-form/if-form->lisp-form/list ()
  (make-projection 'walked-lisp-form/if-form->lisp-form/list))

(def (function e) make-projection/walked-lisp-form/the-form->lisp-form/list ()
  (make-projection 'walked-lisp-form/the-form->lisp-form/list))

(def (function e) make-projection/walked-lisp-form/application-form->lisp-form/list ()
  (make-projection 'walked-lisp-form/application-form->lisp-form/list))

(def (function e) make-projection/walked-lisp-form/function-definition-form->lisp-form/list ()
  (make-projection 'walked-lisp-form/function-definition-form->lisp-form/list))

(def (function e) make-projection/walked-lisp-form/lambda-function-form->lisp-form/list ()
  (make-projection 'walked-lisp-form/lambda-function-form->lisp-form/list))

(def (function e) make-projection/walked-lisp-form/function-argument-form->lisp-form/string ()
  (make-projection 'walked-lisp-form/function-argument-form->lisp-form/string))

(def (function e) make-projection/walked-lisp-form->lisp-form ()
  (type-dispatching
    (hu.dwim.walker:constant-form (make-projection/walked-lisp-form/constant-form->lisp-form/string))
    (hu.dwim.walker:variable-reference-form (make-projection/walked-lisp-form/variable-reference-form->lisp-form/string))
    (hu.dwim.walker:if-form (make-projection/walked-lisp-form/if-form->lisp-form/list))
    (hu.dwim.walker:the-form (make-projection/walked-lisp-form/the-form->lisp-form/list))
    (hu.dwim.walker:application-form (make-projection/walked-lisp-form/application-form->lisp-form/list))
    (hu.dwim.walker:function-definition-form (make-projection/walked-lisp-form/function-definition-form->lisp-form/list))
    (hu.dwim.walker:lambda-function-form (make-projection/walked-lisp-form/lambda-function-form->lisp-form/list))
    (hu.dwim.walker:function-argument-form (make-projection/walked-lisp-form/function-argument-form->lisp-form/string))))

;;;;;;
;;; Construction

(def (macro e) walked-lisp-form/constant-form->lisp-form/string ()
  '(make-projection/walked-lisp-form/constant-form->lisp-form/string))

(def (macro e) walked-lisp-form/variable-reference-form->lisp-form/string ()
  '(make-projection/walked-lisp-form/variable-reference-form->lisp-form/string))

(def (macro e) walked-lisp-form/if-form->lisp-form/list ()
  '(make-projection/walked-lisp-form/if-form->lisp-form/list))

(def (macro e) walked-lisp-form/the-form->lisp-form/list ()
  '(make-projection/walked-lisp-form/the-form->lisp-form/list))

(def (macro e) walked-lisp-form/application-form->lisp-form/list ()
  '(make-projection/walked-lisp-form/application-form->lisp-form/list))

(def (macro e) walked-lisp-form/function-definition-form->lisp-form/list ()
  '(make-projection/walked-lisp-form/function-definition-form->lisp-form/list))

(def (macro e) walked-lisp-form/lambda-function-form->lisp-form/list ()
  '(make-projection/walked-lisp-form/lambda-function-form->lisp-form/list))

(def (macro e) walked-lisp-form/function-argument-form->lisp-form/string ()
  '(make-projection/walked-lisp-form/function-argument-form->lisp-form/string))

(def (macro e) walked-lisp-form->lisp-form ()
  '(make-projection/walked-lisp-form->lisp-form))

;;;;;;
;;; Printer

(def function recurse/slot (recursion input slot input-reference output-reference &optional base-index)
  (bind ((typed-input-reference `(the ,(form-type input) ,input-reference))
         (value (slot-value input slot))
         (slot-path `(slot-value ,typed-input-reference ',slot)))
    (if (consp value)
        (loop for element :in (slot-value input slot)
              for index :from 0
              collect (recurse-printer recursion element
                                       `(elt (the ,(form-type value) ,slot-path) ,index)
                                       (if base-index
                                           `(elt (the list ,output-reference) ,(+ base-index index))
                                           output-reference)))
        (recurse-printer recursion value slot-path output-reference))))

(def function recurse/ordinary-lambda-list (recursion input input-reference output-reference)
  (bind ((typed-input-reference `(the ,(form-type input) ,input-reference))
         (arguments (hu.dwim.walker:bindings-of input))
         (optional-seen? nil)
         (rest-seen? nil)
         (keyword-seen? nil)
         (allow-other-keys-seen? nil)
         (auxiliary-seen? nil))
    (labels ((ensure-&key ()
               (unless keyword-seen?
                 (assert (not auxiliary-seen?))
                 (setq keyword-seen? t)
                 (list '&key)))
             (ensure-&allow-other-keys ()
               (when (and (not allow-other-keys-seen?)
                          (hu.dwim.walker:allow-other-keys? input))
                 (setf allow-other-keys-seen? t)
                 (nconc (ensure-&key)
                        (list '&allow-other-keys)))))
      (loop
        :for index :from 0
        :for argument :in arguments
        :appending (etypecase argument
                     (hu.dwim.walker:required-function-argument-form
                      (assert (not (or optional-seen? rest-seen? keyword-seen? auxiliary-seen?))))
                     (hu.dwim.walker:optional-function-argument-form
                      (unless optional-seen?
                        (assert (not (or rest-seen? keyword-seen? auxiliary-seen?)))
                        (setq optional-seen? t)
                        (list '&optional)))
                     (hu.dwim.walker:rest-function-argument-form
                      (unless rest-seen?
                        (assert (not (or keyword-seen? auxiliary-seen?)))
                        (setq rest-seen? t)
                        (list '&rest)))
                     (hu.dwim.walker:keyword-function-argument-form
                      (ensure-&key))
                     (hu.dwim.walker:auxiliary-function-argument-form
                      (unless auxiliary-seen?
                        (setq auxiliary-seen? t)
                        (nconc (ensure-&allow-other-keys)
                               (list '&aux))))) :into result
        :collect (recurse-printer recursion argument `(elt ,typed-input-reference ,index) `(elt (the list ,output-reference) ,index)) :into result
        :finally (return (nconc result
                                (ensure-&allow-other-keys)))))))

(def printer walked-lisp-form/constant-form->lisp-form/string (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion))
  (bind ((value (hu.dwim.walker:value-of input))
         (output (if (or (eq value t)
                         (eq value nil)
                         (keywordp value))
                     value
                     (etypecase value
                       (number
                        value)
                       (string
                        value)
                       (symbol
                        `(quote ,value))
                       (cons
                        `(quote ,value))))))
    (make-iomap/object input input-reference output output-reference)))

(def printer walked-lisp-form/variable-reference-form->lisp-form/string (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion))
  (bind ((output (hu.dwim.walker:name-of input)))
    (make-iomap/object input input-reference output output-reference)))

(def printer walked-lisp-form/if-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection))
  (bind ((output `(if ,(output-of (recurse/slot recursion input 'hu.dwim.walker::condition input-reference `(elt (the list ,output-reference) 1)))
                      ,(output-of (recurse/slot recursion input 'hu.dwim.walker::then input-reference `(elt (the list ,output-reference) 2)))
                      ,@(awhen (output-of (recurse/slot recursion input 'hu.dwim.walker::else input-reference `(elt (the list ,output-reference) 3)))
                               (list it)))))
    (make-iomap/object input input-reference output output-reference)))

(def printer walked-lisp-form/the-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection))
  (bind ((output `(the ,(hu.dwim.walker::declared-type-of input)
                    ,(output-of (recurse/slot recursion input 'hu.dwim.walker::value input-reference `(elt (the list ,output-reference) 2))))))
    (make-iomap/object input input-reference output output-reference)))

(def printer walked-lisp-form/application-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection))
  (bind ((output (cons (hu.dwim.walker:operator-of input)
                       (mapcar 'output-of (recurse/slot recursion input 'hu.dwim.walker::arguments input-reference output-reference 1)))))
    (make-iomap/object input input-reference output output-reference)))

(def printer walked-lisp-form/function-definition-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection))
  (bind ((docstring (hu.dwim.walker:docstring-of input))
         (output `(defun ,(hu.dwim.walker:name-of input) ,(mapcar 'output-of (recurse/ordinary-lambda-list recursion input input-reference `(elt (the list ,output-reference) 2)))
                    ,@(when docstring (list docstring))
                    ,@(mapcar 'output-of (recurse/slot recursion input 'hu.dwim.walker::body input-reference `(elt (the list ,output-reference) ,(if docstring 4 3)))))))
    (make-iomap/object input input-reference output output-reference)))

(def printer walked-lisp-form/lambda-function-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection))
  (bind ((output `(lambda ,(mapcar 'output-of (recurse/ordinary-lambda-list recursion input input-reference `(elt (the list ,output-reference) 1)))
                    ,@(mapcar 'output-of (recurse/slot recursion input 'hu.dwim.walker::body input-reference output-reference 2)))))
    (make-iomap/object input input-reference output output-reference)))

(def printer walked-lisp-form/function-argument-form->lisp-form/string (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion))
  (bind ((output (hu.dwim.walker:name-of input)))
    (make-iomap/object input input-reference output output-reference)))

;;;;;;
;;; Reader

(def reader walked-lisp-form/constant-form->lisp-form/string (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader walked-lisp-form/variable-reference-form->lisp-form/string (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader walked-lisp-form/if-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader walked-lisp-form/the-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader walked-lisp-form/application-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader walked-lisp-form/function-definition-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader walked-lisp-form/lambda-function-form->lisp-form/list (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader walked-lisp-form/function-argument-form->lisp-form/string (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)