Commit 8a298b58 authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

Update for compatibility with ACL 8.2.

Patch from Vladimir Sedach who notes that the ERROR-P argument to ACL's
EXCL:NAMED-READTABLE has changed to default to TRUE.  Add an explicit
NIL where necessary for correct behavior.
parent ea8ac96c
...@@ -85,7 +85,7 @@ ...@@ -85,7 +85,7 @@
(define-cruft %find-readtable (name) (define-cruft %find-readtable (name)
"Return the readtable named NAME." "Return the readtable named NAME."
#+ :allegro (excl:named-readtable (readtable-name-for-allegro name)) #+ :allegro (excl:named-readtable (readtable-name-for-allegro name) nil)
#+ :common-lisp (values (gethash name *named-readtables* nil))) #+ :common-lisp (values (gethash name *named-readtables* nil)))
...@@ -130,14 +130,14 @@ ...@@ -130,14 +130,14 @@
;; (multiple-value-bind (rt-fn rt-flag) (get-macro-character char rt) ;; (multiple-value-bind (rt-fn rt-flag) (get-macro-character char rt)
;; (multiple-value-bind (std-fn std-flag) (get-macro-character char *standard-readtable*) ;; (multiple-value-bind (std-fn std-flag) (get-macro-character char *standard-readtable*)
;; (and (eq rt-fn std-fn) ;; (and (eq rt-fn std-fn)
;; (eq rt-flag std-flag))))) ;; (eq rt-flag std-flag)))))
;; (defun standard-dispatch-macro-char-p (disp-char sub-char rt) ;; (defun standard-dispatch-macro-char-p (disp-char sub-char rt)
;; (flet ((non-terminating-p (ch rt) (nth-value 1 (get-macro-character ch rt)))) ;; (flet ((non-terminating-p (ch rt) (nth-value 1 (get-macro-character ch rt))))
;; (and (eq (non-terminating-p disp-char rt) ;; (and (eq (non-terminating-p disp-char rt)
;; (non-terminating-p disp-char *standard-readtable*)) ;; (non-terminating-p disp-char *standard-readtable*))
;; (eq (get-dispatch-macro-character disp-char sub-char rt) ;; (eq (get-dispatch-macro-character disp-char sub-char rt)
;; (get-dispatch-macro-character disp-char sub-char *standard-readtable*))))) ;; (get-dispatch-macro-character disp-char sub-char *standard-readtable*)))))
;;;; Readtables Iterators ;;;; Readtables Iterators
...@@ -207,7 +207,7 @@ ...@@ -207,7 +207,7 @@
(if (>= idx table-length) (if (>= idx table-length)
(grovel-dispatch-chars) (grovel-dispatch-chars)
(let ((read-fn (svref macro-table idx)) (let ((read-fn (svref macro-table idx))
(oidx idx)) (oidx idx))
(incf idx) (incf idx)
(if (or (eq read-fn #'excl::read-token) (if (or (eq read-fn #'excl::read-token)
(eq read-fn #'excl::read-dispatch-char) (eq read-fn #'excl::read-dispatch-char)
...@@ -243,7 +243,7 @@ ...@@ -243,7 +243,7 @@
"~&~@< ~@;~A has not been ported to ~A. ~ "~&~@< ~@;~A has not been ported to ~A. ~
We fall back to a portable implementation of readtable iterators. ~ We fall back to a portable implementation of readtable iterators. ~
This implementation has to grovel through all available characters. ~ This implementation has to grovel through all available characters. ~
On Unicode-aware implementations this may come with some costs.~@:>" On Unicode-aware implementations this may come with some costs.~@:>"
(package-name '#.*package*) (lisp-implementation-type)))) (package-name '#.*package*) (lisp-implementation-type))))
#-(or sbcl clozure allegro) #-(or sbcl clozure allegro)
...@@ -341,7 +341,7 @@ ...@@ -341,7 +341,7 @@
;;; some point in the future. ;;; some point in the future.
(define-cruft %get-dispatch-macro-character (char subchar rt) (define-cruft %get-dispatch-macro-character (char subchar rt)
"Ensure ANSI behaviour for GET-DISPATCH-MACRO-CHARACTER." "Ensure ANSI behaviour for GET-DISPATCH-MACRO-CHARACTER."
#+ :ccl (ignore-errors #+ :ccl (ignore-errors
(get-dispatch-macro-character char subchar rt)) (get-dispatch-macro-character char subchar rt))
#+ :common-lisp (get-dispatch-macro-character char subchar rt)) #+ :common-lisp (get-dispatch-macro-character char subchar rt))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment