2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2011 Doug Coleman.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: classes.maybe eval generic.single kernel tools.test
							 | 
						
					
						
							
								
									
										
										
										
											2013-03-22 18:58:20 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								math classes accessors slots classes.algebra
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								classes.algebra.private ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: classes.maybe.tests
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ t } [ 3 maybe{ integer } instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ t } [ f maybe{ integer } instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ f } [ 3.0 maybe{ integer } instance? ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								TUPLE: maybe-integer-container { something maybe{ integer } } ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ f } [ maybe-integer-container new something>> ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ 3 } [ maybe-integer-container new 3 >>something something>> ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ maybe-integer-container new 3.0 >>something ] [ bad-slot-value? ] must-fail-with
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								TUPLE: self-pointer { next maybe{ self-pointer } } ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ T{ self-pointer { next T{ self-pointer } } } }
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ self-pointer new self-pointer new >>next ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ t } [ f maybe{ POSTPONE: f } instance? ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								PREDICATE: natural < maybe{ integer }
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    0 > ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ f } [ -1 natural? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ f } [ 0 natural? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ t } [ 1 natural? ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ t } [ f maybe{ maybe{ integer } } instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ t } [ 3 maybe{ maybe{ integer } } instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ f } [ 3.03 maybe{ maybe{ integer } } instance? ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								INTERSECTION: only-f maybe{ integer } POSTPONE: f ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ t } [ f only-f instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ f } [ t only-f instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ f } [ 30 only-f instance? ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								UNION: ?integer-float maybe{ integer } maybe{ float } ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ t } [ 30 ?integer-float instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ t } [ 30.0 ?integer-float instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ t } [ f ?integer-float instance? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ f } [ t ?integer-float instance? ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: foo ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								GENERIC: lol ( obj -- string )
							 | 
						
					
						
							
								
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: maybe{ foo } lol drop "lol" ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "lol" } [ foo new lol ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ "lol" } [ f lol ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ 3 lol ] [ no-method? ] must-fail-with
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: foo2 a ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								GENERIC: lol2 ( obj -- string )
							 | 
						
					
						
							
								
									
										
										
										
											2012-05-03 22:17:41 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: maybe{ foo } lol2 drop "lol2" ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: f lol2 drop "lol22" ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "lol2" } [ foo new lol2 ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ "lol22" } [ f lol2 ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-11-22 17:47:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ 3 lol2 ] [ no-method? ] must-fail-with
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 20:28:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ t } [ \ + <maybe> classoid? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ f } [ \ + <maybe> valid-classoid? ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2013-03-22 18:58:20 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "IN: classes-tests maybe{ 1 2 3 }" eval( -- ) ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ error>> not-classoids? ] must-fail-with
							 |