| 
									
										
										
										
											2010-01-20 06:44:34 -05:00
										 |  |  | ! Copyright (C) 2004, 2010 Slava Pestov. | 
					
						
							| 
									
										
										
										
											2008-04-03 22:19:20 -04:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2010-01-31 08:48:39 -05:00
										 |  |  | USING: accessors classes classes.private classes.algebra | 
					
						
							|  |  |  | classes.algebra.private words kernel kernel.private namespaces | 
					
						
							|  |  |  | sequences math math.private combinators assocs quotations ;
 | 
					
						
							| 
									
										
										
										
											2008-04-03 22:19:20 -04:00
										 |  |  | IN: classes.builtin | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: builtins | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | PREDICATE: builtin-class < class | 
					
						
							|  |  |  |     "metaclass" word-prop builtin-class eq? ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-06-29 03:12:44 -04:00
										 |  |  | : class>type ( class -- n ) "type" word-prop ; foldable
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-06 10:16:29 -05:00
										 |  |  | : type>class ( n -- class ) builtins get-global nth ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-03 22:19:20 -04:00
										 |  |  | : bootstrap-type>class ( n -- class ) builtins get nth ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-08-17 23:32:21 -04:00
										 |  |  | M: object class tag type>class ; inline
 | 
					
						
							| 
									
										
										
										
											2008-05-02 03:51:38 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: builtin-class rank-class drop 0 ;
 | 
					
						
							| 
									
										
										
										
											2008-06-29 03:12:44 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-11-02 04:25:39 -05:00
										 |  |  | M: builtin-class instance? [ tag ] [ class>type ] bi* eq? ;
 | 
					
						
							| 
									
										
										
										
											2008-07-05 01:59:39 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: builtin-class (flatten-class) dup set ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: builtin-class (classes-intersect?) | 
					
						
							|  |  |  |     { | 
					
						
							|  |  |  |         { [ 2dup eq? ] [ 2drop t ] } | 
					
						
							|  |  |  |         { [ over builtin-class? ] [ 2drop f ] } | 
					
						
							|  |  |  |         [ swap classes-intersect? ] | 
					
						
							|  |  |  |     } cond ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-11-10 18:41:47 -05:00
										 |  |  | : full-cover ( -- ) builtins get [ (flatten-class) ] each ;
 | 
					
						
							| 
									
										
										
										
											2009-08-07 23:30:57 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: anonymous-complement (flatten-class) drop full-cover ;
 |