[Advanced-readtable-cvs] r12 -
rklochkov at common-lisp.net
rklochkov at common-lisp.net
Mon Dec 31 13:39:29 UTC 2012
Author: rklochkov
Date: Mon Dec 31 05:39:29 2012
New Revision: 12
Log:
Fixed wrong behavior when no symbol found
Modified:
package.lisp
src.lisp
Modified: package.lisp
==============================================================================
--- package.lisp Sun Dec 30 06:35:37 2012 (r11)
+++ package.lisp Mon Dec 31 05:39:29 2012 (r12)
@@ -7,7 +7,7 @@
#:set-macro-symbol
#:get-macro-symbol
#:activate
- #:!
+ #:! #:find-package #:find-symbol
#:package-finders
#:symbol-finders
#:*package-finders*
Modified: src.lisp
==============================================================================
--- src.lisp Sun Dec 30 06:35:37 2012 (r11)
+++ src.lisp Mon Dec 31 05:39:29 2012 (r12)
@@ -15,15 +15,10 @@
"List of handlers. Each handler is a cons (key . function)
function = (lambda (name package) ...) -> package")
-
-
-
;;;
;;; Prepare readtables
;;;
-
-
(defvar *advanced-readtable* (copy-readtable nil))
(defvar *colon-readtable* (copy-readtable nil)
"Support readtable with colon as whitespace")
@@ -34,8 +29,6 @@
(defpackage #:advanced-readtable.junk)
-
-
(defun try-funcall (handlers-list name package)
(declare (type list handlers-list)
(type string name)
@@ -55,7 +48,8 @@
(or
(cl:find-package name)
(when current-package
- (try-funcall (package-finders current-package) sname current-package))
+ (try-funcall (package-finders current-package)
+ sname current-package))
(try-funcall *package-finders* sname current-package)))))
(defvar *package-symbol-finders* (make-hash-table :test 'eq)
@@ -161,7 +155,8 @@
(defun read-after-colon (stream maybe-package colons)
"Read symbol package:sym or list package:(...)"
(declare (type stream stream)
- (type fixnum colons))
+ (type (integer 0 2) colons))
+ (check-type colons (integer 0 2))
(when (= colons 0) ; no colon: this is a symbol or an atom
(return-from read-after-colon
(if (symbolp maybe-package)
@@ -188,6 +183,11 @@
(check-type token symbol)
(multiple-value-bind (symbol status)
(find-symbol (symbol-name token) package)
+ (unless status
+ (if (= colons 1) (error "No external symbol ~S in ~S"
+ (symbol-name token) package)
+ (cerror "Intern ~S in ~S" "No such symbol ~S in package ~S"
+ (symbol-name token) package)))
(unintern token)
(when (and (= colons 1) (not (eq status :external)))
(cerror "Use anyway"
More information about the Advanced-readtable-cvs
mailing list