| 
									
										
										
										
											2016-03-30 23:04:14 -04:00
										 |  |  | USING: accessors combinators.short-circuit kernel math | 
					
						
							|  |  |  | tools.test ;
 | 
					
						
							| 
									
										
										
										
											2008-06-24 11:40:27 -04:00
										 |  |  | IN: combinators.short-circuit.tests | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { 3 } [ { [ 1 ] [ 2 ] [ 3 ] } 0&& ] unit-test | 
					
						
							|  |  |  | { 5 } [ 3 { [ 0 > ] [ odd? ] [ 2 + ] } 1&& ] unit-test | 
					
						
							|  |  |  | { 30 } [ 10 20 { [ + 0 > ] [ - even? ] [ + ] } 2&& ] unit-test | 
					
						
							| 
									
										
										
										
											2008-06-24 11:40:27 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { f } [ { [ 1 ] [ f ] [ 3 ] } 0&& ] unit-test | 
					
						
							|  |  |  | { f } [ 3 { [ 0 > ] [ even? ] [ 2 + ] } 1&& ] unit-test | 
					
						
							|  |  |  | { f } [ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } 2&& ] unit-test | 
					
						
							| 
									
										
										
										
											2008-06-24 11:40:27 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { "factor" } [ { [ 10 0 < ] [ f ] [ "factor" ] } 0|| ] unit-test | 
					
						
							|  |  |  | { 11 } [ 10 { [ odd? ] [ 100 > ] [ 1 + ] } 1|| ] unit-test | 
					
						
							|  |  |  | { 30 } [ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } 2|| ] unit-test | 
					
						
							|  |  |  | { f } [ { [ 10 0 < ] [ f ] [ 0 1 = ] } 0|| ] unit-test | 
					
						
							| 
									
										
										
										
											2008-06-24 11:40:27 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-07-18 07:38:34 -04:00
										 |  |  | : compiled-&& ( a -- ? ) { [ 0 > ] [ even? ] [ 2 + ] } 1&& ;
 | 
					
						
							| 
									
										
										
										
											2008-06-24 11:40:27 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { f } [ 3 compiled-&& ] unit-test | 
					
						
							|  |  |  | { 4 } [ 2 compiled-&& ] unit-test | 
					
						
							| 
									
										
										
										
											2008-06-24 11:40:27 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-07-18 07:38:34 -04:00
										 |  |  | : compiled-|| ( a b -- ? ) { [ + odd? ] [ + 100 > ] [ + ] } 2|| ;
 | 
					
						
							| 
									
										
										
										
											2008-06-24 11:40:27 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { 30 } [ 10 20 compiled-|| ] unit-test | 
					
						
							|  |  |  | { 2 } [ 1 1 compiled-|| ] unit-test | 
					
						
							| 
									
										
										
										
											2010-02-08 20:32:53 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | ! && and || should be row-polymorphic both when compiled and when interpreted | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : row-&& ( -- ? )
 | 
					
						
							|  |  |  |     f t { [ drop dup ] } 1&& nip ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { f } [ row-&& ] unit-test | 
					
						
							|  |  |  | { f } [ \ row-&& def>> call ] unit-test | 
					
						
							| 
									
										
										
										
											2010-02-08 20:32:53 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : row-|| ( -- ? )
 | 
					
						
							|  |  |  |     f t { [ drop dup ] } 1|| nip ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { f } [ row-|| ] unit-test | 
					
						
							|  |  |  | { f } [ \ row-|| def>> call ] unit-test |