Ignore:
Timestamp:
Jul 2, 2011, 10:37:33 AM (9 years ago)
Author:
gb
Message:

In CLEAR-GF-CACHE, don't do anything if the dispatch table's
ARGNUM slot has a negative value.

In %SNAP-READER-METHOD, if the gf's dispatch table's argnum
is non-negative, complement it and store the gf's dcode in
the dt's GENERIC-FUNCTION slot.

In PESSIMIZE-CLOS, if a GF's dispatch-table's argnum is negative,
complement it and set the gf's dcode to the value saved in the
dispatch-table's GENERIC-FUNCTION slot. (We can't use COMPUTE-DCODE
to restore the GF's dcode, since it calls slot accessors, possibly
including the one that we're modifying in a non-atomic way.)

It's not clear that PESSIMIZE-CLOS has to deal with anything but
snapped reader methods; DCODE-FOR-UNIVERSALLY-APPLICABLE-SINGLETON
looks like it was half-finished. If we do things like that, we may
need to adopt and follow similar conventions to allow it to be undone,

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos.lisp

    r14558 r14860  
    21372137                        do (note-class-dependent c f)))
    21382138                (clear-gf-dispatch-table dt)
    2139                 (setf (%gf-dispatch-table-argnum dt) -1) ;mark as non-standard
     2139                (let* ((argnum (%gf-dispatch-table-argnum dt)))
     2140                  (unless (< argnum 0)
     2141                    (setf (%gf-dispatch-table-argnum dt) (lognot argnum)
     2142                          (%gf-dispatch-table-gf dt) (%gf-dcode f))))
     2143                   
    21402144                (cond ((null (cdr alist))
    21412145                       ;; Method is only applicable to a single class.
     
    25312535  ;; Un-snap reader methods, undo other GF optimizations.
    25322536  (dolist (f (population-data %all-gfs%))
    2533     (let* ((dt (%gf-dispatch-table f)))
    2534       (clear-gf-dispatch-table dt)
    2535       (compute-dcode f))))
     2537    (let* ((dt (%gf-dispatch-table f))
     2538           (argnum (%gf-dispatch-table-argnum dt)))
     2539      (when (< argnum 0)
     2540        (let* ((dcode (%gf-dispatch-table-gf dt)))
     2541          (setf (%gf-dispatch-table-argnum dt) (lognot argnum)
     2542                (%gf-dispatch-table-gf dt) f
     2543                (%gf-dcode f) dcode)
     2544        (clear-gf-dispatch-table dt))))))
    25362545
    25372546;;; If there's a single method (with standard method combination) on
Note: See TracChangeset for help on using the changeset viewer.