assocs.extras: minor changes to assoc-merge.
							parent
							
								
									14ed9a5455
								
							
						
					
					
						commit
						fbc146d97a
					
				| 
						 | 
				
			
			@ -1,5 +1,5 @@
 | 
			
		|||
 | 
			
		||||
USING: assocs.extras kernel tools.test ;
 | 
			
		||||
USING: assocs.extras kernel sequences tools.test ;
 | 
			
		||||
 | 
			
		||||
IN: assocs.extras
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -12,11 +12,10 @@ IN: assocs.extras
 | 
			
		|||
 | 
			
		||||
{ H{ { 2 1 } { 4 3 } } } [ H{ { 1 2 } { 3 4 } } assoc-invert ] unit-test
 | 
			
		||||
 | 
			
		||||
[ H{ } ] [ { } assoc-merge ] unit-test
 | 
			
		||||
[ H{ { "a" V{ 2 5 } } { "b" V{ 3 } } { "c" V{ 10 } } } ]
 | 
			
		||||
[
 | 
			
		||||
    { H{ { "a" 2 } { "b" 3 } } H{ { "a" 5 } { "c" 10 } } }
 | 
			
		||||
    assoc-merge
 | 
			
		||||
    [ ] [ assoc-merge ] map-reduce
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
{ H{ } } [ H{ { 1 2 } } 2 over delete-value-at ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -39,11 +39,12 @@ IN: assocs.extras
 | 
			
		|||
: assoc-invert ( assoc -- newassoc )
 | 
			
		||||
    dup assoc-invert-as ;
 | 
			
		||||
 | 
			
		||||
: (assoc-merge) ( assoc1 assoc2 -- assoc1 )
 | 
			
		||||
: assoc-merge! ( assoc1 assoc2 -- assoc1 )
 | 
			
		||||
    over [ push-at ] with-assoc assoc-each ;
 | 
			
		||||
 | 
			
		||||
: assoc-merge ( seq -- merge )
 | 
			
		||||
    H{ } clone [ (assoc-merge) ] reduce ;
 | 
			
		||||
: assoc-merge ( assoc1 assoc2 -- newassoc )
 | 
			
		||||
    [ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep
 | 
			
		||||
    [ assoc-merge! ] bi@ ;
 | 
			
		||||
 | 
			
		||||
GENERIC: delete-value-at ( value assoc -- )
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue