| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ! Copyright (C) 2007 Daniel Ehrenberg. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2008-06-09 06:22:21 -04:00
										 |  |  | USING: splitting grouping classes.tuple classes math kernel | 
					
						
							|  |  |  | sequences arrays ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | IN: tuple-arrays | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | TUPLE: tuple-array example ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : prepare-example ( tuple -- seq n )
 | 
					
						
							|  |  |  |     dup class over delegate [ 1array ] [ f 2array ] if
 | 
					
						
							|  |  |  |     swap tuple>array length over length - ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : <tuple-array> ( length example -- tuple-array )
 | 
					
						
							| 
									
										
										
										
											2008-04-13 23:58:07 -04:00
										 |  |  |     prepare-example [ rot * { } new-sequence ] keep
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     <sliced-groups> tuple-array construct-delegate | 
					
						
							|  |  |  |     [ set-tuple-array-example ] keep ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : reconstruct ( seq example -- tuple )
 | 
					
						
							| 
									
										
										
										
											2008-03-19 20:15:32 -04:00
										 |  |  |     prepend >tuple ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: tuple-array nth | 
					
						
							|  |  |  |     [ delegate nth ] keep
 | 
					
						
							|  |  |  |     tuple-array-example reconstruct ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : deconstruct ( tuple example -- seq )
 | 
					
						
							|  |  |  |     >r tuple>array r> length tail-slice ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: tuple-array set-nth ( elt n seq -- )
 | 
					
						
							|  |  |  |     tuck >r >r tuple-array-example deconstruct r> r> | 
					
						
							|  |  |  |     delegate set-nth ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-14 04:03:49 -04:00
										 |  |  | M: tuple-array new-sequence tuple-array-example >tuple <tuple-array> ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : >tuple-array ( seq -- tuple-array/seq )
 | 
					
						
							|  |  |  |     dup empty? [ | 
					
						
							|  |  |  |         0 over first <tuple-array> clone-like
 | 
					
						
							|  |  |  |     ] unless ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: tuple-array like  | 
					
						
							|  |  |  |     drop dup tuple-array? [ >tuple-array ] unless ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | INSTANCE: tuple-array sequence |