33 lines
		
	
	
		
			941 B
		
	
	
	
		
			Factor
		
	
	
		
			Executable File
		
	
			
		
		
	
	
			33 lines
		
	
	
		
			941 B
		
	
	
	
		
			Factor
		
	
	
		
			Executable File
		
	
| ! Copyright (C) 2004, 2008 Slava Pestov.
 | |
| ! See http://factorcode.org/license.txt for BSD license.
 | |
| USING: words sequences kernel assocs combinators classes
 | |
| namespaces arrays math quotations ;
 | |
| IN: classes.union
 | |
| 
 | |
| PREDICATE: union-class < class
 | |
|     "metaclass" word-prop union-class eq? ;
 | |
| 
 | |
| ! Union classes for dispatch on multiple classes.
 | |
| : union-predicate-quot ( members -- quot )
 | |
|     dup empty? [
 | |
|         drop [ drop f ]
 | |
|     ] [
 | |
|         unclip "predicate" word-prop swap [
 | |
|             "predicate" word-prop [ dup ] prepend
 | |
|             [ drop t ]
 | |
|         ] { } map>assoc alist>quot
 | |
|     ] if ;
 | |
| 
 | |
| : define-union-predicate ( class -- )
 | |
|     dup members union-predicate-quot define-predicate ;
 | |
| 
 | |
| M: union-class update-class define-union-predicate ;
 | |
| 
 | |
| : define-union-class ( class members -- )
 | |
|     [ f swap union-class define-class ]
 | |
|     [ drop update-classes ]
 | |
|     2bi ;
 | |
| 
 | |
| M: union-class reset-class
 | |
|     { "class" "metaclass" "members" } reset-props ;
 |