Fix map-case
parent
91059b4ad6
commit
b6a7ebf184
|
@ -1,5 +1,9 @@
|
||||||
USING: unicode.case tools.test namespaces ;
|
USING: unicode.case tools.test namespaces ;
|
||||||
|
|
||||||
|
\ >upper must-infer
|
||||||
|
\ >lower must-infer
|
||||||
|
\ >title must-infer
|
||||||
|
|
||||||
[ "Hello How Are You? I'M Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
|
[ "Hello How Are You? I'M Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
|
||||||
[ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
|
[ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
|
||||||
[ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test
|
[ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: kernel unicode.data sequences sequences.next namespaces
|
USING: unicode.data sequences sequences.next namespaces
|
||||||
unicode.normalize math unicode.categories combinators
|
unicode.normalize math unicode.categories combinators
|
||||||
assocs strings splitting ;
|
assocs strings splitting kernel ;
|
||||||
IN: unicode.case
|
IN: unicode.case
|
||||||
|
|
||||||
: at-default ( key assoc -- value/key ) over >r at r> or ;
|
: at-default ( key assoc -- value/key ) over >r at r> or ;
|
||||||
|
@ -70,15 +70,23 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
: final-sigma ( string -- string )
|
: final-sigma ( string -- string )
|
||||||
HEX: 3A3 over member? [ sigma-map ] when ;
|
HEX: 3A3 over member? [ sigma-map ] when ;
|
||||||
|
|
||||||
|
! : map-case ( string string-quot char-quot -- case )
|
||||||
|
! [
|
||||||
|
! rot [
|
||||||
|
! -rot [
|
||||||
|
! rot dup special-casing at
|
||||||
|
! [ -rot drop call % ]
|
||||||
|
! [ -rot nip call , ] ?if
|
||||||
|
! ] 2keep
|
||||||
|
! ] each 2drop
|
||||||
|
! ] "" make ; inline
|
||||||
|
|
||||||
: map-case ( string string-quot char-quot -- case )
|
: map-case ( string string-quot char-quot -- case )
|
||||||
[
|
[
|
||||||
rot [
|
[
|
||||||
-rot [
|
[ dup special-casing at ] 2dip
|
||||||
rot dup special-casing at
|
[ [ % ] compose ] [ [ , ] compose ] bi* ?if
|
||||||
[ -rot drop call % ]
|
] 2curry each
|
||||||
[ -rot nip call , ] ?if
|
|
||||||
] 2keep
|
|
||||||
] each 2drop
|
|
||||||
] "" make ; inline
|
] "" make ; inline
|
||||||
|
|
||||||
: >lower ( string -- lower )
|
: >lower ( string -- lower )
|
||||||
|
|
Loading…
Reference in New Issue