diff --git a/core/classes/mixin/mixin-tests.factor b/core/classes/mixin/mixin-tests.factor index cd11591d6c..f44642fdd5 100644 --- a/core/classes/mixin/mixin-tests.factor +++ b/core/classes/mixin/mixin-tests.factor @@ -119,3 +119,13 @@ MIXIN: move-instance-declaration-mixin [ ] [ "IN: classes.mixin.tests.a" "move-mixin-test-1" parse-stream drop ] unit-test [ { string } ] [ move-instance-declaration-mixin members ] unit-test + +MIXIN: silly-mixin +SYMBOL: not-a-class + +[ [ \ not-a-class \ silly-mixin add-mixin-instance ] with-compilation-unit ] must-fail + +SYMBOL: not-a-mixin +TUPLE: a-class ; + +[ [ \ a-class \ not-a-mixin add-mixin-instance ] with-compilation-unit ] must-fail diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 4bdb893d9a..6cf95716be 100644 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -50,7 +50,9 @@ TUPLE: check-mixin-class class ; [ [ f ] 2dip "instances" word-prop set-at ] 2bi ; -: add-mixin-instance ( class mixin -- ) +GENERIC# add-mixin-instance 1 ( class mixin -- ) + +M: class add-mixin-instance #! Note: we call update-classes on the new member, not the #! mixin. This ensures that we only have to update the #! methods whose specializer intersects the new member, not diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 965be91642..4b398f6532 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -164,8 +164,8 @@ M: sequence update-methods ( class seq -- ) drop 2dup [ "combination" word-prop ] dip = [ 2drop ] [ { + [ drop reset-generic ] [ "combination" set-word-prop ] - [ drop "methods" word-prop values forget-all ] [ drop H{ } clone "methods" set-word-prop ] [ define-default-method ] } diff --git a/core/generic/single/single-tests.factor b/core/generic/single/single-tests.factor index 8245cbe22f..c8cab970fd 100644 --- a/core/generic/single/single-tests.factor +++ b/core/generic/single/single-tests.factor @@ -4,7 +4,7 @@ generic.single strings sequences arrays kernel accessors words specialized-arrays.double byte-arrays bit-arrays parser namespaces make quotations stack-checker vectors growable hashtables sbufs prettyprint byte-vectors bit-vectors specialized-vectors.double -definitions generic sets graphs assocs grouping see ; +definitions generic sets graphs assocs grouping see eval ; GENERIC: lo-tag-test ( obj -- obj' ) @@ -269,3 +269,9 @@ M: growable call-next-hooker call-next-method "growable " prepend ; [ t ] [ \ + \ nth effective-method nip dup \ nth "default-method" word-prop eq? and ] unit-test + +[ ] [ "IN: generic.single.tests GENERIC: xyz ( a -- b )" eval( -- ) ] unit-test +[ ] [ "IN: generic.single.tests MATH: xyz ( a b -- c )" eval( -- ) ] unit-test + +[ f ] [ "xyz" "generic.single.tests" lookup direct-entry-def>> ] unit-test +[ f ] [ "xyz" "generic.single.tests" lookup "decision-tree" word-prop ] unit-test \ No newline at end of file diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index bf8ea8da08..6e2c80a2ce 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -1,12 +1,14 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors definitions generic generic.single kernel -namespaces words math combinators sequences ; +namespaces words math math.order combinators sequences ; IN: generic.standard TUPLE: standard-combination < single-combination # ; -C: standard-combination +: ( n -- standard-combination ) + dup 0 2 between? [ "Bad dispatch position" throw ] unless + standard-combination boa ; PREDICATE: standard-generic < generic "combination" word-prop standard-combination? ; @@ -24,7 +26,6 @@ CONSTANT: simple-combination T{ standard-combination f 0 } { 0 [ [ dup ] ] } { 1 [ [ over ] ] } { 2 [ [ pick ] ] } - [ 1- (picker) [ dip swap ] curry ] } case ; M: standard-combination picker