| 
									
										
										
										
											2010-01-27 01:28:45 -05:00
										 |  |  | ! Copyright (C) 2008, 2010 Slava Pestov. | 
					
						
							| 
									
										
										
										
											2008-11-29 05:09:16 -05:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2014-12-04 13:23:59 -05:00
										 |  |  | USING: accessors classes.tuple kernel math math.order sequences | 
					
						
							|  |  |  | sequences.private ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | IN: math.ranges | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-06-29 22:37:57 -04:00
										 |  |  | TUPLE: range | 
					
						
							| 
									
										
										
										
											2008-06-30 02:44:58 -04:00
										 |  |  | { from read-only } | 
					
						
							|  |  |  | { length read-only } | 
					
						
							|  |  |  | { step read-only } ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-03-20 18:53:37 -04:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-03-21 11:54:14 -04:00
										 |  |  | : sign/mod ( x y -- z w )
 | 
					
						
							|  |  |  |     [ [ /i ] 2keep pick * - ] keep 0 < [ neg ] when ; inline
 | 
					
						
							| 
									
										
										
										
											2013-03-20 18:53:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-03-20 19:33:01 -04:00
										 |  |  | : <range> ( a b step -- range )
 | 
					
						
							| 
									
										
										
										
											2013-03-20 18:53:37 -04:00
										 |  |  |     [ over - ] dip
 | 
					
						
							|  |  |  |     [ sign/mod 0 < [ 1 + ] unless 0 max ] keep
 | 
					
						
							|  |  |  |     range boa ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-08-17 23:32:21 -04:00
										 |  |  | M: range length ( seq -- n ) length>> ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-03-21 11:54:14 -04:00
										 |  |  | M: range nth-unsafe ( n range -- obj )
 | 
					
						
							|  |  |  |     [ step>> * ] keep from>> + ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-27 01:28:45 -05:00
										 |  |  | ! We want M\ tuple hashcode, not M\ sequence hashcode here! | 
					
						
							|  |  |  | ! sequences hashcode is O(n) in number of elements | 
					
						
							| 
									
										
										
										
											2009-01-29 00:33:26 -05:00
										 |  |  | M: range hashcode* tuple-hashcode ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | INSTANCE: range immutable-sequence | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-05-06 19:01:29 -04:00
										 |  |  | M: range sum [ length ] [ first ] [ last ] tri + * 2 / ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-05-24 22:35:50 -04:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-15 20:44:56 -05:00
										 |  |  | : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-15 20:44:56 -05:00
										 |  |  | : (a, ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-15 20:44:56 -05:00
										 |  |  | : ,b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-05-24 22:35:50 -04:00
										 |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-22 18:38:23 -04:00
										 |  |  | : [a,b] ( a b -- range ) twiddle <range> ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-22 18:38:23 -04:00
										 |  |  | : (a,b] ( a b -- range ) twiddle (a, <range> ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-22 18:38:23 -04:00
										 |  |  | : [a,b) ( a b -- range ) twiddle ,b) <range> ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-22 18:38:23 -04:00
										 |  |  | : (a,b) ( a b -- range ) twiddle (a, ,b) <range> ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-22 18:38:23 -04:00
										 |  |  | : [0,b] ( b -- range ) 0 swap [a,b] ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-22 18:38:23 -04:00
										 |  |  | : [1,b] ( b -- range ) 1 swap [a,b] ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-22 18:38:23 -04:00
										 |  |  | : [0,b) ( b -- range ) 0 swap [a,b) ; inline
 | 
					
						
							| 
									
										
										
										
											2010-01-31 15:46:20 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : [1,b) ( b -- range ) 1 swap [a,b) ; inline
 |