Changeset 14860
 Timestamp:
 Jul 2, 2011, 10:37:33 AM (8 years ago)
 Location:
 trunk/source/level1
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

trunk/source/level1/l1clos.lisp
r14558 r14860 2137 2137 do (noteclassdependent c f))) 2138 2138 (cleargfdispatchtable dt) 2139 (setf (%gfdispatchtableargnum dt) 1) ;mark as nonstandard 2139 (let* ((argnum (%gfdispatchtableargnum dt))) 2140 (unless (< argnum 0) 2141 (setf (%gfdispatchtableargnum dt) (lognot argnum) 2142 (%gfdispatchtablegf dt) (%gfdcode f)))) 2143 2140 2144 (cond ((null (cdr alist)) 2141 2145 ;; Method is only applicable to a single class. … … 2531 2535 ;; Unsnap reader methods, undo other GF optimizations. 2532 2536 (dolist (f (populationdata %allgfs%)) 2533 (let* ((dt (%gfdispatchtable f))) 2534 (cleargfdispatchtable dt) 2535 (computedcode f)))) 2537 (let* ((dt (%gfdispatchtable f)) 2538 (argnum (%gfdispatchtableargnum dt))) 2539 (when (< argnum 0) 2540 (let* ((dcode (%gfdispatchtablegf dt))) 2541 (setf (%gfdispatchtableargnum dt) (lognot argnum) 2542 (%gfdispatchtablegf dt) f 2543 (%gfdcode f) dcode) 2544 (cleargfdispatchtable dt)))))) 2536 2545 2537 2546 ;;; If there's a single method (with standard method combination) on 
trunk/source/level1/l1dcode.lisp
r14558 r14860 182 182 (defun cleargfcache (gf) 183 183 #bccl (unless t (typep gf 'standardgenericfunction) 184 (reportbadarg gf 'standardgenericfunction))184 (reportbadarg gf 'standardgenericfunction)) 185 185 (let ((dt (%gfdispatchtable gf))) 186 (if (eq (%gfdispatchtablesize dt) *mingfdispatchtablesize*) 187 (cleargfdispatchtable dt) 188 (let ((new (makegfdispatchtable))) 189 (setf (%gfdispatchtablemethods new) (%gfdispatchtablemethods dt)) 190 (setf (%gfdispatchtableprecedencelist new) 191 (%gfdispatchtableprecedencelist dt)) 192 (setf (%gfdispatchtablegf new) gf) 193 (setf (%gfdispatchtablekeyvect new) 194 (%gfdispatchtablekeyvect dt)) 195 (setf (%gfdispatchtableargnum new) (%gfdispatchtableargnum dt)) 196 (setf (%gfdispatchtable gf) new))))) 186 (unless (< (%gfdispatchtableargnum dt) 0) ;readermethod optimization 187 (if (eq (%gfdispatchtablesize dt) *mingfdispatchtablesize*) 188 (cleargfdispatchtable dt) 189 (let ((new (makegfdispatchtable))) 190 (setf (%gfdispatchtablemethods new) (%gfdispatchtablemethods dt)) 191 (setf (%gfdispatchtableprecedencelist new) 192 (%gfdispatchtableprecedencelist dt)) 193 (setf (%gfdispatchtablegf new) gf) 194 (setf (%gfdispatchtablekeyvect new) 195 (%gfdispatchtablekeyvect dt)) 196 (setf (%gfdispatchtableargnum new) (%gfdispatchtableargnum dt)) 197 (setf (%gfdispatchtable gf) new)))))) 197 198 198 199 (defun %gfdispatchtablestoreconditional (dt index new)
Note: See TracChangeset
for help on using the changeset viewer.