2008-03-08 13:01:48 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008 Doug Coleman.
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-05 22:35:08 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-12 02:08:30 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: classes classes.algebra classes.predicate kernel
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								sequences words ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-01 17:51:48 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: classes.singleton
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-05 22:35:08 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-02 16:41:29 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								PREDICATE: singleton-class < predicate-class
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-01 17:46:22 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ "predicate-definition" word-prop ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ [ eq? ] curry ] bi sequence= ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-02 16:41:29 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: define-singleton-class ( word -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    \ word over [ eq? ] curry define-predicate-class ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-29 03:12:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: singleton-class instance? eq? ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-12 02:08:30 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: singleton-class (classes-intersect?)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    over singleton-class? [ eq? ] [ call-next-method ] if ;
							 |