Problem using setf find-class to create a class alias for symbol

[Henry Weller]

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:NAMED-LAMBDA (SB-PCL::FAST-METHOD PRINT-SYMBOL (<SYMBOL>))
; (SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. S)
; (DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
; (DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
; (DECLARE (SB-PCL::%METHOD-LAMBDA-LIST (S <SYMBOL>)))
; (DECLARE (SB-PCL::%METHOD-NAME (PRINT-SYMBOL (<SYMBOL>))))
; (DECLARE (TYPE <SYMBOL> S))
; (DECLARE (IGNORABLE S))
; (SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
; (SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS ((S) SB-PCL::.NEXT-METHOD-CALL.
; (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::FAST-METHOD PRINT-SYMBOL (<SYMBOL>))
; :%DEBUG-NAME NIL
; :KIND NIL
; :TYPE #<SB-KERNEL:BUILT-IN-CLASSOID FUNCTION (read-only)>
; :WHERE-FROM :DEFINED
; :VARS (SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. S) {1002BDC271}>
; #: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
                                               {1002ABD151}>:
  unknown type specifier: <SYMBOL>

Type HELP for debugger help, or (SB-EXT:QUIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [ABORT] Exit debugger, returning to top level.

(SB-KERNEL::%%TYPEP HELP #<SB-KERNEL:UNKNOWN-TYPE <SYMBOL>> T)

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.45-0.1-default #1 SMP 2010-02-22 16:49:47 +0100 x86_64 x86_64 x86_64 GNU/Linux
(:ANSI-CL :COMMON-LISP :SBCL :SB-DOC :SB-TEST :SB-LDB :SB-PACKAGE-LOCKS
 :SB-UNICODE :SB-EVAL :SB-SOURCE-LOCATIONS :IEEE-FLOATING-POINT :X86-64 :UNIX
 :ELF :LINUX :SB-THREAD :LARGEFILE :GENCGC :STACK-GROWS-DOWNWARD-NOT-UPWARD
 :C-STACK-IS-CONTROL-STACK :LINKAGE-TABLE :COMPARE-AND-SWAP-VOPS
 :UNWIND-TO-FRAME-AND-CALL-VOP :RAW-INSTANCE-INIT-VOPS
 :STACK-ALLOCATABLE-CLOSURES :STACK-ALLOCATABLE-VECTORS
 :STACK-ALLOCATABLE-LISTS :STACK-ALLOCATABLE-FIXED-OBJECTS :ALIEN-CALLBACKS
 :CYCLE-COUNTER :COMPLEX-FLOAT-VOPS :FLOAT-EQL-VOPS :INLINE-CONSTANTS
 :OS-PROVIDES-DLOPEN :OS-PROVIDES-PUTWC :OS-PROVIDES-SUSECONDS-T)

[Nikodemus Siivola (nikodemus)]

The problem appears to be the (DECLARE (TYPE <SYMBOL> S)) declaration bogusly generated by PCL.

[Christophe Rhodes (csr21-cantab)]

Nikodemus Siivola <email address hidden> writes:

> The problem appears to be the (DECLARE (TYPE <SYMBOL> S)) declaration
> bogusly generated by PCL.

Huh. I was about to complain about the "bogusly" there, but I read in
clhs 4.3.7 that only a class's /proper name/ is valid as a type
declaration (in addition to the class itself). There's loose talk about
"name"s, too, but probably not enough to worry about.

Best,

Christophe

[Nikodemus Siivola (nikodemus)]

In SBCL 1.0.42.9.

[Henry Weller (hweller0)]

Thanks a lot for the fix, I just tested it and it work fine :-)

Henry