Commit 6f02ab5e authored by Tobias C. Rittweiler's avatar Tobias C. Rittweiler

* Finished.

* Fix readtable-iteration bugs on Allegro and SBCL

* Add some more tests

* Update documentation

darcs-hash:20090929202208-f5546-7215b739d453b6db930659e70366c7e4d8cc8ce6.gz
parent d275bbb3
...@@ -108,7 +108,7 @@ ...@@ -108,7 +108,7 @@
;;; CCL has a bug that prevents the portable form below from working ;;; CCL has a bug that prevents the portable form below from working
;;; (Ticket 601). CLISP will incorrectly fold the call to G-D-M-C away ;;; (Ticket 601). CLISP will incorrectly fold the call to G-D-M-C away
;;; if not declared inline.. ;;; if not declared inline.
(define-cruft dispatch-macro-char-p (char rt) (define-cruft dispatch-macro-char-p (char rt)
"Is CHAR a dispatch macro character in RT?" "Is CHAR a dispatch macro character in RT?"
#+ :ccl #+ :ccl
...@@ -123,14 +123,8 @@ ...@@ -123,14 +123,8 @@
(error () nil))) (error () nil)))
;; (defun macro-char-p (char rt) ;; (defun macro-char-p (char rt)
;; (let ((reader-fn (get-macro-character char rt))) ;; (let ((reader-fn (%get-macro-character char rt)))
;; (and reader-fn ;; (and reader-fn t)))
;; ;; Allegro stores READ-TOKEN as reader macro function of each
;; ;; constituent character.
;; #+allegro
;; (let ((read-token-fn
;; (load-time-value (get-macro-character #\A *standard-readtable*))))
;; (not (eq reader-fn read-token-fn))))))
;; (defun standard-macro-char-p (char rt) ;; (defun standard-macro-char-p (char rt)
;; (multiple-value-bind (rt-fn rt-flag) (get-macro-character char rt) ;; (multiple-value-bind (rt-fn rt-flag) (get-macro-character char rt)
...@@ -161,31 +155,33 @@ ...@@ -161,31 +155,33 @@
(dispatch-tables (sb-impl::dispatch-tables readtable)) (dispatch-tables (sb-impl::dispatch-tables readtable))
(char-code 0)) (char-code 0))
(with-hash-table-iterator (ht-iterator char-macro-ht) (with-hash-table-iterator (ht-iterator char-macro-ht)
(labels ((grovel1 () ; grovel base macro characters (labels ((grovel-base-chars ()
(declare (optimize sb-c::merge-tail-calls)) (declare (optimize sb-c::merge-tail-calls))
(if (>= char-code sb-int:base-char-code-limit) (if (>= char-code sb-int:base-char-code-limit)
(grovel2) (grovel-unicode-chars)
(let ((entry (svref char-macro-array char-code))) (let ((reader-fn (svref char-macro-array char-code))
(setq char-code (1+ char-code)) (char (code-char (shiftf char-code (1+ char-code)))))
(if entry (if reader-fn
(values t (code-char (1- char-code)) entry nil nil) (yield char reader-fn)
(grovel1))))) (grovel-base-chars)))))
(grovel2 () ; grovel unicode macro characters (grovel-unicode-chars ()
(multiple-value-bind (more? char reader-fn) (ht-iterator) (multiple-value-bind (more? char reader-fn) (ht-iterator)
(if (not more?) (if (not more?)
(grovel3) (values nil nil nil nil nil)
(values t char reader-fn nil nil)))) (yield char reader-fn))))
(grovel3 () ; grovel dispatch macro characters (yield (char reader-fn)
(if (null dispatch-tables) (let ((disp-ht))
(values nil nil nil nil nil) (cond
(let* ((disp-ch (caar dispatch-tables)) ((setq disp-ht (cdr (assoc char dispatch-tables)))
(disp-ht (cdar dispatch-tables)) (let* ((disp-fn (get-macro-character char readtable))
(disp-fn (get-macro-character disp-ch readtable)) (sub-char-alist))
(sub-char-alist)) (maphash (lambda (k v)
(setq dispatch-tables (cdr dispatch-tables)) (push (cons k v) sub-char-alist))
(maphash (lambda (k v) (push (cons k v) sub-char-alist)) disp-ht) disp-ht)
(values t disp-ch disp-fn t sub-char-alist))))) (values t char disp-fn t sub-char-alist)))
#'grovel1)))) (t
(values t char reader-fn nil nil))))))
#'grovel-base-chars))))
#+clozure #+clozure
(defun %make-readtable-iterator (readtable) (defun %make-readtable-iterator (readtable)
...@@ -203,39 +199,42 @@ ...@@ -203,39 +199,42 @@
(defun %make-readtable-iterator (readtable) (defun %make-readtable-iterator (readtable)
(declare (optimize speed)) ; for TCO (declare (optimize speed)) ; for TCO
(check-type readtable readtable) (check-type readtable readtable)
(let* ((+macro-attr+ 1) ; discovered through "reverse-engineering" (let* ((macro-table (first (excl::readtable-macro-table readtable)))
(attribute-table (first (excl::readtable-attribute-table readtable)))
(macro-table (first (excl::readtable-macro-table readtable)))
(dispatch-tables (excl::readtable-dispatch-tables readtable)) (dispatch-tables (excl::readtable-dispatch-tables readtable))
(table-length (length attribute-table)) (table-length (length macro-table))
(idx 0)) (idx 0))
(assert (= table-length (length macro-table)))
(labels ((grovel-macro-chars () (labels ((grovel-macro-chars ()
(if (>= idx table-length) (if (>= idx table-length)
(grovel-dispatch-chars) (grovel-dispatch-chars)
(let ((attr (svref attribute-table idx)) (let ((read-fn (svref macro-table idx))
(oidx idx)) (oidx idx))
(incf idx) (incf idx)
(if (= attr +macro-attr+) (if (or (eq read-fn #'excl::read-token)
(values t (code-char oidx) (svref macro-table oidx) nil nil) (eq read-fn #'excl::read-dispatch-char)
(grovel-macro-chars))))) (eq read-fn #'excl::undefined-macro-char))
(grovel-macro-chars)
(values t (code-char oidx) read-fn nil nil)))))
(grovel-dispatch-chars () (grovel-dispatch-chars ()
(if (null dispatch-tables) (if (null dispatch-tables)
(values nil nil nil nil nil) (values nil nil nil nil nil)
(destructuring-bind (disp-char sub-char-table) (destructuring-bind (disp-char sub-char-table)
(first dispatch-tables) (first dispatch-tables)
(setf dispatch-tables (rest dispatch-tables)) (setf dispatch-tables (rest dispatch-tables))
(values t ;;; Kludge. We can't fully clear dispatch tables
disp-char ;;; in %CLEAR-READTABLE.
(svref macro-table (char-code disp-char)) (when (eq (svref macro-table (char-code disp-char))
t #'excl::read-dispatch-char)
(loop for subch-fn across sub-char-table (values t
for subch-code from 0 disp-char
when subch-fn (svref macro-table (char-code disp-char))
collect (cons (code-char subch-code) t
subch-fn))))))) (loop for subch-fn across sub-char-table
#'grovel-macro-chars) for subch-code from 0
)) when subch-fn
collect (cons (code-char subch-code)
subch-fn))))))))
#'grovel-macro-chars)))
#-(or sbcl clozure allegro) #-(or sbcl clozure allegro)
(eval-when (:compile-toplevel) (eval-when (:compile-toplevel)
...@@ -305,8 +304,6 @@ ...@@ -305,8 +304,6 @@
;;;; Misc ;;;; Misc
(declaim (special *standard-readtable*))
;;; This should return an implementation's actual standard readtable ;;; This should return an implementation's actual standard readtable
;;; object only if the implementation makes the effort to guard against ;;; object only if the implementation makes the effort to guard against
;;; modification of that object. Otherwise it should better return a ;;; modification of that object. Otherwise it should better return a
...@@ -316,16 +313,47 @@ ...@@ -316,16 +313,47 @@
#+ :sbcl+safe-standard-readtable sb-impl::*standard-readtable* #+ :sbcl+safe-standard-readtable sb-impl::*standard-readtable*
#+ :common-lisp (copy-readtable nil)) #+ :common-lisp (copy-readtable nil))
;;; FIXME: Alas, on SBCL, SET-SYNTAX-FROM-CHAR does not get rid of a ;;; On SBCL, SET-SYNTAX-FROM-CHAR does not get rid of a
;;; readtable's dispatch table properly. ;;; readtable's dispatch table properly.
;;; Same goes for Allegro but that does not seem to provide a
;;; setter for their readtable's dispatch tables. Hence this ugly
;;; workaround.
(define-cruft %clear-readtable (readtable) (define-cruft %clear-readtable (readtable)
"Make all macro characters in READTABLE be consituents." "Make all macro characters in READTABLE be constituents."
#+ :common-lisp #+ :sbcl
(progn (prog1 readtable
(do-readtable (char readtable)
(set-syntax-from-char char #\A readtable))
(setf (sb-impl::dispatch-tables readtable) nil))
#+ :allegro
(prog1 readtable
(do-readtable (char readtable) (do-readtable (char readtable)
(set-syntax-from-char char #\A readtable *standard-readtable*)) (set-syntax-from-char char #\A readtable))
#+sbcl (setf (sb-impl::dispatch-tables readtable) nil) (let ((dispatch-tables (excl::readtable-dispatch-tables readtable)))
readtable)) (setf (cdr dispatch-tables) nil)
(setf (caar dispatch-tables) #\Backspace)
(setf (cadar dispatch-tables) (fill (cadar dispatch-tables) nil))))
#+ :common-lisp
(do-readtable (char readtable readtable)
(set-syntax-from-char char #\A readtable)))
;;; See Clozure Trac Ticket 601. This is supposed to be removed at
;;; some point in the future.
(define-cruft %get-dispatch-macro-character (char subchar rt)
"Ensure ANSI behaviour for GET-DISPATCH-MACRO-CHARACTER."
#+ :ccl (ignore-errors
(get-dispatch-macro-character char subchar rt))
#+ :common-lisp (get-dispatch-macro-character char subchar rt))
;;; Allegro stores READ-TOKEN as reader macro function of each
;;; constituent character.
(define-cruft %get-macro-character (char rt)
"Ensure ANSI behaviour for GET-MACRO-CHARACTER."
#+ :allegro (let ((fn (get-macro-character char rt)))
(cond ((not fn) nil)
((function= fn #'excl::read-token) nil)
(t fn)))
#+ :common-lisp (get-macro-character char rt))
;;;; Specialized PRINT-OBJECT for named readtables. ;;;; Specialized PRINT-OBJECT for named readtables.
......
...@@ -79,23 +79,23 @@ ...@@ -79,23 +79,23 @@
<br>&nbsp;<br><h3><a class=none name="notes_on_the_api">Notes on the API</a></h3> <br>&nbsp;<br><h3><a class=none name="notes_on_the_api">Notes on the API</a></h3>
&nbsp; &nbsp; The <code>API</code> heavily imitates the <code>API</code> of packages. This has the nice property that any <br> &nbsp; &nbsp; experienced Common Lisper will take it up without effort. &nbsp; &nbsp; The <code>API</code> heavily imitates the <code>API</code> of packages. This has the nice property that any <br> &nbsp; &nbsp; experienced Common Lisper will take it up without effort.
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#DEFREADTABLE"><CODE>DEFREADTABLE</CODE></A></code> - <code>DEFPACKAGE</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Defreadtable"><code>DEFREADTABLE</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/m_defpkg.htm"><code>DEFPACKAGE</code></a></code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#IN-READTABLE"><CODE>IN-READTABLE</CODE></A></code> - <code>IN-PACKAGE</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#In-Readtable"><code>IN-READTABLE</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/m_in_pkg.htm"><code>IN-PACKAGE</code></a></code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#MERGE-READTABLES-INTO"><CODE>MERGE-READTABLES-INTO</CODE></A></code> - <code>USE-PACKAGE</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Merge-Readtables-Into"><code>MERGE-READTABLES-INTO</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_use_pk.htm"><code>USE-PACKAGE</code></a></code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#MAKE-READTABLE"><CODE>MAKE-READTABLE</CODE></A></code> - <code>MAKE-PACKAGE</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Make-Readtable"><code>MAKE-READTABLE</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_mk_pkg.htm"><code>MAKE-PACKAGE</code></a></code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#UNREGISTER-READTABLE"><CODE>UNREGISTER-READTABLE</CODE></A></code> - <code>DELETE-PACKAGE</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Unregister-Readtable"><code>UNREGISTER-READTABLE</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_del_pk.htm"><code>DELETE-PACKAGE</code></a></code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#RENAME-READTABLE"><CODE>RENAME-READTABLE</CODE></A></code> - <code>RENAME-PACKAGE</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Rename-Readtable"><code>RENAME-READTABLE</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_rn_pkg.htm"><code>RENAME-PACKAGE</code></a></code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#FIND-READTABLE"><CODE>FIND-READTABLE</CODE></A></code> - <code>FIND-PACKAGE</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Find-Readtable"><code>FIND-READTABLE</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_find_p.htm"><code>FIND-PACKAGE</code></a></code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#READTABLE-NAME"><CODE>READTABLE-NAME</CODE></A></code> - <code>PACKAGE-NAME</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Readtable-Name"><code>READTABLE-NAME</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_pkg_na.htm"><code>PACKAGE-NAME</code></a></code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#LIST-ALL-NAMED-READTABLES"><CODE>LIST-ALL-NAMED-READTABLES</CODE></A></code> - <code>LIST-ALL-PACKAGES</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#List-All-Named-Readtables"><code>LIST-ALL-NAMED-READTABLES</code></a></code> - <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_list_a.htm"><code>LIST-ALL-PACKAGES</code></a></code>
<br>&nbsp;<br><h3><a class=none name="important_api_idiosyncrasies">Important API idiosyncrasies</a></h3> <br>&nbsp;<br><h3><a class=none name="important_api_idiosyncrasies">Important API idiosyncrasies</a></h3>
&nbsp; &nbsp; There are three major differences between the <code>API</code> of Named-Readtables, and the <code>API</code> <br> &nbsp; &nbsp; of packages. &nbsp; &nbsp; There are three major differences between the <code>API</code> of Named-Readtables, and the <code>API</code> <br> &nbsp; &nbsp; of packages.
<br><br> <br><br>
...@@ -117,15 +117,15 @@ ...@@ -117,15 +117,15 @@
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; (Such merging can more or less be implemented portably albeit at a certain cost. <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Most of the time, this cost manifests itself at the time a readtable is defined, <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; i.e. once at compile-time, so it may not bother you. Nonetheless, we provide extra <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; support for Sbcl, ClozureCL, and AllegroCL at the moment. Patches for your <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; implementation of choice are welcome, of course.) &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; (Such merging can more or less be implemented portably albeit at a certain cost. <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Most of the time, this cost manifests itself at the time a readtable is defined, <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; i.e. once at compile-time, so it may not bother you. Nonetheless, we provide extra <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; support for Sbcl, ClozureCL, and AllegroCL at the moment. Patches for your <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; implementation of choice are welcome, of course.)
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; <code>3.</code> <code><A HREF="#DEFREADTABLE"><CODE>DEFREADTABLE</CODE></A></code> does not have compile-time effects. &nbsp; &nbsp; &nbsp; <code>3.</code> <code><a href="#Defreadtable"><code>DEFREADTABLE</code></a></code> does not have compile-time effects.
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If you define a package via <code>DEFPACKAGE,</code> you can make that package the currently <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; active package for the subsequent compilation of the same file via <code>IN-PACKAGE.</code> The <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; same is, however, not true for <code><A HREF="#DEFREADTABLE"><CODE>DEFREADTABLE</CODE></A></code> and <code><A HREF="#IN-READTABLE"><CODE>IN-READTABLE</CODE></A></code> for the following <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; reason: &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If you define a package via <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/m_defpkg.htm"><code>DEFPACKAGE</code></a>,</code> you can make that package the currently <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; active package for the subsequent compilation of the same file via <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/m_in_pkg.htm"><code>IN-PACKAGE</code></a>.</code> The <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; same is, however, not true for <code><a href="#Defreadtable"><code>DEFREADTABLE</code></a></code> and <code><a href="#In-Readtable"><code>IN-READTABLE</code></a></code> for the following <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; reason:
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; It&#039;s unlikely that the need for special reader-macros arises for a problem <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; which can be solved in just one file. Most often, you&#039;re going to define the <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; reader macro functions, and set up the corresponding readtable in an extra file. &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; It&#039;s unlikely that the need for special reader-macros arises for a problem <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; which can be solved in just one file. Most often, you&#039;re going to define the <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; reader macro functions, and set up the corresponding readtable in an extra file.
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If <code><A HREF="#DEFREADTABLE"><CODE>DEFREADTABLE</CODE></A></code> had compile-time effects, you&#039;d have to wrap each definition <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; of a reader-macro function in an <code>EVAL-WHEN</code> to make its definition available at <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; compile-time. Because that&#039;s simply not the common case, <code><A HREF="#DEFREADTABLE"><CODE>DEFREADTABLE</CODE></A></code> does not <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; have a compile-time effect. &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If <code><a href="#Defreadtable"><code>DEFREADTABLE</code></a></code> had compile-time effects, you&#039;d have to wrap each definition <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; of a reader-macro function in an <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm"><code>EVAL-WHEN</code></a></code> to make its definition available at <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; compile-time. Because that&#039;s simply not the common case, <code><a href="#Defreadtable"><code>DEFREADTABLE</code></a></code> does not <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; have a compile-time effect.
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If you want to use a readtable within the same file as its definition, wrap the <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#DEFREADTABLE"><CODE>DEFREADTABLE</CODE></A></code> and the reader-macro function definitions in an explicit <code>EVAL-WHEN.</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If you want to use a readtable within the same file as its definition, wrap the <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Defreadtable"><code>DEFREADTABLE</code></a></code> and the reader-macro function definitions in an explicit <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm"><code>EVAL-WHEN</code></a>.</code>
<br>&nbsp;<br><h3><a class=none name="preregistered_readtables">Preregistered Readtables</a></h3> <br>&nbsp;<br><h3><a class=none name="preregistered_readtables">Preregistered Readtables</a></h3>
&nbsp; &nbsp; &nbsp; &nbsp; - <code>NIL,</code> <code>:STANDARD,</code> and <code>:COMMON-LISP</code> designate the <i><a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_s.htm#standard_readtable">standard readtable</a></i>. &nbsp; &nbsp; &nbsp; &nbsp; - <code>NIL,</code> <code>:STANDARD,</code> and <code>:COMMON-LISP</code> designate the <i><a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_s.htm#standard_readtable">standard readtable</a></i>.
<br><br> <br><br>
...@@ -175,7 +175,7 @@ ...@@ -175,7 +175,7 @@
SYMBOL)</code></blockquote><blockquote><i>result</i>: <code>READTABLE</code></blockquote>&nbsp;&nbsp;Description: SYMBOL)</code></blockquote><blockquote><i>result</i>: <code>READTABLE</code></blockquote>&nbsp;&nbsp;Description:
<blockquote> <blockquote>
Like <code>COPY-READTABLE</code> but takes a <code><A HREF="#NAMED-READTABLE-DESIGNATOR"><CODE>NAMED-READTABLE-DESIGNATOR</CODE></A></code> as argument. Like <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_cp_rdt.htm"><code>COPY-READTABLE</code></a></code> but takes a <code><a href="#Named-Readtable-Designator"><code>NAMED-READTABLE-DESIGNATOR</code></a></code> as argument.
</blockquote> </blockquote>
...@@ -194,27 +194,27 @@ The readtable can be populated using the following <i>options</i>: ...@@ -194,27 +194,27 @@ The readtable can be populated using the following <i>options</i>:
<br><br> <br><br>
&nbsp; &nbsp; <code>(:MERGE</code> <i>readtable-designators</i>+) &nbsp; &nbsp; <code>(:MERGE</code> <i>readtable-designators</i>+)
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Merge the readtables designated into the new readtable being defined as per <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><A HREF="#MERGE-READTABLES-INTO"><CODE>MERGE-READTABLES-INTO</CODE></A>.</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Merge the readtables designated into the new readtable being defined as per <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <code><a href="#Merge-Readtables-Into"><code>MERGE-READTABLES-INTO</code></a>.</code>
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If no <code>:MERGE</code> clause is given, an empty readtable is used. See <code><A HREF="#MAKE-READTABLE"><CODE>MAKE-READTABLE</CODE></A>.</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If no <code>:MERGE</code> clause is given, an empty readtable is used. See <code><a href="#Make-Readtable"><code>MAKE-READTABLE</code></a>.</code>
<br><br> <br><br>
&nbsp; &nbsp; <code>(:FUZE</code> <i>readtable-designators</i>+) &nbsp; &nbsp; <code>(:FUZE</code> <i>readtable-designators</i>+)
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Like <code>:MERGE</code> except: &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Like <code>:MERGE</code> except:
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Error conditions of type <code><A HREF="#READER-MACRO-CONFLICT"><CODE>READER-MACRO-CONFLICT</CODE></A></code> that are signaled during the merge <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; operation will be silently <u>continued</u>. It follows that reader macros in earlier <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; entries will be overwritten by later ones. &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Error conditions of type <code><a href="#Reader-Macro-Conflict"><code>READER-MACRO-CONFLICT</code></a></code> that are signaled during the merge <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; operation will be silently <u>continued</u>. It follows that reader macros in earlier <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; entries will be overwritten by later ones.
<br><br> <br><br>
&nbsp; &nbsp; <code>(:DISPATCH-MACRO-CHAR</code> <i>macro-char</i> <i>sub-char</i> <i>function</i>) &nbsp; &nbsp; <code>(:DISPATCH-MACRO-CHAR</code> <i>macro-char</i> <i>sub-char</i> <i>function</i>)
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Define a new sub character <i>sub-char</i> for the dispatching macro character <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <i>macro-char</i>, per <code>SET-DISPATCH-MACRO-CHARACTER.</code> You probably have to define <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <i>macro-char</i> as a dispatching macro character by the following option first. &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Define a new sub character <i>sub-char</i> for the dispatching macro character <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <i>macro-char</i>, per <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_set__1.htm"><code>SET-DISPATCH-MACRO-CHARACTER</code></a>.</code> You probably have to define <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <i>macro-char</i> as a dispatching macro character by the following option first.
<br><br> <br><br>
&nbsp; &nbsp; <code>(:MACRO-CHAR</code> <i>macro-char</i> <i>function</i> [<i>non-terminating-p</i>]) &nbsp; &nbsp; <code>(:MACRO-CHAR</code> <i>macro-char</i> <i>function</i> [<i>non-terminating-p</i>])
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Define a new macro character in the readtable, per <code>SET-MACRO-CHARACTER.</code> If <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <i>function</i> is the keyword <code>:DISPATCH,</code> <i>macro-char</i> is made a dispatching <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; macro character, per <code>MAKE-DISPATCH-MACRO-CHARACTER.</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Define a new macro character in the readtable, per <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_set_ma.htm"><code>SET-MACRO-CHARACTER</code></a>.</code> If <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <i>function</i> is the keyword <code>:DISPATCH,</code> <i>macro-char</i> is made a dispatching <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; macro character, per <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_mk_dis.htm"><code>MAKE-DISPATCH-MACRO-CHARACTER</code></a>.</code>
<br><br> <br><br>
&nbsp; &nbsp; <code>(:SYNTAX-FROM</code> <i>from-readtable-designator</i> <i>from-char</i> <i>to-char</i>) &nbsp; &nbsp; <code>(:SYNTAX-FROM</code> <i>from-readtable-designator</i> <i>from-char</i> <i>to-char</i>)
<br><br> <br><br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Set the character syntax of <i>to-char</i> in the readtable being defined to the <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; same syntax as <i>from-char</i> as per <code>SET-SYNTAX-FROM-CHAR.</code> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Set the character syntax of <i>to-char</i> in the readtable being defined to the <br> &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; same syntax as <i>from-char</i> as per <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/f_set_sy.htm"><code>SET-SYNTAX-FROM-CHAR</code></a>.</code>
<br><br> <br><br>
&nbsp; &nbsp; <code>(:CASE</code> <i>case-mode</i>) &nbsp; &nbsp; <code>(:CASE</code> <i>case-mode</i>)
<br><br> <br><br>
...@@ -224,7 +224,7 @@ Any number of option clauses may appear. The options are grouped by their type, ...@@ -224,7 +224,7 @@ Any number of option clauses may appear. The options are grouped by their type,
<br><br> <br><br>
Notes: Notes:
<br><br> <br><br>
&nbsp; &nbsp; The readtable is defined at load-time. If you want to have it available at <br> &nbsp; &nbsp; compilation time <code>--</code> say to use its reader-macros in the same file as its definition <br> &nbsp; &nbsp; <code>--</code> you have to wrap the <code><A HREF="#DEFREADTABLE"><CODE>DEFREADTABLE</CODE></A></code> form in an explicit <code>EVAL-WHEN.</code> &nbsp; &nbsp; The readtable is defined at load-time. If you want to have it available at <br> &nbsp; &nbsp; compilation time <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/a__.htm"><code>-</code></a>-</code> say to use its reader-macros in the same file as its definition <br> &nbsp; &nbsp; <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/a__.htm"><code>-</code></a>-</code> you have to wrap the <code><a href="#Defreadtable"><code>DEFREADTABLE</code></a></code> form in an explicit <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm"><code>EVAL-WHEN</code></a>.</code>
<br><br> <br><br>
&nbsp; &nbsp; On redefinition, the target readtable is made empty first before it&#039;s refilled <br> &nbsp; &nbsp; according to the clauses. &nbsp; &nbsp; On redefinition, the target readtable is made empty first before it&#039;s refilled <br> &nbsp; &nbsp; according to the clauses.
<br><br> <br><br>
...@@ -245,7 +245,7 @@ Notes: ...@@ -245,7 +245,7 @@ Notes:
SYMBOL)</code></blockquote><blockquote><i>result</i>: <code>READTABLE</code></blockquote>&nbsp;&nbsp;Description: SYMBOL)</code></blockquote><blockquote><i>result</i>: <code>READTABLE</code></blockquote>&nbsp;&nbsp;Description:
<blockquote> <blockquote>
Looks up the readtable specified by <i>name</i> and returns it if it&#039;s found. <br> If it is not found, it registers the readtable designated by <i>default</i> under <br> the name represented by <i>name</i>; or if no default argument is given, it signals <br> an error of type <code><A HREF="#READTABLE-DOES-NOT-EXIST"><CODE>READTABLE-DOES-NOT-EXIST</CODE></A></code> instead. Looks up the readtable specified by <i>name</i> and returns it if it&#039;s found. <br> If it is not found, it registers the readtable designated by <i>default</i> under <br> the name represented by <i>name</i>; or if no default argument is given, it signals <br> an error of type <code><a href="#Readtable-Does-Not-Exist"><code>READTABLE-DOES-NOT-EXIST</code></a></code> instead.
</blockquote> </blockquote>
...@@ -275,7 +275,7 @@ Looks for the readtable specified by <i>name</i> and returns it if it is found. ...@@ -275,7 +275,7 @@ Looks for the readtable specified by <i>name</i> and returns it if it is found.
<p><br>[Macro]<br><a class=none name='IN-READTABLE'><b>in-readtable</b> <i>name</i> =&gt; <i>result</i></a><br><br>&nbsp;&nbsp;Description: <p><br>[Macro]<br><a class=none name='IN-READTABLE'><b>in-readtable</b> <i>name</i> =&gt; <i>result</i></a><br><br>&nbsp;&nbsp;Description:
<blockquote> <blockquote>
Set <code>*READTABLE*</code> to the readtable referred to by the symbol <i>name</i>. Set <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/v_rdtabl.htm"><code>*READTABLE*</code></a></code> to the readtable referred to by the symbol <i>name</i>.
</blockquote> </blockquote>
...@@ -305,9 +305,15 @@ Returns a list of all registered readtables. The returned list is guaranteed to ...@@ -305,9 +305,15 @@ Returns a list of all registered readtables. The returned list is guaranteed to
Creates and returns a new readtable under the specified <i>name</i>. Creates and returns a new readtable under the specified <i>name</i>.
<br><br> <br><br>
<i>merge</i> takes a list of <code><A HREF="#NAMED-READTABLE-DESIGNATOR"><CODE>NAMED-READTABLE-DESIGNATORS</CODE></A></code> and specifies the <br> readtables the new readtable is created from. (See the <code>:MERGE</code> clause of <code><A HREF="#DEFREADTABLE"><CODE>DEFREADTABLE</CODE></A></code> <br> for details.) If <i>merge</i> is <code>NIL,</code> an empty readtable is used instead. <i>merge</i> takes a list of <code><a href="#Named-Readtable-Designators"><code>NAMED-READTABLE-DESIGNATORS</code></a></code> and specifies the <br> readtables the new readtable is created from. (See the <code>:MERGE</code> clause of <code><a href="#Defreadtable"><code>DEFREADTABLE</code></a></code> <br> for details.)
<br><br> <br><br>
An empty readtable is a readtable where the character syntax of each character is <br> like in the <i><a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_s.htm#standard_readtable">standard readtable</a></i> except that each standard macro character has been <br> made a constituent. If <i>merge</i> is <code>NIL,</code> an empty readtable is used instead.
<br><br>
If <i>name</i> is not given, an anonymous empty readtable is returned.
<br><br>
Notes:
<br><br>
&nbsp; &nbsp; An empty readtable is a readtable where each character&#039;s syntax is the same as <br> &nbsp; &nbsp; in the <i><a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_s.htm#standard_readtable">standard readtable</a></i> except that each macro character has been made a <br> &nbsp; &nbsp; constituent. Basically: whitespace stays whitespace, everything else is constituent.
</blockquote> </blockquote>
...@@ -326,7 +332,7 @@ An empty readtable is a readtable where the character syntax of each character i ...@@ -326,7 +332,7 @@ An empty readtable is a readtable where the character syntax of each character i
Copy the contents of each readtable in <i>named-readtables</i> into <br> <i>result-table</i>. Copy the contents of each readtable in <i>named-readtables</i> into <br> <i>result-table</i>.
<br><br> <br><br>
If a macro character appears in more than one of the readtables, i.e. if a conflict <br> is discovered during the merge, an error of type <code><A HREF="#READER-MACRO-CONFLICT"><CODE>READER-MACRO-CONFLICT</CODE></A></code> is signaled. If a macro character appears in more than one of the readtables, i.e. if a conflict <br> is discovered during the merge, an error of type <code><a href="#Reader-Macro-Conflict"><code>READER-MACRO-CONFLICT</code></a></code> is signaled.
</blockquote> </blockquote>
...@@ -422,7 +428,7 @@ Associate <i>readtable</i> with <i>name</i>. Returns the readtable. ...@@ -422,7 +428,7 @@ Associate <i>readtable</i> with <i>name</i>. Returns the readtable.
SYMBOL)</code></blockquote><blockquote><i>new-name</i>: <code>SYMBOL</code></blockquote><blockquote><i>result</i>: <code>READTABLE</code></blockquote>&nbsp;&nbsp;Description: SYMBOL)</code></blockquote><blockquote><i>new-name</i>: <code>SYMBOL</code></blockquote><blockquote><i>result</i>: <code>READTABLE</code></blockquote>&nbsp;&nbsp;Description:
<blockquote> <blockquote>
Replaces the associated name of the readtable designated by <i>old-name</i> with <br> <i>new-name</i>. If a readtable is already registered under <i>new-name</i>, an <br> error of type <code><A HREF="#READTABLE-DOES-ALREADY-EXIST"><CODE>READTABLE-DOES-ALREADY-EXIST</CODE></A></code> is signaled. Replaces the associated name of the readtable designated by <i>old-name</i> with <br> <i>new-name</i>. If a readtable is already registered under <i>new-name</i>, an <br> error of type <code><a href="#Readtable-Does-Already-Exist"><code>READTABLE-DOES-ALREADY-EXIST</code></a></code> is signaled.
</blockquote> </blockquote>
...@@ -438,7 +444,7 @@ Replaces the associated name of the readtable designated by <i>old-name</i> with ...@@ -438,7 +444,7 @@ Replaces the associated name of the readtable designated by <i>old-name</i> with
NIL)</code></blockquote>&nbsp;&nbsp;Description: NIL)</code></blockquote>&nbsp;&nbsp;Description:
<blockquote> <blockquote>
Remove the association of <i>named-readtable</i>. Returns <code>T</code> if successfull, <code>NIL</code> <br> otherwise. Remove the association of <i>named-readtable</i>. Returns <code><a href="http://www.lispworks.com/reference/HyperSpec/Body/a_t.htm"><code>T</code></a></code> if successfull, <code>NIL</code> <br> otherwise.
</blockquote> </blockquote>
...@@ -448,7 +454,7 @@ Remove the association of <i>named-readtable</i>. Returns <code>T</code> if succ ...@@ -448,7 +454,7 @@ Remove the association of <i>named-readtable</i>. Returns <code>T</code> if succ
<hr> <hr>
<p> <p>
This documentation was generated on 2009-9-26 from a Lisp image using some home-brewn, This documentation was generated on 2009-9-29 from a Lisp image using some home-brewn,
duct-taped, <br> evolutionary hacked extension of Edi Weitz' duct-taped, <br> evolutionary hacked extension of Edi Weitz'
<a href="http://weitz.de/documentation-template/">DOCUMENTATION-TEMPLATE</a>. <a href="http://weitz.de/documentation-template/">DOCUMENTATION-TEMPLATE</a>.
</p> </p>
......
...@@ -189,13 +189,19 @@ Notes: ...@@ -189,13 +189,19 @@ Notes:
"Creates and returns a new readtable under the specified `name'. "Creates and returns a new readtable under the specified `name'.
`merge' takes a list of NAMED-READTABLE-DESIGNATORS and specifies the `merge' takes a list of NAMED-READTABLE-DESIGNATORS and specifies the
readtables the new readtable is created from. (See the :MERGE clause readtables the new readtable is created from. (See the :MERGE clause of
of DEFREADTABLE for details.) If `merge' is NIL, an empty readtable is DEFREADTABLE for details.)
used instead.
An empty readtable is a readtable where the character syntax of each If `merge' is NIL, an empty readtable is used instead.
character is like in the /standard readtable/ except that each
standard macro character has been made a constituent." If `name' is not given, an anonymous empty readtable is returned.
Notes:
An empty readtable is a readtable where each character's syntax is the
same as in the /standard readtable/ except that each macro character has
been made a constituent. Basically: whitespace stays whitespace,
everything else is constituent."
(cond ((not name-supplied-p) (cond ((not name-supplied-p)
(copy-readtable *empty-readtable*)) (copy-readtable *empty-readtable*))
((reserved-readtable-name-p name) ((reserved-readtable-name-p name)
...@@ -255,8 +261,8 @@ READER-MACRO-CONFLICT is signaled." ...@@ -255,8 +261,8 @@ READER-MACRO-CONFLICT is signaled."
(t (t
(ensure-dispatch-macro-character char non-terminating-p to) (ensure-dispatch-macro-character char non-terminating-p to)
(loop for (subchar . subfn) in table do (loop for (subchar . subfn) in table do
(check-reader-macro-conflict from to char subchar) (check-reader-macro-conflict from to char subchar)
(set-dispatch-macro-character char subchar subfn to))))) (set-dispatch-macro-character char subchar subfn to)))))
to)) to))
(let ((result-table (ensure-readtable result-readtable))) (let ((result-table (ensure-readtable result-readtable)))
(dolist (table (mapcar #'ensure-readtable named-readtables)) (dolist (table (mapcar #'ensure-readtable named-readtables))
...@@ -265,8 +271,9 @@ READER-MACRO-CONFLICT is signaled." ...@@ -265,8 +271,9 @@ READER-MACRO-CONFLICT is signaled."
(defun ensure-dispatch-macro-character (char &optional non-terminating-p (defun ensure-dispatch-macro-character (char &optional non-terminating-p
(readtable *readtable*)) (readtable *readtable*))
(unless (dispatch-macro-char-p char readtable) (if (dispatch-macro-char-p char readtable)
(make-dispatch-macro-character char non-terminating-p readtable))) t
(make-dispatch-macro-character char non-terminating-p readtable)))
(define-api copy-named-readtable (define-api copy-named-readtable
(named-readtable) (named-readtable)
...@@ -339,15 +346,15 @@ This condition is signaled during the merge process if a) a reader macro ...@@ -339,15 +346,15 @@ This condition is signaled during the merge process if a) a reader macro
character\) is both present in the source as well as the target readtable, character\) is both present in the source as well as the target readtable,
and b) if and only if the two respective reader macro functions differ.")) and b) if and only if the two respective reader macro functions differ."))
(defun check-reader-macro-conflict (from to char &optional subchar) (defun check-reader-macro-conflict (from to char &optional subchar)
(flet ((conflictp (from-fn to-fn) (flet ((conflictp (from-fn to-fn)
(assert from-fn) ; if this fails, there's a bug in readtable iterators.
(and to-fn (not (function= to-fn from-fn))))) (and to-fn (not (function= to-fn from-fn)))))
(when (if subchar (when (if subchar
(conflictp (safe-get-dispatch-macro-character char subchar from) (conflictp (%get-dispatch-macro-character char subchar from)
(safe-get-dispatch-macro-character char subchar to)) (%get-dispatch-macro-character char subchar to))
(conflictp (get-macro-character char from) (conflictp (%get-macro-character char from)
(get-macro-character char to))) (%get-macro-character char to)))
(cerror (format nil "Overwrite ~@C in ~A." char to) (cerror (format nil "Overwrite ~@C in ~A." char to)
'reader-macro-conflict 'reader-macro-conflict
:from-readtable from :from-readtable from
...@@ -355,13 +362,6 @@ and b) if and only if the two respective reader macro functions differ.")) ...@@ -355,13 +362,6 @@ and b) if and only if the two respective reader macro functions differ."))
:macro-char char :macro-char char
:sub-char subchar)))) :sub-char subchar))))
;;; See Ticket 601. This is supposed to be removed at some point in
;;; the future.
(defun safe-get-dispatch-macro-character (char subchar rt)
#+ccl (ignore-errors
(get-dispatch-macro-character char subchar rt))
#-ccl (get-dispatch-macro-character char subchar rt))
;;; Although there is no way to get at the standard readtable in ;;; Although there is no way to get at the standard readtable in
;;; Common Lisp (cf. /standard readtable/, CLHS glossary), we make ;;; Common Lisp (cf. /standard readtable/, CLHS glossary), we make
......
...@@ -5,7 +5,8 @@ ...@@ -5,7 +5,8 @@
(defpackage :named-readtables-test (defpackage :named-readtables-test
(:use :cl :named-readtables) (:use :cl :named-readtables)
(:import-from :named-readtables (:import-from :named-readtables
#:*empty-readtable* #:dispatch-macro-char-p
#:do-readtable #:do-readtable
#:ensure-function #:ensure-function
#:ensure-dispatch-macro-character
#:function=)) #:function=))
\ No newline at end of file
...@@ -8,6 +8,9 @@ ...@@ -8,6 +8,9 @@
(funcall cdr-fn (cdr entry)))) (funcall cdr-fn (cdr entry))))
alist)) alist))
(defun length=1 (list)
(and list (null (cdr list))))
(defmacro signals-condition-p (name &body body) (defmacro signals-condition-p (name &body body)
`(handler-case (prog1 nil ,@body) `(handler-case (prog1 nil ,@body)
(,(second name) () t))) (,(second name) () t)))
...@@ -98,6 +101,48 @@ ...@@ -98,6 +101,48 @@
(get-macro-character #\" (copy-readtable nil))) (get-macro-character #\" (copy-readtable nil)))
t) t)
(deftest cruft.2
(dispatch-macro-char-p #\# (find-readtable :standard))
t)
(deftest cruft.3
(dispatch-macro-char-p #\# (make-readtable))
nil)
(deftest cruft.4
(let ((rt (copy-named-readtable :standard)))
(ensure-dispatch-macro-character #\# t rt)
(dispatch-macro-char-p #\# rt))
t)
(deftest cruft.5
(let ((rt (make-readtable)))
(values
(dispatch-macro-char-p #\$ rt)
(ensure-dispatch-macro-character #\$ t rt)
(dispatch-macro-char-p #\$ rt)))
nil t t)
(deftest cruft.6
(let ((rt (make-readtable))
(fn (constantly nil)))
(ensure-dispatch-macro-character #\$ t rt)
(set-dispatch-macro-character #\$ #\# fn rt)
(values
(eq fn (get-dispatch-macro-character #\$ #\# rt))
(length=1 (readtable-content rt))))
t t)
(deftest cruft.7
(let ((rt (make-readtable))
(fn (constantly nil)))
(set-macro-character #\$ fn t rt)
(values