steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Forgetting a predicate class now updates predicate-instance? word

db4
Slava Pestov 2009-03-13 04:22:16 -05:00
parent 4c51d8524d
commit a23a6a2870
3 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
core/classes/predicate/predicate-tests.factor
View File

@ -1,4 +1,4 @@
USING: math tools.test classes.algebra ; USING: math tools.test classes.algebra words kernel sequences assocs ;
IN: classes.predicate IN: classes.predicate
PREDICATE: negative < integer 0 < ; PREDICATE: negative < integer 0 < ;
@ -19,3 +19,9 @@ M: positive abs ;
[ 10 ] [ -10 abs ] unit-test [ 10 ] [ -10 abs ] unit-test
[ 10 ] [ 10 abs ] unit-test [ 10 ] [ 10 abs ] unit-test
[ 0 ] [ 0 abs ] unit-test [ 0 ] [ 0 abs ] unit-test
PREDICATE: blah < word blah eq? ;
[ f ] [ \ predicate-instance? "compiled-uses" word-prop keys \ blah swap memq? ] unit-test
FORGET: blah

10
core/classes/predicate/predicate.factor
View File

@ -25,8 +25,9 @@ DEFER: predicate-instance? ( object class -- ? )
: predicate-quot ( class -- quot ) : predicate-quot ( class -- quot )
[ [
\ dup , \ dup ,
dup superclass "predicate" word-prop % [ superclass "predicate" word-prop % ]
"predicate-definition" word-prop , [ drop f ] , \ if , [ "predicate-definition" word-prop , ] bi
[ drop f ] , \ if ,
] [ ] make ; ] [ ] make ;
: define-predicate-class ( class superclass definition -- ) : define-predicate-class ( class superclass definition -- )
@ -42,9 +43,8 @@ DEFER: predicate-instance? ( object class -- ? )
update-predicate-instance ; update-predicate-instance ;
M: predicate-class reset-class M: predicate-class reset-class
[ call-next-method ] [ call-next-method ] [ { "predicate-definition" } reset-props ] bi
[ { "predicate-definition" } reset-props ] update-predicate-instance ;
bi ;
M: predicate-class rank-class drop 1 ; M: predicate-class rank-class drop 1 ;

4
core/classes/union/union-tests.factor
View File

@ -70,10 +70,14 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ;
[ t ] [ "blah" "classes.union.tests" lookup union-class? ] unit-test [ t ] [ "blah" "classes.union.tests" lookup union-class? ] unit-test
[ t ] [ "foo?" "classes.union.tests" lookup predicate? ] unit-test
[ ] [ "IN: classes.union.tests USE: math UNION: blah integer ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test [ ] [ "IN: classes.union.tests USE: math UNION: blah integer ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test
[ t ] [ "blah" "classes.union.tests" lookup union-class? ] unit-test [ t ] [ "blah" "classes.union.tests" lookup union-class? ] unit-test
[ f ] [ "foo?" "classes.union.tests" lookup predicate? ] unit-test
GENERIC: test-generic ( x -- y ) GENERIC: test-generic ( x -- y )
TUPLE: a-tuple ; TUPLE: a-tuple ;