classes: store implementors in hash-sets.
parent
f2d0752403
commit
f06bfef276
|
@ -3,6 +3,7 @@
|
|||
USING: accessors assocs combinators definitions graphs kernel
|
||||
make namespaces quotations sequences sets words words.symbol ;
|
||||
FROM: namespaces => set ;
|
||||
QUALIFIED: sets
|
||||
IN: classes
|
||||
|
||||
ERROR: bad-inheritance class superclass ;
|
||||
|
@ -133,7 +134,7 @@ GENERIC: implementors ( class/classes -- seq )
|
|||
|
||||
: class-usages ( class -- seq ) [ class-usage ] closure keys ;
|
||||
|
||||
M: class implementors implementors-map get at keys ;
|
||||
M: class implementors implementors-map get at sets:members ;
|
||||
|
||||
M: sequence implementors [ implementors ] gather ;
|
||||
|
||||
|
@ -146,7 +147,7 @@ M: sequence implementors [ implementors ] gather ;
|
|||
dup class-uses update-map get remove-vertex ;
|
||||
|
||||
: implementors-map+ ( class -- )
|
||||
[ H{ } clone ] dip implementors-map get set-at ;
|
||||
[ HS{ } clone ] dip implementors-map get set-at ;
|
||||
|
||||
: implementors-map- ( class -- )
|
||||
implementors-map get delete-at ;
|
||||
|
|
|
@ -140,7 +140,7 @@ M: anonymous-intersection implementor-classes participants>> ;
|
|||
[ swap implementor-classes [ implementors-map get at ] map ] dip call ; inline
|
||||
|
||||
: reveal-method ( method classes generic -- )
|
||||
[ [ [ conjoin ] with each ] with-implementors ]
|
||||
[ [ [ adjoin ] with each ] with-implementors ]
|
||||
[ [ set-at ] with-methods ]
|
||||
2bi ;
|
||||
|
||||
|
@ -176,8 +176,8 @@ M: method forget*
|
|||
] keep eq?
|
||||
[
|
||||
[ [ delete-at ] with-methods ]
|
||||
[ [ [ delete-at ] with each ] with-implementors ] 2bi
|
||||
reset-caches
|
||||
[ [ [ delete ] with each ] with-implementors ]
|
||||
2bi reset-caches
|
||||
] [ 2drop ] if
|
||||
] if
|
||||
]
|
||||
|
|
Loading…
Reference in New Issue