| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-01-16 16:25:29 -05:00
										 |  |  | ! USING: kernel quotations namespaces sequences assocs.lib ; | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | USING: kernel namespaces namespaces.private quotations sequences | 
					
						
							| 
									
										
										
										
											2008-03-15 08:57:38 -04:00
										 |  |  |        assocs.lib math.parser math sequences.lib locals ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | IN: namespaces.lib | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : save-namestack ( quot -- ) namestack >r call r> set-namestack ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-01-29 21:52:58 -05:00
										 |  |  | : set* ( val var -- ) namestack* set-assoc-stack ;
 | 
					
						
							| 
									
										
										
										
											2008-03-06 10:52:56 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: building-seq  | 
					
						
							|  |  |  | : get-building-seq ( n -- seq )
 | 
					
						
							|  |  |  |     building-seq get nth ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : n, get-building-seq push ;
 | 
					
						
							|  |  |  | : n% get-building-seq push-all ;
 | 
					
						
							|  |  |  | : n# >r number>string r> n% ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : 0, 0 n, ;
 | 
					
						
							|  |  |  | : 0% 0 n% ;
 | 
					
						
							|  |  |  | : 0# 0 n# ;
 | 
					
						
							|  |  |  | : 1, 1 n, ;
 | 
					
						
							|  |  |  | : 1% 1 n% ;
 | 
					
						
							|  |  |  | : 1# 1 n# ;
 | 
					
						
							|  |  |  | : 2, 2 n, ;
 | 
					
						
							|  |  |  | : 2% 2 n% ;
 | 
					
						
							|  |  |  | : 2# 2 n# ;
 | 
					
						
							| 
									
										
										
										
											2008-03-07 21:08:34 -05:00
										 |  |  | : 3, 3 n, ;
 | 
					
						
							|  |  |  | : 3% 3 n% ;
 | 
					
						
							|  |  |  | : 3# 3 n# ;
 | 
					
						
							|  |  |  | : 4, 4 n, ;
 | 
					
						
							|  |  |  | : 4% 4 n% ;
 | 
					
						
							|  |  |  | : 4# 4 n# ;
 | 
					
						
							| 
									
										
										
										
											2008-03-06 10:52:56 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-03-15 08:57:38 -04:00
										 |  |  | MACRO:: nmake ( quot exemplars -- )
 | 
					
						
							|  |  |  |     [let | n [ exemplars length ] | | 
					
						
							| 
									
										
										
										
											2008-03-06 10:52:56 -05:00
										 |  |  |         [ | 
					
						
							| 
									
										
										
										
											2008-03-15 08:57:38 -04:00
										 |  |  |             [ | 
					
						
							|  |  |  |                 exemplars | 
					
						
							|  |  |  |                 [ 0 swap new-resizable ] map
 | 
					
						
							|  |  |  |                 building-seq set
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |                 quot call
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |                 building-seq get
 | 
					
						
							|  |  |  |                 exemplars [ like ] 2map
 | 
					
						
							|  |  |  |                 n firstn | 
					
						
							|  |  |  |             ] with-scope
 | 
					
						
							|  |  |  |         ] | 
					
						
							|  |  |  |     ] ;
 |