assocs.extras: Fix error with assoc-collapse with f as first element

Since `assoc-collapse` uses a clone of the first assoc in the input sequence as
basis for the resulting assoc, this was failing when the first element was `f`.
Change behavior to return a hashtable instead, since this is the
default behavior for `f new-assoc` as well.

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index e14ef76a9444938246efb23d087b47e59bcd809a..276005980c7ca787e1d26dcf8b8ca8ac7611e58c 100644 (file)
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -136,3 +136,12 @@ USING: arrays assocs.extras kernel math math.order sequences tools.test ;
     H{ { 3 30 } { 4 40 } } 3array
     [ min ] assoc-collapse
 ] unit-test
+
+{
+    H{ { 2 22 } { 3 30 } { 4 40 } }
+} [
+    f
+    H{ { 2 22 } { 3 33 } }
+    H{ { 3 30 } { 4 40 } } 3array
+    [ min ] assoc-collapse
+] unit-test

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index b13bd21f182f58ad974de8ae2aa460025b60e831..44b076817967dc63689f19d8e21c56380b550fe2 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -80,7 +80,7 @@ IN: assocs.extras
 : assoc-collapse ( seq quot: ( value1 value2 -- new-value ) -- assoc )
     over empty?
     [ 2drop f ]
-    [ [ unclip-slice clone ] [ [ assoc-merge! ] curry ] bi* reduce ] if ; inline
+    [ [ unclip-slice H{ } or clone ] [ [ assoc-merge! ] curry ] bi* reduce ] if ; inline
 
 GENERIC: delete-value-at ( value assoc -- )