'case' didn't work if the default was a non-quotation callable, like a curry; this could come up with macro expansion. Bug reported by Dan

db4
Slava Pestov 2009-02-04 02:41:30 -06:00
parent 280939e6ca
commit cd77ecfab3
3 changed files with 14 additions and 4 deletions

View File

@ -70,7 +70,7 @@ IN: stack-checker.transforms
[
[ no-case ]
] [
dup peek quotation? [
dup peek callable? [
dup peek swap but-last
] [
[ no-case ] swap

View File

@ -1,6 +1,6 @@
USING: alien strings kernel math tools.test io prettyprint
namespaces combinators words classes sequences accessors
math.functions ;
math.functions arrays ;
IN: combinators.tests
! Compiled
@ -314,3 +314,13 @@ IN: combinators.tests
\ test-case-7 must-infer
[ "plus" ] [ \ + test-case-7 ] unit-test
! Some corner cases (no pun intended)
DEFER: corner-case-1
<< \ corner-case-1 2 [ + ] curry 1array [ case ] curry (( a -- b )) define-declared >>
[ t ] [ \ corner-case-1 optimized>> ] unit-test
[ 4 ] [ 2 corner-case-1 ] unit-test
[ 4 ] [ 2 2 [ + ] curry 1array case ] unit-test

View File

@ -59,13 +59,13 @@ ERROR: no-case ;
] [
dup wrapper? [ wrapped>> ] when
] if =
] [ quotation? ] if
] [ callable? ] if
] find nip ;
: case ( obj assoc -- )
case-find {
{ [ dup array? ] [ nip second call ] }
{ [ dup quotation? ] [ call ] }
{ [ dup callable? ] [ call ] }
{ [ dup not ] [ no-case ] }
} cond ;