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

classes: store implementors in hash-sets.

db4
John Benediktsson 2013-03-08 10:29:50 -08:00
parent f2d0752403
commit f06bfef276
2 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
core/classes/classes.factor
View File

@ -3,6 +3,7 @@
USING: accessors assocs combinators definitions graphs kernel USING: accessors assocs combinators definitions graphs kernel
make namespaces quotations sequences sets words words.symbol ; make namespaces quotations sequences sets words words.symbol ;
FROM: namespaces => set ; FROM: namespaces => set ;
QUALIFIED: sets
IN: classes IN: classes
ERROR: bad-inheritance class superclass ; ERROR: bad-inheritance class superclass ;
@ -133,7 +134,7 @@ GENERIC: implementors ( class/classes -- seq )
: class-usages ( class -- seq ) [ class-usage ] closure keys ; : 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 ; M: sequence implementors [ implementors ] gather ;
@ -146,7 +147,7 @@ M: sequence implementors [ implementors ] gather ;
dup class-uses update-map get remove-vertex ; dup class-uses update-map get remove-vertex ;
: implementors-map+ ( class -- ) : implementors-map+ ( class -- )
[ H{ } clone ] dip implementors-map get set-at ; [ HS{ } clone ] dip implementors-map get set-at ;
: implementors-map- ( class -- ) : implementors-map- ( class -- )
implementors-map get delete-at ; implementors-map get delete-at ;

6
core/generic/generic.factor
View File

@ -140,7 +140,7 @@ M: anonymous-intersection implementor-classes participants>> ;
[ swap implementor-classes [ implementors-map get at ] map ] dip call ; inline [ swap implementor-classes [ implementors-map get at ] map ] dip call ; inline
: reveal-method ( method classes generic -- ) : reveal-method ( method classes generic -- )
[ [ [ conjoin ] with each ] with-implementors ] [ [ [ adjoin ] with each ] with-implementors ]
[ [ set-at ] with-methods ] [ [ set-at ] with-methods ]
2bi ; 2bi ;
@ -176,8 +176,8 @@ M: method forget*
] keep eq? ] keep eq?
[ [
[ [ delete-at ] with-methods ] [ [ delete-at ] with-methods ]
[ [ [ delete-at ] with each ] with-implementors ] 2bi [ [ [ delete ] with each ] with-implementors ]
reset-caches 2bi reset-caches
] [ 2drop ] if ] [ 2drop ] if
] if ] if
] ]