diff --git a/core/classes/classes.factor b/core/classes/classes.factor index ba5b43dc80..9c0398cf61 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -131,6 +131,14 @@ GENERIC: update-methods ( class seq -- ) [ drop update-map+ ] 2tri ; +: forget-predicate ( class -- ) + dup "predicate" word-prop + dup length 1 = [ + first + tuck "predicating" word-prop = + [ forget ] [ drop ] if + ] [ 2drop ] if ; + GENERIC: class ( object -- class ) : instance? ( obj class -- ? ) diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 7bc4c2bb54..8bcbe090b1 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -136,17 +136,16 @@ M: method-body definer M: method-body forget* dup "forgotten" word-prop [ drop ] [ [ - dup "default" word-prop [ call-next-method ] [ - dup - [ "method-class" word-prop ] - [ "method-generic" word-prop ] bi - 3dup method eq? [ - [ delete-at ] with-methods - call-next-method - ] [ 3drop ] if + dup "default" word-prop [ drop ] [ + [ + [ "method-class" word-prop ] + [ "method-generic" word-prop ] bi + 2dup method + ] keep eq? + [ [ delete-at ] with-methods ] [ 2drop ] if ] if ] - [ t "forgotten" set-word-prop ] bi + [ call-next-method ] bi ] if ; M: method-body smart-usage @@ -169,7 +168,7 @@ M: sequence implementors : forget-class ( class -- ) class-usages [ { - [ "predicate" word-prop [ forget ] each ] + [ forget-predicate ] [ forget-methods ] [ update-map- ] [ reset-class ]