Fix littledan bug #2

db4
Slava Pestov 2008-01-31 00:49:18 -06:00
parent 0c078d0455
commit 60290fbf52
3 changed files with 15 additions and 5 deletions

View File

@ -255,7 +255,14 @@ PRIVATE>
>r dup word-props r> union over set-word-props
t "class" set-word-prop ;
GENERIC: update-methods ( class -- )
GENERIC: update-predicate ( class -- )
M: class update-predicate drop ;
: update-predicates ( assoc -- )
[ drop update-predicate ] assoc-each ;
GENERIC: update-methods ( assoc -- )
: define-class ( word members superclass metaclass -- )
#! If it was already a class, update methods after.
@ -264,8 +271,9 @@ GENERIC: update-methods ( class -- )
over class-usages [
uncache-classes
dupd (define-class)
] keep cache-classes
r> [ update-methods ] [ drop ] if ;
] keep cache-classes r>
[ class-usages dup update-predicates update-methods ]
[ drop ] if ;
GENERIC: class ( object -- class ) inline

2
core/classes/union/union.factor Normal file → Executable file
View File

@ -20,6 +20,8 @@ PREDICATE: class union-class
over members union-predicate-quot
define-predicate ;
M: union-class update-predicate define-union-predicate ;
: define-union-class ( class members -- )
dupd f union-class define-class define-union-predicate ;

View File

@ -107,5 +107,5 @@ M: class forget* ( class -- )
dup uncache-class
forget-word ;
M: class update-methods ( class -- )
class-usages implementors* [ make-generic ] each ;
M: assoc update-methods ( assoc -- )
implementors* [ make-generic ] each ;