repos
/
cl-unification
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Add (enable-template-reader), so it is easy to turn on the template reader
Annotate for file /template-reader.lisp
2010-02-05 pix
1
;;; Setting up the reader macro.
09:02:42 '
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|)))