combinators: fix linear-case-quot to order the comparisons properly.

I noticed that member? optimized comparisons in the wrong order, this
was because it calls into linear-case-quot.  The reason case was working
find is because it reversed before calling linear-case-quot.  The fix
was to move the reverse into linear-case-quot.

diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor
index 7acb32f5994b2cfca82d9687cbe2fe81dab26ecb..39c50f847901c25e3800a65962f6903ce131f0f2 100644 (file)
--- a/core/combinators/combinators-tests.factor
+++ b/core/combinators/combinators-tests.factor
@@ -336,3 +336,20 @@ DEFER: corner-case-1
     } case ;
 
 [ 5.0 test-case-13 ] [ no-case? ] must-fail-with
+
+{
+    [
+        dup 1 =
+        [ drop "one" ] [
+            dup 2 =
+            [ drop "two" ]
+            [ dup 3 = [ drop "three" ] [ drop f ] if ] if
+        ] if
+    ]
+} [
+    [ drop f ] {
+        { 1 [ "one" ] }
+        { 2 [ "two" ] }
+        { 3 [ "three" ] }
+    } linear-case-quot
+] unit-test

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index 2fc7e3e1f69ee2a64979e0d860370682e490c02c..c64c57b14aab476dcd5342d9fa9c57c5e52f616e 100644 (file)
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -123,7 +123,7 @@ ERROR: no-case object ;
     [
         [ 1quotation \ dup prefix \ = suffix ]
         [ \ drop prefix ] bi*
-    ] assoc-map alist>quot ;
+    ] assoc-map reverse! alist>quot ;
 
 <PRIVATE
 
@@ -145,8 +145,9 @@ ERROR: no-case object ;
     [ first2 (distribute-buckets) ] with each ; inline
 
 : hash-case-table ( default assoc -- array )
-    V{ } [ 1array ] distribute-buckets
-    [ [ [ literalize ] dip ] assoc-map linear-case-quot ] with map ;
+    V{ } [ 1array ] distribute-buckets [
+        [ [ literalize ] dip ] assoc-map linear-case-quot
+    ] with map ;
 
 : hash-dispatch-quot ( table -- quot )
     [ length 1 - [ fixnum-bitand ] curry ] keep
@@ -179,7 +180,7 @@ ERROR: no-case object ;
 PRIVATE>
 
 : case>quot ( default assoc -- quot )
-    <reversed> dup keys {
+    dup keys {
         { [ dup empty? ] [ 2drop ] }
         { [ dup [ length 4 <= ] [ [ word? ] any? ] bi or ] [ drop linear-case-quot ] }
         { [ dup contiguous-range? ] [ drop dispatch-case-quot ] }