Fix case bug

db4
Slava Pestov 2008-04-22 16:29:10 -05:00
parent cdb31b4813
commit f1113b7c2a
3 changed files with 15 additions and 7 deletions

View File

@ -150,7 +150,7 @@ M: hashtable hashcode*
drop drop
] [ ] [
dup length 4 <= dup length 4 <=
over keys [ word? ] contains? or over keys [ [ word? ] [ wrapper? ] bi or ] contains? or
[ [
linear-case-quot linear-case-quot
] [ ] [

View File

@ -60,7 +60,8 @@ sequences.private combinators ;
[ value-literal sequence? ] [ drop f ] if ; [ value-literal sequence? ] [ drop f ] if ;
: member-quot ( seq -- newquot ) : member-quot ( seq -- newquot )
[ [ t ] ] { } map>assoc [ drop f ] suffix [ nip case ] curry ; [ literalize [ t ] ] { } map>assoc
[ drop f ] suffix [ nip case ] curry ;
: expand-member ( #call -- ) : expand-member ( #call -- )
dup node-in-d peek value-literal member-quot f splice-quot ; dup node-in-d peek value-literal member-quot f splice-quot ;

View File

@ -1,9 +1,9 @@
USING: arrays compiler.units generic hashtables inference kernel USING: arrays compiler.units generic hashtables inference kernel
kernel.private math optimizer prettyprint sequences sbufs kernel.private math optimizer generator prettyprint sequences
strings tools.test vectors words sequences.private quotations sbufs strings tools.test vectors words sequences.private
optimizer.backend classes classes.algebra inference.dataflow quotations optimizer.backend classes classes.algebra
classes.tuple.private continuations growable optimizer.inlining inference.dataflow classes.tuple.private continuations growable
namespaces hints ; optimizer.inlining namespaces hints ;
IN: optimizer.tests IN: optimizer.tests
[ H{ { 1 5 } { 3 4 } { 2 5 } } ] [ [ H{ { 1 5 } { 3 4 } { 2 5 } } ] [
@ -349,3 +349,10 @@ USE: sequences.private
1 2 3.0 3 counter-example ; 1 2 3.0 3 counter-example ;
[ 2 4 6.0 0 ] [ counter-example' ] unit-test [ 2 4 6.0 0 ] [ counter-example' ] unit-test
: member-test { + - * / /i } member? ;
\ member-test must-infer
[ ] [ \ member-test word-dataflow optimize 2drop ] unit-test
[ t ] [ \ + member-test ] unit-test
[ f ] [ \ append member-test ] unit-test