| 
									
										
										
										
											2008-09-10 21:07:07 -04:00
										 |  |  | ! Copyright (C) 2003, 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2012-07-19 12:35:28 -04:00
										 |  |  | USING: assocs kernel sequences namespaces ;
 | 
					
						
							| 
									
										
										
										
											2008-09-10 21:07:07 -04:00
										 |  |  | IN: make | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: building | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2012-07-19 12:35:28 -04:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : make-sequence ( quot exemplar -- seq )
 | 
					
						
							| 
									
										
										
										
											2008-09-10 21:07:07 -04:00
										 |  |  |     [ | 
					
						
							| 
									
										
										
										
											2012-07-21 13:44:54 -04:00
										 |  |  |         32 swap new-resizable [ | 
					
						
							|  |  |  |             building [ call ] with-variable
 | 
					
						
							|  |  |  |         ] keep
 | 
					
						
							|  |  |  |     ] keep like ; inline
 | 
					
						
							| 
									
										
										
										
											2008-09-10 21:07:07 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2012-07-19 12:35:28 -04:00
										 |  |  | : make-assoc ( quot exemplar -- assoc )
 | 
					
						
							| 
									
										
										
										
											2012-07-21 13:44:54 -04:00
										 |  |  |     5 swap new-assoc [ | 
					
						
							|  |  |  |         building [ call ] with-variable
 | 
					
						
							|  |  |  |     ] keep ; inline
 | 
					
						
							| 
									
										
										
										
											2012-07-19 12:35:28 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : make ( quot exemplar -- seq )
 | 
					
						
							|  |  |  |     dup sequence? [ make-sequence ] [ make-assoc ] if ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-09-10 21:07:07 -04:00
										 |  |  | : , ( elt -- ) building get push ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : % ( seq -- ) building get push-all ;
 | 
					
						
							| 
									
										
										
										
											2012-07-19 12:35:28 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : ,, ( value key -- ) building get set-at ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : %% ( assoc -- ) building get swap assoc-union! drop ;
 | 
					
						
							| 
									
										
										
										
											2012-07-19 20:47:50 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : ,+ ( n key -- ) building get at+ ;
 |