| 
									
										
										
										
											2008-11-29 05:09:16 -05:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2008-04-26 00:17:08 -04:00
										 |  |  | USING: kernel layouts math math.order namespaces sequences | 
					
						
							| 
									
										
										
										
											2008-04-20 06:15:46 -04:00
										 |  |  | sequences.private accessors ;
 | 
					
						
							| 
									
										
										
										
											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
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-03-20 19:33:01 -04:00
										 |  |  | : <range> ( a b step -- range )
 | 
					
						
							| 
									
										
										
										
											2008-11-29 05:09:16 -05:00
										 |  |  |     [ over - ] dip [ /i 1+ 0 max ] keep range boa ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: range length ( seq -- n )
 | 
					
						
							| 
									
										
										
										
											2008-04-20 06:15:46 -04:00
										 |  |  |     length>> ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: range nth-unsafe ( n range -- obj )
 | 
					
						
							| 
									
										
										
										
											2008-04-20 06:15:46 -04:00
										 |  |  |     [ step>> * ] keep from>> + ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | INSTANCE: range immutable-sequence | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : twiddle 2dup > -1 1 ? ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-30 23:21:37 -05:00
										 |  |  | : (a, dup [ + ] curry 2dip ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-30 23:21:37 -05:00
										 |  |  | : ,b) dup [ - ] curry dip ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											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
 | 
					
						
							| 
									
										
										
										
											2007-10-01 01:08:44 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : range-increasing? ( range -- ? )
 | 
					
						
							| 
									
										
										
										
											2008-04-20 06:15:46 -04:00
										 |  |  |     step>> 0 > ;
 | 
					
						
							| 
									
										
										
										
											2007-10-01 01:08:44 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : range-decreasing? ( range -- ? )
 | 
					
						
							| 
									
										
										
										
											2008-04-20 06:15:46 -04:00
										 |  |  |     step>> 0 < ;
 | 
					
						
							| 
									
										
										
										
											2007-10-01 01:08:44 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : first-or-peek ( seq head? -- elt )
 | 
					
						
							|  |  |  |     [ first ] [ peek ] if ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : range-min ( range -- min )
 | 
					
						
							|  |  |  |     dup range-increasing? first-or-peek ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : range-max ( range -- max )
 | 
					
						
							|  |  |  |     dup range-decreasing? first-or-peek ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : clamp-to-range ( n range -- n )
 | 
					
						
							| 
									
										
										
										
											2008-04-20 07:15:08 -04:00
										 |  |  |     [ range-min max ] [ range-max min ] bi ;
 | 
					
						
							| 
									
										
										
										
											2007-10-01 01:08:44 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : sequence-index-range  ( seq -- range )
 | 
					
						
							|  |  |  |     length [0,b) ;
 |