Commit 4381b5b8 authored by David Lichteblau's avatar David Lichteblau

Fix the Allegro port.

darcs-hash:20090427095349-3bbdd-8f4f4b2f6d5fd8cdfe380849f965f551ec79e269.gz
parent e84ed90a
...@@ -72,8 +72,8 @@ ...@@ -72,8 +72,8 @@
;; Kludge: ACL uses keywords to name readtables, we allow ;; Kludge: ACL uses keywords to name readtables, we allow
;; arbitrary symbols. ;; arbitrary symbols.
(intern (format nil "~A.~A" (intern (format nil "~A.~A"
(package-name (symbol-package name)) (package-name (symbol-package symbol))
(symbol-name name)) (symbol-name symbol))
:keyword) :keyword)
(prog1 kwd (prog1 kwd
(assert (or (not status) (get kwd 'named-readtable-designator))) (assert (or (not status) (get kwd 'named-readtable-designator)))
...@@ -81,20 +81,20 @@ ...@@ -81,20 +81,20 @@
(define-cruft %associate-name-with-readtable (name readtable) (define-cruft %associate-name-with-readtable (name readtable)
"Associate NAME with READTABLE for FIND-READTABLE to work." "Associate NAME with READTABLE for FIND-READTABLE to work."
#+ :allegro (setf (named-readtable (readtable-name-for-allegro name)) readtable) #+ :allegro (setf (excl:named-readtable (readtable-name-for-allegro name)) readtable)
#+ :common-lisp (setf (gethash name *named-readtables*) readtable)) #+ :common-lisp (setf (gethash name *named-readtables*) readtable))
(define-cruft %unassociate-name-from-readtable (name readtable) (define-cruft %unassociate-name-from-readtable (name readtable)
"Remove the association between NAME and READTABLE" "Remove the association between NAME and READTABLE"
#+ :allegro (let ((n (readtable-name-for-allegro name))) #+ :allegro (let ((n (readtable-name-for-allegro name)))
(assert (eq readtable (named-readtable n))) (assert (eq readtable (excl:named-readtable n)))
(setf (named-readtable n) nil)) (setf (excl:named-readtable n) nil))
#+ :common-lisp (progn (assert (eq readtable (gethash name *named-readtables*))) #+ :common-lisp (progn (assert (eq readtable (gethash name *named-readtables*)))
(remhash name *named-readtables*))) (remhash name *named-readtables*)))
(define-cruft %find-readtable (name) (define-cruft %find-readtable (name)
"Return the readtable named NAME." "Return the readtable named NAME."
#+ :allegro (named-readtable (readtable-name-for-allegro name)) #+ :allegro (excl:named-readtable (readtable-name-for-allegro name))
#+ :common-lisp (values (gethash name *named-readtables* nil))) #+ :common-lisp (values (gethash name *named-readtables* nil)))
......
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