common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

handle short<->long method combination redefinitions

Browse source 
CHANGE-CLASS, not just REINITIALIZE-INSTANCE
This commit is contained in:
Christophe Rhodes 2018-05-02 14:00:07 +01:00
parent 842ed287cc
commit bcf4dcc084
2 changed files with 34 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/pcl/defcombin.lisp
View file

@ -102,9 +102,9 @@
(short-combine-methods type-name options operator ioa source-location doc))))
(old-info (gethash type-name **method-combinations**)))
(flet ((frobber (mc)
;; KLUDGE: assume the MC is already a short-form MC
(reinitialize-instance mc :operator operator :identity-with-one-argument ioa
'source source-location :documentation doc)))
(change-class mc 'short-method-combination
:operator operator :identity-with-one-argument ioa
'source source-location :documentation doc)))
(update-mcs type-name info old-info #'frobber)))
(setf (random-documentation type-name 'method-combination) doc)
type-name)
@ -185,9 +185,9 @@
:source-location source-location))
(old-info (gethash type-name **method-combinations**)))
(flet ((frobber (mc)
(reinitialize-instance mc :type-name type-name
:args-lambda-list args-lambda-list
'source source-location :documentation doc)))
(change-class mc 'long-method-combination
:type-name type-name :args-lambda-list args-lambda-list
'source source-location :documentation doc)))
(update-mcs type-name info old-info #'frobber)))
(setf (gethash type-name *long-method-combination-functions*) function)
(setf (random-documentation type-name 'method-combination) doc)

37
tests/clos-method-combination-redefinition.impure.lisp
View file

@ -168,13 +168,32 @@
(assert (not (even-as (make-instance 'parse-state :string "abcbabab"))))
(assert (even-as (make-instance 'parse-state :string "abcbabab") :start 'no)))
;;; TODO
;;;
;;; 4. (possibly) move long-method-combination-function into method
;;; combination objects, in which case need to check that existing
;;; method combination objects are updated (currently the method
;;; combination function lives in a global hash table and that is
;;; updated at redefinition time).
;;;
;;; 5. redefinition between short- and long-form method combinations
;;;; changing between short- and long-form method combination
(define-method-combination maximum :operator max)
(defgeneric maxx (x)
(:method-combination maximum)
(:method maximum ((x symbol)) 3)
(:method maximum ((x list)) 4)
(:method maximum ((x null)) 5))
(with-test (:name (:method-combination :maximum))
(assert (= (maxx nil) 5))
(assert (= (maxx '(3 4)) 4))
(assert (= (maxx t) 3)))
(define-method-combination maximum ()
((maximum (maximum)))
`(min ,@(mapcar (lambda (m) `(call-method ,m)) maximum)))
(with-test (:name (:method-combination :maximum :redefined-long))
(assert (= (maxx nil) 3))
(assert (= (maxx '(3 4)) 4))
(assert (= (maxx t) 3)))
(define-method-combination maximum :operator -)
(with-test (:name (:method-combination :maximum :redefined-short))
(assert (= (maxx nil) -2))
(assert (= (maxx '(3 4)) -4))
(assert (= (maxx t) -3)))