Add better error checking for INSTANCE: and GENERIC#, and remove unnecessary word props when generic word's combination changes
parent
c15a4c1c5a
commit
5b53562c7b
|
@ -119,3 +119,13 @@ MIXIN: move-instance-declaration-mixin
|
||||||
[ ] [ "IN: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
|
[ ] [ "IN: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
|
||||||
|
|
||||||
[ { string } ] [ move-instance-declaration-mixin members ] 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
|
||||||
|
|
|
@ -50,7 +50,9 @@ TUPLE: check-mixin-class class ;
|
||||||
[ [ f ] 2dip "instances" word-prop set-at ]
|
[ [ f ] 2dip "instances" word-prop set-at ]
|
||||||
2bi ;
|
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
|
#! Note: we call update-classes on the new member, not the
|
||||||
#! mixin. This ensures that we only have to update the
|
#! mixin. This ensures that we only have to update the
|
||||||
#! methods whose specializer intersects the new member, not
|
#! methods whose specializer intersects the new member, not
|
||||||
|
|
|
@ -164,8 +164,8 @@ M: sequence update-methods ( class seq -- )
|
||||||
drop
|
drop
|
||||||
2dup [ "combination" word-prop ] dip = [ 2drop ] [
|
2dup [ "combination" word-prop ] dip = [ 2drop ] [
|
||||||
{
|
{
|
||||||
|
[ drop reset-generic ]
|
||||||
[ "combination" set-word-prop ]
|
[ "combination" set-word-prop ]
|
||||||
[ drop "methods" word-prop values forget-all ]
|
|
||||||
[ drop H{ } clone "methods" set-word-prop ]
|
[ drop H{ } clone "methods" set-word-prop ]
|
||||||
[ define-default-method ]
|
[ define-default-method ]
|
||||||
}
|
}
|
||||||
|
|
|
@ -4,7 +4,7 @@ generic.single strings sequences arrays kernel accessors words
|
||||||
specialized-arrays.double byte-arrays bit-arrays parser namespaces
|
specialized-arrays.double byte-arrays bit-arrays parser namespaces
|
||||||
make quotations stack-checker vectors growable hashtables sbufs
|
make quotations stack-checker vectors growable hashtables sbufs
|
||||||
prettyprint byte-vectors bit-vectors specialized-vectors.double
|
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' )
|
GENERIC: lo-tag-test ( obj -- obj' )
|
||||||
|
|
||||||
|
@ -269,3 +269,9 @@ M: growable call-next-hooker call-next-method "growable " prepend ;
|
||||||
[ t ] [
|
[ t ] [
|
||||||
\ + \ nth effective-method nip dup \ nth "default-method" word-prop eq? and
|
\ + \ nth effective-method nip dup \ nth "default-method" word-prop eq? and
|
||||||
] unit-test
|
] 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
|
|
@ -1,12 +1,14 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors definitions generic generic.single kernel
|
USING: accessors definitions generic generic.single kernel
|
||||||
namespaces words math combinators sequences ;
|
namespaces words math math.order combinators sequences ;
|
||||||
IN: generic.standard
|
IN: generic.standard
|
||||||
|
|
||||||
TUPLE: standard-combination < single-combination # ;
|
TUPLE: standard-combination < single-combination # ;
|
||||||
|
|
||||||
C: <standard-combination> standard-combination
|
: <standard-combination> ( n -- standard-combination )
|
||||||
|
dup 0 2 between? [ "Bad dispatch position" throw ] unless
|
||||||
|
standard-combination boa ;
|
||||||
|
|
||||||
PREDICATE: standard-generic < generic
|
PREDICATE: standard-generic < generic
|
||||||
"combination" word-prop standard-combination? ;
|
"combination" word-prop standard-combination? ;
|
||||||
|
@ -24,7 +26,6 @@ CONSTANT: simple-combination T{ standard-combination f 0 }
|
||||||
{ 0 [ [ dup ] ] }
|
{ 0 [ [ dup ] ] }
|
||||||
{ 1 [ [ over ] ] }
|
{ 1 [ [ over ] ] }
|
||||||
{ 2 [ [ pick ] ] }
|
{ 2 [ [ pick ] ] }
|
||||||
[ 1- (picker) [ dip swap ] curry ]
|
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
M: standard-combination picker
|
M: standard-combination picker
|
||||||
|
|
Loading…
Reference in New Issue