Remove predicate-instance? hack; use call( instead
parent
ead3452957
commit
bdec395130
|
@ -140,9 +140,6 @@ bootstrapping? on
|
||||||
"word" "words" create register-builtin
|
"word" "words" create register-builtin
|
||||||
"byte-array" "byte-arrays" create register-builtin
|
"byte-array" "byte-arrays" create register-builtin
|
||||||
|
|
||||||
! For predicate classes
|
|
||||||
"predicate-instance?" "classes.predicate" create drop
|
|
||||||
|
|
||||||
! We need this before defining c-ptr below
|
! We need this before defining c-ptr below
|
||||||
"f" "syntax" lookup { } define-builtin
|
"f" "syntax" lookup { } define-builtin
|
||||||
|
|
||||||
|
|
|
@ -19,9 +19,3 @@ 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
|
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: classes classes.algebra kernel namespaces make words
|
USING: classes classes.algebra kernel namespaces make words
|
||||||
sequences quotations arrays kernel.private assocs combinators ;
|
sequences quotations arrays kernel.private assocs combinators ;
|
||||||
|
@ -7,21 +7,6 @@ IN: classes.predicate
|
||||||
PREDICATE: predicate-class < class
|
PREDICATE: predicate-class < class
|
||||||
"metaclass" word-prop predicate-class eq? ;
|
"metaclass" word-prop predicate-class eq? ;
|
||||||
|
|
||||||
DEFER: predicate-instance? ( object class -- ? )
|
|
||||||
|
|
||||||
: update-predicate-instance ( -- )
|
|
||||||
\ predicate-instance? bootstrap-word
|
|
||||||
classes [ predicate-class? ] filter [
|
|
||||||
[ literalize ]
|
|
||||||
[
|
|
||||||
[ superclass 1array [ declare ] curry ]
|
|
||||||
[ "predicate-definition" word-prop ]
|
|
||||||
bi compose
|
|
||||||
]
|
|
||||||
bi
|
|
||||||
] { } map>assoc [ case ] curry
|
|
||||||
define ;
|
|
||||||
|
|
||||||
: predicate-quot ( class -- quot )
|
: predicate-quot ( class -- quot )
|
||||||
[
|
[
|
||||||
\ dup ,
|
\ dup ,
|
||||||
|
@ -38,19 +23,17 @@ DEFER: predicate-instance? ( object class -- ? )
|
||||||
[ dup predicate-quot define-predicate ]
|
[ dup predicate-quot define-predicate ]
|
||||||
[ update-classes ]
|
[ update-classes ]
|
||||||
bi
|
bi
|
||||||
]
|
] 3tri ;
|
||||||
3tri
|
|
||||||
update-predicate-instance ;
|
|
||||||
|
|
||||||
M: predicate-class reset-class
|
M: predicate-class reset-class
|
||||||
[ call-next-method ] [ { "predicate-definition" } reset-props ] bi
|
[ call-next-method ] [ { "predicate-definition" } reset-props ] bi ;
|
||||||
update-predicate-instance ;
|
|
||||||
|
|
||||||
M: predicate-class rank-class drop 1 ;
|
M: predicate-class rank-class drop 1 ;
|
||||||
|
|
||||||
M: predicate-class instance?
|
M: predicate-class instance?
|
||||||
2dup superclass instance?
|
2dup superclass instance? [
|
||||||
[ predicate-instance? ] [ 2drop f ] if ;
|
"predicate-definition" word-prop call( object -- ? )
|
||||||
|
] [ 2drop f ] if ;
|
||||||
|
|
||||||
M: predicate-class (flatten-class)
|
M: predicate-class (flatten-class)
|
||||||
superclass (flatten-class) ;
|
superclass (flatten-class) ;
|
||||||
|
|
Loading…
Reference in New Issue