Changeset 9844 for trunk/source/level1/l1closboot.lisp
 Timestamp:
 Jun 27, 2008, 6:28:43 PM (11 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/source/level1/l1closboot.lisp
r9837 r9844 540 540 ;;;;;;;;;;;;;;;;;;;;;;;;;;; defmethod support ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 541 541 542 (%fhave 'functionencapsulation ;Redefined in encapsulate543 (qlfun bootstrappingfunctionencapsulation (name)544 (declare (ignore name))545 nil))546 547 542 (%fhave '%movemethodencapsulationsmaybe ; Redefined in encapsulate 548 543 (qlfun boot%movemethodencapsulationsmaybe (m1 m2) … … 550 545 nil)) 551 546 552 553 547 (%fhave 'findunencapsulateddefinition ;Redefined in encapsulate 554 (qlfun bootstrapping unenecapsulateddef (spec)555 (values 556 (typecase spec 557 (symbol (fboundp spec)) 558 (method (%methodfunction spec))559 (t spec))560 spec)))548 (qlfun bootstrappingfindunencapsulateddefinition (fn) 549 fn)) 550 551 (%fhave 'functionencapsulatedp ;Redefined in encapsulate 552 (qlfun bootstrappingfunctionencapsulatedp (fn) 553 (declare (ignore fn)) 554 nil)) 561 555 562 556 (let* ((classwrapperrandomstate (makerandomstate)) … … 570 564 571 565 (defun %innermethodfunction (method) 572 (let ((f (%methodfunction method))) 573 (when (functionencapsulation f) 574 (setq f (findunencapsulateddefinition f))) 575 (closurefunction f))) 576 566 (closurefunction 567 (findunencapsulateddefinition 568 (%methodfunction method)))) 577 569 578 570 (defun copymethodfunctionbits (from to) … … 711 703 712 704 713 (defun forgetencapsulations (name)714 (declare (ignore name))715 nil)716 717 705 (defun %anonymousmethod (function specializers qualifiers lambdalist &optional documentation 718 706 &aux name methodclass) … … 779 767 (setq methodfunction 780 768 (closurefunction 781 (if (functionencapsulation methodfunction) 782 (findunencapsulateddefinition methodfunction) 783 methodfunction))) 769 (findunencapsulateddefinition methodfunction))) 784 770 (setq methodfunction (requiretype methodfunction 'methodfunction)) 785 771 (lfunname methodfunction)) … … 1096 1082 multimethodindex) 1097 1083 0)) 1098 (let* ((olddcode (%gfdcode gf)) 1099 (encapsulateddcodecons (and (combinedmethodp olddcode) 1100 (eq '%%callgfencapsulation 1101 (functionname (%combinedmethoddcode olddcode))) 1102 (cdr (%combinedmethodmethods olddcode))))) 1103 (when (or nondt (neq dcode (if encapsulateddcodecons (cdr encapsulateddcodecons) olddcode)) 1084 (let* ((olddcode (%gfdcode (findunencapsulateddefinition gf)))) 1085 (when (or nondt 1086 (neq dcode olddcode) 1104 1087 (neq multimethodindex (%gfdispatchtableargnum dt))) 1105 (let* ((proto (if nondt 1106 #'funcallabletrampoline 1107 (or (cdr (assq dcode dcodeprotoalist)) *gfproto*)))) 1108 (cleargfdispatchtable dt) 1109 (setf (%gfdispatchtableargnum dt) multimethodindex) 1110 (if encapsulateddcodecons ; and more? 1111 (let ((oldgf (car encapsulateddcodecons))) 1112 (if (not (typep oldgf 'genericfunction)) 1113 (error "Confused")) 1114 ;(setf (uvref oldgf 0)(uvref proto 0)) 1115 (setf (cdr encapsulateddcodecons) dcode)) 1116 (progn 1117 (setf (%gfdcode gf) dcode) 1118 (replacefunctioncode gf proto)))))) 1088 (cleargfdispatchtable dt) 1089 (setf (%gfdispatchtableargnum dt) multimethodindex) 1090 (if (functionencapsulatedp gf) 1091 (%setencapsulatedgfdcode gf dcode) 1092 (setf (%gfdcode gf) dcode)))) 1119 1093 (values dcode multimethodindex))))) 1120 1094
Note: See TracChangeset
for help on using the changeset viewer.