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.

diff --git a/NEWS b/NEWS
index 9a82f45..76ca271 100644 (file)
--- 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 <pkgname>::<form-in-package>
+    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 (file)
--- 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
+<package-name>::<form-in-package>
+@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 (file)
--- 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 <package-name>::<form-in-package> 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 (file)
--- 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)"))))