:test #'char= :key #'car)))
(set-cat-entry to-char att to-readtable)
(set-cmt-entry to-char mac to-readtable)
- (when from-dpair
- (cond
- (to-dpair
- (let ((table (cdr to-dpair)))
- (clrhash table)
- (shallow-replace/eql-hash-table table (cdr from-dpair))))
- (t
- (let ((pair (cons to-char (make-hash-table))))
- (shallow-replace/eql-hash-table (cdr pair) (cdr from-dpair))
+ (cond ((and (not from-dpair) (not to-dpair)))
+ ((and (not from-dpair) to-dpair)
(setf (dispatch-tables to-readtable)
- (push pair (dispatch-tables to-readtable)))))))))
+ (remove to-dpair (dispatch-tables to-readtable))))
+ (to-dpair
+ (let ((table (cdr to-dpair)))
+ (clrhash table)
+ (shallow-replace/eql-hash-table table (cdr from-dpair))))
+ (t
+ (let ((pair (cons to-char (make-hash-table))))
+ (shallow-replace/eql-hash-table (cdr pair) (cdr from-dpair))
+ (setf (dispatch-tables to-readtable)
+ (push pair (dispatch-tables to-readtable))))))))
t)
(defun set-macro-character (char function &optional
"Causes CHAR to be a macro character which invokes FUNCTION when seen
by the reader. The NON-TERMINATINGP flag can be used to make the macro
character non-terminating, i.e. embeddable in a symbol name."
- (let ((designated-readtable (or rt-designator *standard-readtable*)))
+ (let ((designated-readtable (or rt-designator *standard-readtable*))
+ (function (%coerce-callable-to-fun function)))
(assert-not-standard-readtable designated-readtable 'set-macro-character)
(set-cat-entry char (if non-terminatingp
+char-attr-constituent+
(define-compiler-macro read-from-string (&whole form string &rest args)
;; Check this at compile-time, and rewrite it so we're silent at runtime.
- (destructuring-bind (&optional eof-error-p eof-value &rest keys)
+ (destructuring-bind (&optional (eof-error-p t) eof-value &rest keys)
args
(cond ((maybe-note-read-from-string-signature-issue eof-error-p)
`(read-from-string ,string t ,eof-value ,@keys))
(:preserve-whitespace preserve-whitespace)
(otherwise
(return-from read-from-string form)))))
- (when (assoc key seen)
+ (when (member key seen)
(setf var (gensym "IGNORE"))
(push var ignore))
(push key seen)