| 
									
										
										
										
											2009-01-13 18:12:43 -05:00
										 |  |  | ! Copyright (C) 2008, 2009 Slava Pestov. | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: kernel sequences sequences.private arrays vectors fry | 
					
						
							| 
									
										
										
										
											2009-01-13 18:12:43 -05:00
										 |  |  | math.order namespaces assocs ;
 | 
					
						
							| 
									
										
										
										
											2008-12-06 12:17:19 -05:00
										 |  |  | IN: compiler.utilities | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : flattener ( seq quot -- seq vector quot' )
 | 
					
						
							|  |  |  |     over length <vector> [ | 
					
						
							|  |  |  |         dup
 | 
					
						
							|  |  |  |         '[ | 
					
						
							|  |  |  |             @ [ | 
					
						
							|  |  |  |                 dup array?
 | 
					
						
							|  |  |  |                 [ _ push-all ] [ _ push ] if
 | 
					
						
							|  |  |  |             ] when*
 | 
					
						
							|  |  |  |         ] | 
					
						
							|  |  |  |     ] keep ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : flattening ( seq quot combinator -- seq' )
 | 
					
						
							|  |  |  |     [ flattener ] dip dip { } like ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : map-flat ( seq quot -- seq' ) [ each ] flattening ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
 | 
					
						
							| 
									
										
										
										
											2009-01-13 18:12:43 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: yield-hook | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-10 17:16:12 -05:00
										 |  |  | yield-hook [ [ ] ] initialize
 |