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.
db4
John Benediktsson 2015-07-16 09:55:19 -07:00
parent 33a62c7f9d
commit 6cded6437f
2 changed files with 22 additions and 4 deletions

View File

@ -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

View File

@ -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 ] }