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

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

;;;;;;
;;; Java to tree projection

(def class* projection/java-to-tree (projection)
  ())

;;;;;;
;;; Java to tree projection constructors

(def (function e) make-projection/java-to-tree ()
  (make-instance 'projection/java-to-tree))

;;;;;;
;;; Java to tree printer

(def method project-document (java-document (projection projection/java-to-tree))
  (bind ((mapping (make-mapping)))
    (labels ((recurse (input input-reference output-reference)
               (bind ((typed-input-reference `(the ,(form-type input) ,input-reference)))
                 (prog1-bind output
                     (etypecase input
                       (document
                        (if (eq input java-document)
                            (recurse (content-of input) `(content-of ,typed-input-reference) `(content-of (the document ,output-reference)))
                            input))
                       ;; statement
                       (java/statement/block
                        (make-tree/node (iter (for index :from 0)
                                              (for element :in-sequence (elements-of input))
                                              (collect (recurse element `(elt (elements-of ,typed-input-reference) ,index) `(elt (the list (children-of (the tree/node ,output-reference))) ,index))))))
                       (java/statement/if
                        (insert-string-mapping mapping `(form-name ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 0) 2)
                        (insert-string-mapping mapping `(form-name ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 3) 4)
                        (make-tree/node (list* "if"
                                               (recurse (condition-of input) `(condition-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 1))
                                               (recurse (then-of input) `(then-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 2))
                                               "else"
                                               (when (else-of input)
                                                 (list (recurse (else-of input) `(else-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 4)))))))
                       (java/statement/return
                        (insert-string-mapping mapping `(form-name ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 0) 6)
                        (make-tree/node (list "return" (recurse (value-of input) `(value-of  ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 1)))))
                       ;; expression
                       (java/expression/variable-reference
                        (insert-string-mapping mapping `(name-of ,typed-input-reference) output-reference (length (name-of input)))
                        (name-of input))
                       (java/expression/method-invocation
                        (make-tree/node (list (aprog1 (method-of input)
                                                (insert-string-mapping mapping `(method-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 0) (length (method-of input))))
                                              (aprog1 (make-tree/node (iter (for index :from 0)
                                                                            (for argument :in-sequence (arguments-of input))
                                                                            (collect (recurse argument
                                                                                              `(elt (the list (arguments-of ,typed-input-reference)) ,index)
                                                                                              `(elt (the list (children-of (the tree/node (elt (the list (children-of (the tree/node ,output-reference))) 1)))) ,index)))))
                                                (insert-mapping mapping `(the list (arguments-of ,typed-input-reference)) `(the tree/node (elt (the list (children-of (the tree/node ,output-reference))) 1)))))))
                       (java/expression/infix-operator
                        (make-tree/node (iter (for index :from 0)
                                              (for argument :in-sequence (arguments-of input))
                                              (unless (first-iteration-p)
                                                (collect (operator-of input)))
                                              (collect (recurse argument `(elt (the list (arguments-of ,typed-input-reference)) ,index) `(elt (the list (children-of (the tree/node ,output-reference))) (* 2 index)))))))
                       ;; literal
                       (java/literal/null
                        "null")
                       (java/literal/number
                        (bind ((value (write-to-string (value-of input))))
                          (insert-string-mapping mapping `(write-to-string (the number (value-of ,typed-input-reference))) output-reference (length value))
                          value))
                       (java/literal/character
                        (format nil "'~A'" (value-of input)))
                       (java/literal/string
                        (value-of input))
                       ;; declaration
                       (java/declaration/method
                        (make-tree/node (list (recurse (qualifier-of input) `(qualifier-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 0))
                                              (recurse (return-type-of input) `(return-type-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 1))
                                              (aprog1 (name-of input)
                                                (insert-string-mapping mapping `(name-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 2) (length (name-of input))))
                                              (aprog1 (make-tree/node (iter (for index :from 0)
                                                                            (for argument :in-sequence (arguments-of input))
                                                                            (collect (recurse argument
                                                                                              `(elt (arguments-of ,typed-input-reference) ,index)
                                                                                              `(elt (the list (children-of (the tree/node (elt (the list (children-of (the tree/node ,output-reference))) 3)))) ,index)))))
                                                (insert-mapping mapping `(the list (arguments-of ,typed-input-reference)) `(the tree/node (elt (the list (children-of (the tree/node ,output-reference))) 3))))
                                              (recurse (body-of input) `(body-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 4)))))
                       (java/declaration/argument
                        (make-tree/node (list (recurse (slot-value input 'type) `(slot-value ,typed-input-reference 'type) `(elt (the list (children-of (the tree/node ,output-reference))) 0))
                                              (aprog1 (name-of input)
                                                (insert-string-mapping mapping `(name-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 1) (length (name-of input)))))))
                       (java/declaration/qualifier
                        (insert-string-mapping mapping `(name-of ,typed-input-reference) output-reference (length (name-of input)))
                        (name-of input))
                       (java/declaration/type
                        (insert-string-mapping mapping `(name-of ,typed-input-reference) output-reference (length (name-of input)))
                        (name-of input)))
                   (bind ((typed-output-reference `(the ,(form-type output) ,output-reference)))
                     (insert-mapping mapping typed-input-reference typed-output-reference))))))
      (bind ((tree-document (recurse java-document 'document 'document)))
        (make-document tree-document
                       :selection (map-reference-forward mapping (selection-of java-document))
                       :source (make-source java-document projection mapping))))))

;;;;;;
;;; Java to tree form reader

(def method read-operation (java-document (projection projection/java-to-tree) xxx)
  (bind ((operation (operation-of xxx)))
    (cond ((typep operation 'operation/replace-selection)
           (make-operation/replace-selection (map-reference-backward (mapping-of (source-of (document-of xxx))) (selection-of operation))))
          ((typep operation 'operation/sequence/replace-element-range)
           (make-operation/sequence/replace-element-range (map-reference-backward (mapping-of (source-of (document-of xxx))) (target-of operation)) (replacement-of operation)))
          (t operation))))