| 
									
										
										
										
											2008-03-26 19:23:19 -04:00
										 |  |  | ! Copyright (C) 2004, 2008 Slava Pestov. | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: classes kernel namespaces words ;
 | 
					
						
							|  |  |  | IN: classes.predicate | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-03-26 19:23:19 -04:00
										 |  |  | PREDICATE: predicate-class < class | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     "metaclass" word-prop predicate-class eq? ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : predicate-quot ( class -- quot )
 | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         \ dup , | 
					
						
							|  |  |  |         dup superclass "predicate" word-prop % | 
					
						
							|  |  |  |         "predicate-definition" word-prop , [ drop f ] , \ if , | 
					
						
							|  |  |  |     ] [ ] make ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-03-26 19:23:19 -04:00
										 |  |  | : define-predicate-class ( class superclass definition -- )
 | 
					
						
							| 
									
										
										
										
											2008-04-02 03:44:10 -04:00
										 |  |  |     [ drop f predicate-class define-class ] | 
					
						
							|  |  |  |     [ nip "predicate-definition" set-word-prop ] | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         2drop
 | 
					
						
							|  |  |  |         [ dup predicate-quot define-predicate ] | 
					
						
							|  |  |  |         [ update-classes ] | 
					
						
							|  |  |  |         bi
 | 
					
						
							|  |  |  |     ] 3tri ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: predicate-class reset-class | 
					
						
							|  |  |  |     { | 
					
						
							| 
									
										
										
										
											2008-04-03 01:21:53 -04:00
										 |  |  |         "class" | 
					
						
							|  |  |  |         "metaclass" | 
					
						
							|  |  |  |         "predicate-definition" | 
					
						
							|  |  |  |         "superclass" | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     } reset-props ;
 |