2008-06-13 02:51:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: locals sequences kernel math ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: sorting.insertion
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							
								
									
										
										
										
											2010-03-09 02:38:10 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								:: insert ( ... seq quot: ( ... elt -- ... elt' ) n -- ... )
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 02:51:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    n zero? [
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-13 20:21:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        n n 1 - [ seq nth quot call ] bi@ >= [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            n n 1 - seq exchange
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            seq quot n 1 - insert
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 02:51:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] unless
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-18 20:22:59 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] unless ; inline recursive
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 02:51:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-22 20:19:51 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: insertion-sort ( ... seq quot: ( ... elt -- ... elt' ) -- ... )
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 02:51:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ! quot is a transformation on elements
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-14 10:10:13 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    over length [ insert ] with with each-integer ; inline
							 |