28 lines
		
	
	
		
			770 B
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			28 lines
		
	
	
		
			770 B
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2008, 2010 Doug Coleman, Slava Pestov.
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
USING: classes classes.algebra.private classes.predicate
 | 
						|
classes.predicate.private kernel sequences words ;
 | 
						|
IN: classes.singleton
 | 
						|
 | 
						|
<PRIVATE
 | 
						|
 | 
						|
: singleton-predicate-quot ( class -- quot ) [ eq? ] curry ;
 | 
						|
 | 
						|
PRIVATE>
 | 
						|
 | 
						|
PREDICATE: singleton-class < predicate-class
 | 
						|
    [ "predicate-definition" word-prop ]
 | 
						|
    [ singleton-predicate-quot ]
 | 
						|
    bi sequence= ;
 | 
						|
 | 
						|
: define-singleton-class ( word -- )
 | 
						|
    \ word over singleton-predicate-quot define-predicate-class ;
 | 
						|
 | 
						|
M: singleton-class instance? eq? ;
 | 
						|
 | 
						|
M: singleton-class (classes-intersect?)
 | 
						|
    over singleton-class? [ eq? ] [ call-next-method ] if ;
 | 
						|
 | 
						|
M: singleton-class predicate-quot
 | 
						|
    singleton-predicate-quot ;
 |