1 (in-package :cl-tuples
)
3 ;; to do -- investigate cl-syntax-sugar to see if we can come up with
4 ;; some nicer custom syntax
6 ;; make #{ .. } notation become a short hand for (values ...)
7 (defun |
#{-reader|
(stream char arg
)
8 (declare (ignore char arg
))
9 `(values ,@(read-delimited-list #\
} stream t
)))
11 (defun |
#[-reader|
(stream char arg
)
12 (declare (ignore char arg
))
13 (let ((form (read-delimited-list #\
] stream t
)))
14 (if (tuple-typep (car form
))
15 (if (is-asterisk-symbol (car form
))
16 (let* ((form-str (symbol-name (car form
)))
17 (tuple-str (subseq form-str
0 (- (length form-str
) 1))))
18 `(,(make-adorned-symbol tuple-str
:asterisk t
:suffix
"VALUES") ,@(cdr form
)))
19 `(,(make-adorned-symbol (car form
) :prefix
"MAKE") ,@(cdr form
)))
20 (error "~A does not define a tuple type" (car form
)))))
22 (defvar *original-readtable
* NIL
)
24 (defvar *restore-reader-syntax
* NIL
)
26 (defmacro disable-tuples-syntax
()
27 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
28 (setf *restore-reader-syntax
* NIL
)
29 (%disable-tuples-syntax
)))
31 (defmacro locally-disable-tuples-syntax
()
32 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
33 (%disable-tuples-syntax
)))
35 (defun %disable-tuples-syntax
()
36 (when *original-readtable
*
37 (setf *readtable
* *original-readtable
*
38 *original-readtable
* NIL
))
41 (defmacro enable-tuples-syntax
()
42 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
43 (setf *restore-reader-syntax
* T
)
44 (%enable-tuples-syntax
)))
46 (defmacro locally-enable-tuples-syntax
()
47 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
48 (%enable-tuples-syntax
)))
50 (defmacro file-enable-tuples-syntax
()
51 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
52 (%enable-tuples-syntax NIL
)))
54 (defun %enable-tuples-syntax
(&optional
(save-original-p T
))
56 (setf *original-readtable
* (copy-readtable)))
57 (when (or (not save-original-p
) *original-readtable
*)
58 (setf *readtable
* (copy-readtable))
59 (set-dispatch-macro-character #\
# #\
{ #'|
#{-reader|
)
60 (set-dispatch-macro-character #\
# #\
[ #'|
#[-reader|
)
61 (set-macro-character #\
} (get-macro-character #\
) nil
))
62 (set-macro-character #\
] (get-macro-character #\
) nil
)))
65 (defmacro restore-tuples-syntax-state
()
66 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
67 (if *restore-tuples-syntax
*
68 (%enable-tuples-syntax
)
69 (%disable-tuples-syntax
))))