Changeset 10534


Ignore:
Timestamp:
Aug 22, 2008, 2:15:42 PM (11 years ago)
Author:
gb
Message:

Careful with the $lfbits-noname-bit when cloning functions, since
that's also the sign bit on 32-bit lisps.

Support GF class redefinition as done in the trunk (assuming that
I merged in the right CHANGE-CLASS methods.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-clos.lisp

    r10057 r10534  
    364364                                table
    365365                                (dpb 1 $lfbits-numreq
    366                                      (ash 1 $lfbits-noname-bit)))
     366                                     (ash -1 $lfbits-noname-bit)))
    367367              #+x86-target
    368368              (%clone-x86-function (if small
     
    372372                                   table
    373373                                   (dpb 1 $lfbits-numreq
    374                                      (ash 1 $lfbits-noname-bit))))
     374                                     (ash -1 $lfbits-noname-bit))))
    375375             (class (%wrapper-class wrapper))
    376376             (get-f
     
    14461446      (setf (fdefinition function-name) gf))))
    14471447
     1448(defparameter *error-on-gf-class-redefinition* nil
     1449  "The MOP spec requires ENSURE-GENERIC-FUNCTION-USING-CLASS of an
     1450   existing gf to signal an error if the :GENERIC-FUNCTION-CLASS
     1451   argument specifies a class other than the existing gf's class.
     1452   ANSI CL allows this kind of redefinition if the classes are
     1453   \"compatible\", but doesn't define what compatibility means
     1454   in this case.  When *ERROR-ON-GF-CLASS-REDEFINITION* is true,
     1455   a continuable error is signaled.
     1456
     1457   Historically, Clozure CL CERRORed, but didn't offer a useful
     1458   CHANGE-CLASS method that would change the GF's class")
     1459
    14481460(defmethod ensure-generic-function-using-class
    14491461    ((gf generic-function)
     
    14561468      (normalize-egf-keys keys gf)
    14571469    (unless (eq gf-class (class-of gf))
    1458       (cerror (format nil "Change the class of ~s to ~s." gf gf-class)
    1459               "The class of the existing generic function ~s is not ~s"
    1460               gf gf-class)
     1470      (when *error-on-gf-class-redefinition*
     1471        (cerror (format nil "Change the class of ~s to ~s." gf gf-class)
     1472                "The class of the existing generic function ~s is not ~s"
     1473                gf gf-class))
    14611474      (change-class gf gf-class))
    14621475    (apply #'reinitialize-instance gf initargs)))
Note: See TracChangeset for help on using the changeset viewer.