| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov, James Cash. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2013-03-07 13:05:28 -05:00
										 |  |  | USING: accessors arrays assocs deques dlists fry kernel | 
					
						
							|  |  |  | sequences sequences.private ;
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | IN: linked-assocs | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-03-07 13:05:28 -05:00
										 |  |  | TUPLE: linked-assoc { assoc read-only } { dlist dlist read-only } ;
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-11 18:42:52 -05:00
										 |  |  | : <linked-assoc> ( exemplar -- assoc )
 | 
					
						
							|  |  |  |     0 swap new-assoc <dlist> linked-assoc boa ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | : <linked-hash> ( -- assoc )
 | 
					
						
							| 
									
										
										
										
											2008-11-11 18:42:52 -05:00
										 |  |  |     H{ } <linked-assoc> ;
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: linked-assoc assoc-size assoc>> assoc-size ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-03-07 13:05:28 -05:00
										 |  |  | M: linked-assoc at* | 
					
						
							|  |  |  |     assoc>> at* [ [ obj>> second-unsafe ] when ] keep ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : (delete-at) ( key assoc dlist -- )
 | 
					
						
							|  |  |  |     '[ at [ _ delete-node ] when* ] [ delete-at ] 2bi ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							| 
									
										
										
										
											2008-11-08 02:18:03 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: linked-assoc delete-at | 
					
						
							| 
									
										
										
										
											2013-03-07 13:05:28 -05:00
										 |  |  |     [ assoc>> ] [ dlist>> ] bi (delete-at) ;
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | <PRIVATE
 | 
					
						
							| 
									
										
										
										
											2013-03-07 13:05:28 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : add-to-dlist ( value key dlist -- node )
 | 
					
						
							|  |  |  |     [ swap 2array ] dip push-back* ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: linked-assoc set-at | 
					
						
							| 
									
										
										
										
											2013-03-07 13:05:28 -05:00
										 |  |  |     [ assoc>> ] [ dlist>> ] bi
 | 
					
						
							|  |  |  |     '[ _ 2over key? [ 3dup (delete-at) ] when nip add-to-dlist ] | 
					
						
							|  |  |  |     [ set-at ] 2bi ;
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: linked-assoc >alist | 
					
						
							| 
									
										
										
										
											2012-07-13 18:53:38 -04:00
										 |  |  |     dlist>> dlist>sequence ;
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-08 12:21:32 -05:00
										 |  |  | M: linked-assoc clear-assoc | 
					
						
							|  |  |  |     [ assoc>> clear-assoc ] [ dlist>> clear-deque ] bi ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: linked-assoc clone  | 
					
						
							|  |  |  |     [ assoc>> clone ] [ dlist>> clone ] bi
 | 
					
						
							|  |  |  |     linked-assoc boa ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-08 01:44:53 -05:00
										 |  |  | INSTANCE: linked-assoc assoc |