From 2612849876e000af9b3c1f52cddb04cef0841f37 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 3 Dec 2011 11:01:25 +0200 Subject: [PATCH] add support for package::form-read-in-package syntax sb-c::(csubtypep (specifier-type 'fixnum) (specifier-type 'integer)) Isn't that lovely? The superbly fantasic thing is that this even works *right* with package locks: (in-package :cl-user) sb-c::(defun some-internal-bit ...) causes a package lock violation since the current package is back to CL-USER by the type the code is executed. --- NEWS | 2 ++ doc/manual/beyond-ansi.texinfo | 19 +++++++++++++++++++ src/code/reader.lisp | 19 +++++++++---------- tests/reader.pure.lisp | 6 +++++- 4 files changed, 35 insertions(+), 11 deletions(-) diff --git a/NEWS b/NEWS index 9a82f45..76ca271 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,8 @@ changes relative to sbcl-1.0.54: ** --arch option can be used to specify the architecture to build for. (Mainly useful for building 32-bit SBCL's on x86-64 hosts, not full-blows cross-compilation.) + * enhancement: extended package prefix syntax :: + which allows specifying the name of the package for a whole form. * enhancement: when *READ-EVAL* is true, arrays with element type other than T can be printed readably using #.-based syntax. (Thanks to Robert Brown) * enhancement: MAKE-ALIEN signals a storage-condition instead of returning a diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo index 08b942b..1e684d4 100644 --- a/doc/manual/beyond-ansi.texinfo +++ b/doc/manual/beyond-ansi.texinfo @@ -7,6 +7,7 @@ ANSI standard. SBCL doesn't support as many extensions as CMUCL, but it still has quite a few. @xref{Contributed Modules}. @menu +* Reader Extensions:: * Garbage Collection:: * Metaobject Protocol:: * Support For Unix:: @@ -19,6 +20,24 @@ it still has quite a few. @xref{Contributed Modules}. * Efficiency Hacks:: @end menu +@node Reader Extensions +@comment node-name, next, previous, up +@section Reader Extensions +@cindex Reader Extensions + +SBCL supports extended package prefix syntax, which allows specifying +the package to read an arbitrary form in: + +@lisp +:: +@end lisp + +Example: + +@lisp + 'foo::(bar quux zot) == '(foo::bar foo::quux foo::zot) +@end lisp + @node Garbage Collection @comment node-name, next, previous, up @section Garbage Collection diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 56b8ac1..77ab6f0 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -906,7 +906,8 @@ standard Lisp readtable when NIL." (defun read-token (stream firstchar) #!+sb-doc - "This function is just an fsm that recognizes numbers and symbols." + "Default readmacro function. Handles numbers, symbols, and SBCL's +extended :: syntax." ;; Check explicitly whether FIRSTCHAR has an entry for ;; NON-TERMINATING in CHARACTER-ATTRIBUTE-TABLE and ;; READ-DOT-NUMBER-SYMBOL in CMT. Report an error if these are @@ -1260,9 +1261,12 @@ standard Lisp readtable when NIL." (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-delimiter+ (unread-char char stream) - (simple-reader-error stream - "illegal terminating character after a colon: ~S" - char)) + (if package-designator + (let ((*package* (%find-package-or-lose package-designator))) + (return (read stream t nil t))) + (simple-reader-error stream + "illegal terminating character after a double-colon: ~S" + char))) (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ @@ -1273,13 +1277,8 @@ standard Lisp readtable when NIL." RETURN-SYMBOL (casify-read-buffer escapes) (let ((found (if package-designator - (find-package package-designator) + (%find-package-or-lose package-designator) (sane-package)))) - (unless found - (error 'simple-reader-package-error :stream stream - :format-arguments (list package-designator) - :format-control "package ~S not found")) - (if (or (zerop colons) (= colons 2) (eq found *keyword-package*)) (return (intern* *read-buffer* *ouch-ptr* found)) (multiple-value-bind (symbol test) diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index d5407e4..1fbd790 100644 --- a/tests/reader.pure.lisp +++ b/tests/reader.pure.lisp @@ -263,7 +263,7 @@ (reader-error () :error))))) -(with-test (:name set-syntax-from-char-dispatch-macro-char) +(with-test (:name :set-syntax-from-char-dispatch-macro-char) (let ((rt (copy-readtable))) (make-dispatch-macro-character #\! nil rt) (set-dispatch-macro-character #\! #\! (constantly 'bang^2) rt) @@ -273,3 +273,7 @@ (assert (eq 'bang^2 (maybe-bang))) (set-syntax-from-char #\! #\! rt) (assert (eq '!! (maybe-bang)))))) + +(with-test (:name :read-in-package-syntax) + (assert (equal '(sb-c::a (sb-kernel::x sb-kernel::y) sb-c::b) + (read-from-string "sb-c::(a sb-kernel::(x y) b)")))) -- 1.7.10.4