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
parent
33a62c7f9d
commit
6cded6437f
|
@ -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
|
||||
|
|
|
@ -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 ] }
|
||||
|
|
Loading…
Reference in New Issue