Problem using setf find-class to create a class alias for symbol
Affects | Status | Importance | Assigned to | Milestone | |
---|---|---|---|---|---|
SBCL |
Fix Released
|
Medium
|
Unassigned |
Bug Description
The code:
(defvar new-symbol (intern "<SYMBOL>"))
(setf (find-class '<symbol>) (find-class 'symbol))
(describe '<symbol>)
(defmethod print-symbol ((s <symbol>))
(print s))
(print-symbol 'help)
does not compile or run correctly because <symbol> does not appear to inherit
all the necessary properties of symbol:
CL-USER> (defvar new-symbol (intern "<SYMBOL>"))
(setf (find-class '<symbol>) (find-class 'symbol))
NEW-SYMBOL
CL-USER> (defmethod print-symbol ((s <symbol>))
(print s))
#<BUILT-IN-CLASS SYMBOL>
CL-USER> (print-symbol 'help)
;
; caught STYLE-WARNING:
; undefined type: <SYMBOL>
; in: LAMBDA NIL
; (SB-INT:
; (SB-PCL::.PV. SB-PCL:
; (DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL:
; (DISABLE-
; (DECLARE (SB-PCL:
; (DECLARE (SB-PCL:
; (DECLARE (TYPE <SYMBOL> S))
; (DECLARE (IGNORABLE S))
; (SYMBOL-MACROLET ((SB-PCL:
; (SB-PCL:
; (S) NIL :CALL-NEXT-METHOD-P NIL
; :NEXT-METHOD-P-P NIL :SETQ-P NIL
; :METHOD-CELL (#:METHOD-CELL) ...)
; (DECLARE (SB-PCL::%CLASS S <SYMBOL>))
; (LOCALLY
; (DECLARE #)
; (SYMBOL-MACROLET #
; #
; #)))))
; --> FUNCTION LOCALLY
; ==>
; (SB-C::%FUNCALL
; #<SB-C::CLAMBDA
; :%SOURCE-NAME (SB-PCL:
; :%DEBUG-NAME NIL
; :KIND NIL
; :TYPE #<SB-KERNEL:
; :WHERE-FROM :DEFINED
; :VARS (SB-PCL::.PV. SB-PCL:
; #:G2 #:G3 #:G4)
;
; caught STYLE-WARNING:
; undefined type: <SYMBOL>
; (TYPE <SYMBOL> S)
;
; caught STYLE-WARNING:
; undefined type: <SYMBOL>
;
; caught STYLE-WARNING:
; 8 more uses of undefined type <SYMBOL>
;
; compilation unit finished
; Undefined type:
; <SYMBOL>
; caught 4 STYLE-WARNING conditions
STYLE-WARNING: Implicitly creating new generic function PRINT-SYMBOL.
#<STANDARD-METHOD PRINT-SYMBOL (SYMBOL) {1002C514F1}>
CL-USER>
debugger invoked on a SIMPLE-ERROR in thread #<THREAD "initial thread" RUNNING
unknown type specifier: <SYMBOL>
Type HELP for debugger help, or (SB-EXT:QUIT) to exit from SBCL.
restarts (invokable by number or by possibly-
0: [ABORT] Exit debugger, returning to top level.
(SB-KERNEL::%%TYPEP HELP #<SB-KERNEL:
There appears to be special handling for the symbol system class which setq
find-class is not handling correctly. When the same form of code is used to
create a class alias for string it works correctly:
(defvar new-string (intern "<STRING>"))
(setf (find-class '<string>) (find-class 'string))
(describe '<string>)
(defmethod print-string ((s <string>))
(print s))
(print-string "help")
CL-USER> (defvar new-string (intern "<STRING>"))
(setf (find-class '<string>) (find-class 'string))
NEW-STRING
CL-USER> (defmethod print-string ((s <string>))
(print s))
(print-string "help")
#<BUILT-IN-CLASS STRING>
CL-USER> STYLE-WARNING: Implicitly creating new generic function PRINT-STRING.
#<STANDARD-METHOD PRINT-STRING (STRING) {1002C25891}>
CL-USER>
"help"
"help"
CL-USER>
Is there some way to work around this issue or perhaps a more portable way to
create class aliases of this form?
Further tests have shown that the symbol alias code compiles and executes correctly with CMUCL version 20a, CLISP version 2.47+ and Allegro version 8.2.
System information:
-------
SBCL 1.0.40.1
Linux dm 2.6.27.
(:ANSI-CL :COMMON-LISP :SBCL :SB-DOC :SB-TEST :SB-LDB :SB-PACKAGE-LOCKS
:SB-UNICODE :SB-EVAL :SB-SOURCE-
:ELF :LINUX :SB-THREAD :LARGEFILE :GENCGC :STACK-
:C-STACK-
:UNWIND-
:STACK-
:STACK-
:CYCLE-COUNTER :COMPLEX-FLOAT-VOPS :FLOAT-EQL-VOPS :INLINE-CONSTANTS
:OS-PROVIDES-
Changed in sbcl: | |
status: | Triaged → In Progress |
assignee: | nobody → Nikodemus Siivola (nikodemus) |
Changed in sbcl: | |
assignee: | Nikodemus Siivola (nikodemus) → nobody |
Changed in sbcl: | |
status: | Fix Committed → Fix Released |
The problem appears to be the (DECLARE (TYPE <SYMBOL> S)) declaration bogusly generated by PCL.