1 ;;; Setting up the reader macro.
 2 (in-package "CL.EXT.DACF.UNIFICATION")
 3 
 4 ;;; 20080711 MA:
 5 ;;; Reverted to the old version with MAKE-LOAD-FORM added.  Template
 6 ;;; objects are created at read-time.
 7 
 8 (defun |sharp-T-reader| (stream subchar arg)
 9   (declare (ignore subchar arg))
10   (let ((spec (read stream t nil t)))
11     (typecase spec
12       (null (make-template nil spec))
13       (cons (make-template (first spec) spec))
14       (t    (make-template spec spec)))))
15 
16 (defmethod make-load-form ((x template) &optional env)
17   (make-load-form-saving-slots x :environment env))
18 
19 
20 #||
21 ;;; Version with more 'macro-like' behavior. The previous version
22 ;;; created an object at read-time, which may cause problems with
23 ;;; MAKE-LOAD-FORMs, constant-ness etc etc.
24 ;;;
25 ;;; 20080713 MA
26 ;;; Removed because it was not working well with nested templates.
27 ;;; Reverted to the original one plus MAKE-LOAD-FORM.
28 
29 (defun |sharp-T-reader| (stream subchar arg)
30   (declare (ignore subchar arg))
31   (let ((spec (read stream t nil t)))
32     (typecase spec
33       (null `(make-template nil ',spec))
34       (cons `(make-template ',(first spec) ',spec))
35       (t    `(make-template ',spec ',spec)))
36     ))
37 ||#
38 
39 (eval-when (:load-toplevel :execute)
40   (set-dispatch-macro-character #\# #\T '|sharp-T-reader|))
41 
42 
43 #|| Useless with the read time templates and MAKE-LOAD-FORM.
44 
45 (defun rewrite-template-spec (spec)
46   "Rewrites a template specification.
47 The rewriting simply makes sure that sub-templates are created as needed.
48 The result is either the SPEC itself or an appropriate call to LIST."
49 
50   (typecase spec
51     (atom `',spec)
52     (cons (destructuring-bind (head &rest tail)
53               spec
54             (case head
55               (quote spec)
56               (make-template `(make-template ,(first tail)
57                                              ,(rewrite-template-spec (second (second tail)))))
58               (t `(list ',head ,@(mapcar #'rewrite-template-spec tail)))
59               )))
60     (t `',spec)))
61 
62 ||#
63 
64 (defmacro enable-template-reader ()
65   `(eval-when (:compile-toplevel :load-toplevel :execute)
66      (setf *readtable* (copy-readtable *readtable*))
67      (set-dispatch-macro-character #\# #\T '|sharp-T-reader|)))