Changeset 7983


Ignore:
Timestamp:
Jan 1, 2008, 2:34:21 AM (12 years ago)
Author:
gb
Message:

Be sure that UPDATE-CPL returns the CPL; some early/low-level classes
weren't geting their wrapper's CPL set.

Provide a mechanism for registering alternate dcode-generating functions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/1.2-devel/ccl/level-1/l1-clos.lisp

    r7946 r7983  
    548548      (setf (%class.cpl class) cpl)
    549549      #|(force-cache-flushes class)|#)
    550     (setf (%class.cpl class) cpl)))
     550    (setf (%class.cpl class) cpl))
     551  cpl)
    551552
    552553
     
    10981099                  :initfunction ,#'false :readers (slot-definition-writers))))
    10991100
     1101
    11001102(%ensure-class-preserving-wrapper
    11011103 'effective-slot-definition
     
    11271129 :direct-superclasses '(standard-slot-definition direct-slot-definition)
    11281130)
     1131
    11291132
    11301133(%ensure-class-preserving-wrapper
     
    21772180    (values ngf nwin 0)))
    21782181
     2182(defun register-non-dt-dcode-function (f)
     2183  (flet ((symbol-or-function-name (x)
     2184           (etypecase x
     2185             (symbol x)
     2186             (function (function-name x)))))
     2187    (let* ((already (member (symbol-or-function-name f) *non-dt-dcode-functions* :key #'symbol-or-function-name)))
     2188      (if already
     2189        (setf (car already) f)
     2190        (push f *non-dt-dcode-functions*))
     2191      f)))
     2192
     2193(defun dcode-for-universally-applicable-singleton (gf)
     2194  (let* ((methods (generic-function-methods gf))
     2195         (method (car methods)))
     2196    (when (and method
     2197               (null (cdr methods))
     2198               (null (method-qualifiers method))
     2199               (dolist (spec (method-specializers method) t)
     2200                 (unless (eq spec *t-class*)
     2201                   (return nil))))
     2202      (method-function method))))
     2203
     2204(register-non-dt-dcode-function #'dcode-for-universally-applicable-singleton)
     2205
     2206
     2207
     2208
     2209     
Note: See TracChangeset for help on using the changeset viewer.