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