| 
									
										
										
										
											2011-11-22 05:44:58 -05:00
										 |  |  | ! Copyright (C) 2011 Doug Coleman. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2013-03-24 04:10:54 -04:00
										 |  |  | USING: accessors arrays classes classes.algebra | 
					
						
							| 
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 |  |  | classes.algebra.private classes.private classes.union.private | 
					
						
							| 
									
										
										
										
											2013-03-05 13:48:14 -05:00
										 |  |  | kernel words ;
 | 
					
						
							| 
									
										
										
										
											2011-11-22 05:44:58 -05:00
										 |  |  | IN: classes.maybe | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-11-23 04:43:02 -05:00
										 |  |  | ! The class slot has to be a union of a word and a classoid | 
					
						
							| 
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 |  |  | ! for TUPLE: foo { a maybe{ foo } } ; and maybe{ union{ integer float } } | 
					
						
							|  |  |  | ! to work. | 
					
						
							|  |  |  | ! In the first case, foo is not yet a tuple-class when maybe{ is reached, | 
					
						
							| 
									
										
										
										
											2011-11-23 04:43:02 -05:00
										 |  |  | ! thus it's not a classoid yet. union{ is a classoid, so the second case works. | 
					
						
							|  |  |  | ! words are not generally classoids, so classoid alone is insufficient. | 
					
						
							|  |  |  | TUPLE: maybe { class union{ word classoid } initial: object read-only } ;
 | 
					
						
							| 
									
										
										
										
											2011-11-22 05:44:58 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | C: <maybe> maybe | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-11-22 21:49:18 -05:00
										 |  |  | INSTANCE: maybe classoid | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-11-22 05:44:58 -05:00
										 |  |  | M: maybe instance? | 
					
						
							|  |  |  |     over [ class>> instance? ] [ 2drop t ] if ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 |  |  | : maybe-class-or ( maybe -- classoid )
 | 
					
						
							| 
									
										
										
										
											2011-11-22 05:44:58 -05:00
										 |  |  |     class>> \ f class-or ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 |  |  | M: maybe normalize-class | 
					
						
							|  |  |  |     maybe-class-or ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: maybe valid-classoid? class>> valid-classoid? ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-11-22 05:44:58 -05:00
										 |  |  | M: maybe rank-class drop 6 ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: maybe (flatten-class) | 
					
						
							| 
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 |  |  |     maybe-class-or (flatten-class) ;
 | 
					
						
							| 
									
										
										
										
											2011-11-22 05:44:58 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: maybe union-of-builtins? | 
					
						
							|  |  |  |     class>> union-of-builtins? ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 |  |  | M: maybe class-name | 
					
						
							| 
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 |  |  |     class>> class-name ;
 | 
					
						
							| 
									
										
										
										
											2011-11-22 23:38:07 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: maybe predicate-def | 
					
						
							|  |  |  |     class>> predicate-def [ [ t ] if* ] curry ;
 | 
					
						
							| 
									
										
										
										
											2013-03-24 04:10:54 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: maybe classes-contained-by | 
					
						
							|  |  |  |     class>> 1array ;
 |