Add better error checking for INSTANCE: and GENERIC#, and remove unnecessary word props when generic word's combination changes

db4
Slava Pestov 2009-04-28 17:56:15 -05:00
parent c15a4c1c5a
commit 5b53562c7b
5 changed files with 25 additions and 6 deletions

View File

@ -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

View File

@ -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

View File

@ -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 ]
} }

View File

@ -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

View File

@ -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