| 
									
										
										
										
											2010-01-20 06:44:34 -05:00
										 |  |  | ! Copyright (C) 2008, 2010 Doug Coleman, Slava Pestov. | 
					
						
							| 
									
										
										
										
											2008-03-05 22:35:08 -05:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2013-03-05 13:48:14 -05:00
										 |  |  | USING: classes classes.algebra.private classes.predicate | 
					
						
							|  |  |  | classes.predicate.private kernel sequences words ;
 | 
					
						
							| 
									
										
										
										
											2008-04-01 17:51:48 -04:00
										 |  |  | IN: classes.singleton | 
					
						
							| 
									
										
										
										
											2008-03-05 22:35:08 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-20 06:44:34 -05:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-07-17 18:41:33 -04:00
										 |  |  | : singleton-predicate-quot ( class -- quot ) [ eq? ] curry ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-20 06:44:34 -05:00
										 |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											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 ] | 
					
						
							| 
									
										
										
										
											2009-07-17 18:41:33 -04:00
										 |  |  |     [ singleton-predicate-quot ] | 
					
						
							|  |  |  |     bi sequence= ;
 | 
					
						
							| 
									
										
										
										
											2008-04-01 17:46:22 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-02 16:41:29 -04:00
										 |  |  | : define-singleton-class ( word -- )
 | 
					
						
							| 
									
										
										
										
											2009-07-17 18:41:33 -04:00
										 |  |  |     \ word over singleton-predicate-quot 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 ;
 | 
					
						
							| 
									
										
										
										
											2009-07-17 18:41:33 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: singleton-class predicate-quot | 
					
						
							| 
									
										
										
										
											2011-11-22 02:00:52 -05:00
										 |  |  |     singleton-predicate-quot ;
 |