;;; Setting up the reader macro.
(in-package "CL.EXT.DACF.UNIFICATION")
;;; 20080711 MA:
;;; Reverted to the old version with MAKE-LOAD-FORM added.  Template
;;; objects are created at read-time.
(defun |sharp-T-reader| (stream subchar arg)
  (declare (ignore subchar arg))
  (let ((spec (read stream t nil t)))
    (typecase spec
      (null (make-template nil spec))
      (cons (make-template (first spec) spec))
      (t    (make-template spec spec)))))
(defmethod make-load-form ((x template) &optional env)
  (make-load-form-saving-slots x :environment env))
#||
;;; Version with more 'macro-like' behavior. The previous version
;;; created an object at read-time, which may cause problems with
;;; MAKE-LOAD-FORMs, constant-ness etc etc.
;;;
;;; 20080713 MA
;;; Removed because it was not working well with nested templates.
;;; Reverted to the original one plus MAKE-LOAD-FORM.
(defun |sharp-T-reader| (stream subchar arg)
  (declare (ignore subchar arg))
  (let ((spec (read stream t nil t)))
    (typecase spec
      (null `(make-template nil ',spec))
      (cons `(make-template ',(first spec) ',spec))
      (t    `(make-template ',spec ',spec)))
    ))
||#
(eval-when (:load-toplevel :execute)
  (set-dispatch-macro-character #\# #\T '|sharp-T-reader|))
#|| Useless with the read time templates and MAKE-LOAD-FORM.
(defun rewrite-template-spec (spec)
  "Rewrites a template specification.
The rewriting simply makes sure that sub-templates are created as needed.
The result is either the SPEC itself or an appropriate call to LIST."
  (typecase spec
    (atom `',spec)
    (cons (destructuring-bind (head &rest tail)
              spec
            (case head
              (quote spec)
              (make-template `(make-template ,(first tail)
                                             ,(rewrite-template-spec (second (second tail)))))
              (t `(list ',head ,@(mapcar #'rewrite-template-spec tail)))
              )))
    (t `',spec)))
||#
(defmacro enable-template-reader ()
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf *readtable* (copy-readtable *readtable*))
     (set-dispatch-macro-character #\# #\T '|sharp-T-reader|)))