X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Freader.lisp;h=afc665095e9d236a8776cc09334d86e732bfec6f;hb=3f3033a6c0ddf0af8dd1b5a17c2a4b82ea59b94f;hp=56b8ac1a45c09878eba3819d7e931514bfd0e3f6;hpb=f71445c16693bf12ac835a46763e1dfb25a6db0a;p=sbcl.git diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 56b8ac1..afc6650 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -904,9 +904,12 @@ standard Lisp readtable when NIL." (cond (all-lower (raise-em)) (all-upper (lower-em)))))))))))) +(defvar *reader-package* 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 +1263,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* ((*reader-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 +1279,8 @@ standard Lisp readtable when NIL." RETURN-SYMBOL (casify-read-buffer escapes) (let ((found (if package-designator - (find-package package-designator) - (sane-package)))) - (unless found - (error 'simple-reader-package-error :stream stream - :format-arguments (list package-designator) - :format-control "package ~S not found")) - + (%find-package-or-lose package-designator) + (or *reader-package* (sane-package))))) (if (or (zerop colons) (= colons 2) (eq found *keyword-package*)) (return (intern* *read-buffer* *ouch-ptr* found)) (multiple-value-bind (symbol test)