| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ! Copyright (C) 2005, 2006 Alex Chapman, Daniel Ehrenberg | 
					
						
							|  |  |  | ! See http;//factorcode.org/license.txt for BSD license | 
					
						
							| 
									
										
										
										
											2008-04-13 01:52:49 -04:00
										 |  |  | USING: kernel sequences math sequences.private strings | 
					
						
							|  |  |  | accessors ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | IN: circular | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! a circular sequence wraps another sequence, but begins at an | 
					
						
							|  |  |  | ! arbitrary element in the underlying sequence. | 
					
						
							|  |  |  | TUPLE: circular seq start ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : <circular> ( seq -- circular )
 | 
					
						
							| 
									
										
										
										
											2008-04-13 16:06:27 -04:00
										 |  |  |     0 circular boa ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-09-15 00:27:37 -04:00
										 |  |  | <PRIVATE
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | : circular-wrap ( n circular -- n circular )
 | 
					
						
							| 
									
										
										
										
											2008-04-13 01:52:49 -04:00
										 |  |  |     [ start>> + ] keep
 | 
					
						
							|  |  |  |     [ seq>> length rem ] keep ; inline
 | 
					
						
							| 
									
										
										
										
											2008-09-15 00:27:37 -04:00
										 |  |  | PRIVATE>
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-13 01:52:49 -04:00
										 |  |  | M: circular length seq>> length ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-13 01:52:49 -04:00
										 |  |  | M: circular virtual@ circular-wrap seq>> ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-13 01:52:49 -04:00
										 |  |  | M: circular virtual-seq seq>> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | : change-circular-start ( n circular -- )
 | 
					
						
							|  |  |  |     #! change start to (start + n) mod length | 
					
						
							| 
									
										
										
										
											2008-04-13 01:52:49 -04:00
										 |  |  |     circular-wrap (>>start) ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : push-circular ( elt circular -- )
 | 
					
						
							| 
									
										
										
										
											2008-04-13 01:52:49 -04:00
										 |  |  |     [ set-first ] [ 1 swap change-circular-start ] bi ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : <circular-string> ( n -- circular )
 | 
					
						
							|  |  |  |     0 <string> <circular> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | INSTANCE: circular virtual-sequence | 
					
						
							| 
									
										
										
										
											2008-05-25 16:19:26 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | TUPLE: growing-circular < circular length ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: growing-circular length length>> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-09-15 00:27:37 -04:00
										 |  |  | <PRIVATE
 | 
					
						
							| 
									
										
										
										
											2008-05-25 16:19:26 -04:00
										 |  |  | : full? ( circular -- ? )
 | 
					
						
							|  |  |  |     [ length ] [ seq>> length ] bi = ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : set-peek ( elt seq -- )
 | 
					
						
							|  |  |  |     [ length 1- ] keep set-nth ;
 | 
					
						
							| 
									
										
										
										
											2008-09-15 00:27:37 -04:00
										 |  |  | PRIVATE>
 | 
					
						
							| 
									
										
										
										
											2008-05-25 16:19:26 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : push-growing-circular ( elt circular -- )
 | 
					
						
							|  |  |  |     dup full? [ push-circular ] | 
					
						
							|  |  |  |     [ [ 1+ ] change-length set-peek ] if ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : <growing-circular> ( capacity -- growing-circular )
 | 
					
						
							|  |  |  |     { } new-sequence 0 0 growing-circular boa ;
 |