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

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

;;;;;;
;;; iomap

(def (namespace e) forward-mapper)

(def (definer e) forward-mapper (name arguments &body forms)
  `(setf (find-forward-mapper ',name) (lambda ,arguments ,@forms)))

(def (namespace e) backward-mapper)

(def (definer e) backward-mapper (name arguments &body forms)
  `(setf (find-backward-mapper ',name) (lambda ,arguments ,@forms)))

(def (class* ea) iomap ()
  ((input :type t)
   (output :type t)
   (forward-mapper :type function)
   (backward-mapper :type function))
  (:documentation "An IOMAP provides a bidirectional mapping between INPUT and OUTPUT."))

(def (function e) make-iomap (type &rest args)
  (apply #'make-instance type
         :forward-mapper (find-forward-mapper type)
         :backward-mapper (find-backward-mapper type)
         args))

;; TODO: move?

(def (class* ea) iomap/object (iomap)
  ((input-reference :type reference)
   (output-reference :type reference)))

(def (function e) make-iomap/object (input input-reference output output-reference)
  (make-iomap 'iomap/object
              :input input :input-reference (when input-reference `(the ,(form-type input) ,input-reference))
              :output output :output-reference (when output-reference `(the ,(form-type output) ,output-reference))))

(def (function e) make-iomap/object* (input input-reference output output-reference)
  (make-iomap 'iomap/object
              :input input :input-reference input-reference
              :output output :output-reference output-reference))

;; TODO: move?

(def (class* ea) iomap/string (iomap)
  ((input-reference :type reference)
   (output-reference :type reference)
   (input-offset :type integer)
   (output-offset :type integer)
   (length :type integer)))

(def (function e) make-iomap/string (input input-reference input-offset output output-reference output-offset length)
  (make-iomap 'iomap/string
              :input input :input-reference (when input-reference `(the ,(form-type input) ,input-reference)) :input-offset input-offset
              :output output :output-reference (when output-reference `(the ,(form-type output) ,output-reference)) :output-offset output-offset
              :length length))

(def (function e) make-iomap/string* (input input-reference input-offset output output-reference output-offset length)
  (make-iomap 'iomap/string
              :input input :input-reference input-reference :input-offset input-offset
              :output output :output-reference output-reference :output-offset output-offset
              :length length))

;; TODO: move?

(def (class* ea) iomap/sequential (iomap)
  ((element-iomaps :type list)))

(def (function e) make-iomap/sequential (input output element-iomaps)
  (make-iomap 'iomap/sequential :input input :output output :element-iomaps element-iomaps))

;; TODO: move?

(def (class* ea) iomap/recursive (iomap)
  ((child-iomaps :type list)))

(def (function e) make-iomap/recursive (input output child-iomaps)
  (make-iomap 'iomap/recursive :input input :output output :child-iomaps child-iomaps))

;;;;;;
;;; Mapping API

(def (function e) map-input-references (iomap function)
  (etypecase iomap
    (iomap/object
     (when-bind input-reference (input-reference-of iomap)
       (funcall function iomap input-reference)))
    (iomap/string
     (bind ((length (length-of iomap)))
       (iter (for index :from 0 :below length)
             (funcall function iomap `(the character (elt ,(input-reference-of iomap) ,(+ index (input-offset-of iomap))))))
       (iter (for index :from 0 :to length)
             (funcall function iomap `(the sequence-position (pos ,(input-reference-of iomap) ,(+ index (input-offset-of iomap))))))))
    (iomap/sequential
     (map-input-references (first (element-iomaps-of iomap)) function))
    (iomap/recursive
     (iter (for child-iomap :in (child-iomaps-of iomap))
           (map-input-references child-iomap function)))))

(def (function e) map-output-references (iomap function)
  (etypecase iomap
    (iomap/object
     (when-bind output-reference (output-reference-of iomap)
       (funcall function iomap output-reference)))
    (iomap/string
     (bind ((length (length-of iomap)))
       (iter (for index :from 0 :below length)
             (funcall function iomap `(the character (elt ,(output-reference-of iomap) ,(+ index (output-offset-of iomap))))))
       (iter (for index :from 0 :to length)
             (funcall function iomap `(the sequence-position (pos ,(output-reference-of iomap) ,(+ index (output-offset-of iomap))))))))
    (iomap/sequential
     (map-output-references (last-elt (element-iomaps-of iomap)) function))
    (iomap/recursive
     (iter (for child-iomap :in (child-iomaps-of iomap))
           (map-output-references child-iomap function)))))

(def (function e) map-forward (iomap input-reference function)
  (funcall (forward-mapper-of iomap) iomap input-reference function))

(def (function e) map-backward (iomap output-reference function)
  (funcall (backward-mapper-of iomap) iomap output-reference function))







;; TODO: move

(def forward-mapper iomap/object (iomap input-reference function)
  (when (equal input-reference (input-reference-of iomap))
    (funcall function iomap (output-reference-of iomap))))

(def forward-mapper iomap/string (iomap input-reference function)
  (pattern-case input-reference
    ((the character (elt (the string ?a) ?b))
     (when (and (equal `(the string ,?a) (input-reference-of iomap))
                (<= (input-offset-of iomap) ?b (+ -1 (input-offset-of iomap) (length-of iomap))))
       (funcall function iomap `(the character (elt ,(output-reference-of iomap) ,(+ (- ?b (input-offset-of iomap)) (output-offset-of iomap)))))))
    ((the sequence-position (pos (the string ?a) ?b))
     (when (and (equal `(the string ,?a) (input-reference-of iomap))
                (<= (input-offset-of iomap) ?b (+ (input-offset-of iomap) (length-of iomap))))
       (funcall function iomap `(the sequence-position (pos ,(output-reference-of iomap) ,(+ (- ?b (input-offset-of iomap)) (output-offset-of iomap)))))))))

(def forward-mapper iomap/sequential (iomap input-reference function)
  (labels ((recurse (reference remaining-iomaps)
             (when remaining-iomaps
               (map-forward (car remaining-iomaps) reference
                            (lambda (iomap output-reference)
                              (funcall function iomap output-reference)
                              (recurse output-reference (cdr remaining-iomaps)))))))
    (recurse input-reference (element-iomaps-of iomap))))

(def forward-mapper iomap/recursive (iomap input-reference function)
  (iter (for child-iomap :in (child-iomaps-of iomap))
        (map-forward child-iomap input-reference function)))






;; TODO: move

(def backward-mapper iomap/object (iomap output-reference function)
  (when (equal output-reference (output-reference-of iomap))
    (funcall function iomap (input-reference-of iomap))))

(def backward-mapper iomap/string (iomap output-reference function)
  (pattern-case output-reference
    ((the character (elt (the string ?a) ?b))
     (when (and (equal `(the string ,?a) (output-reference-of iomap))
                (<= (output-offset-of iomap) ?b (+ -1 (output-offset-of iomap) (length-of iomap))))
       (funcall function iomap `(the character (elt ,(input-reference-of iomap) ,(+ (- ?b (output-offset-of iomap)) (input-offset-of iomap)))))))
    ((the sequence-position (pos (the string ?a) ?b))
     (when (and (equal `(the string ,?a) (output-reference-of iomap))
                (<= (output-offset-of iomap) ?b (+ (output-offset-of iomap) (length-of iomap))))
       (funcall function iomap `(the sequence-position (pos ,(input-reference-of iomap) ,(+ (- ?b (output-offset-of iomap)) (input-offset-of iomap)))))))))

(def backward-mapper iomap/sequential (iomap output-reference function)
  (labels ((recurse (reference remaining-iomaps)
             (when remaining-iomaps
               (map-backward (car remaining-iomaps) reference
                             (lambda (iomap input-reference)
                               (funcall function iomap input-reference)
                               (recurse input-reference (cdr remaining-iomaps)))))))
    (recurse output-reference (reverse (element-iomaps-of iomap)))))

(def backward-mapper iomap/recursive (iomap output-reference function)
  (iter (for child-iomap :in (child-iomaps-of iomap))
        (map-backward child-iomap output-reference function)))