diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index b85e8879e1..1d2f821750 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -3,7 +3,7 @@ USING: combinators.short-circuit unicode.categories kernel math combinators splitting sequences math.parser io.files io assocs arrays namespaces make math.ranges unicode.normalize.private values -io.encodings.ascii unicode.syntax unicode.data compiler.units +io.encodings.ascii unicode.syntax unicode.data compiler.units fry alien.syntax sets accessors interval-maps memoize locals words ; IN: unicode.breaks @@ -111,14 +111,9 @@ PRIVATE> pieces) ( str quot -- ) - str [ - dup quot call cut-slice - swap , quot (>pieces) - ] unless-empty ; inline recursive - -: >pieces ( str quot -- graphemes ) - [ (>pieces) ] { } make ; inline +: >pieces ( str quot: ( str -- i ) -- graphemes ) + [ dup empty? not ] swap '[ dup @ cut-slice swap ] + [ ] produce nip ; inline PRIVATE> diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor index 0083e49672..f9d304e05c 100644 --- a/basis/unicode/case/case-tests.factor +++ b/basis/unicode/case/case-tests.factor @@ -4,7 +4,7 @@ USING: unicode.case tools.test namespaces ; \ >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 [ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test [ t ] [ "hello how are you?" lower? ] unit-test diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 7e61831f36..5d103e2dd0 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: unicode.data sequences sequences.next namespaces make unicode.normalize math unicode.categories combinators -assocs strings splitting kernel accessors ; +assocs strings splitting kernel accessors unicode.breaks ; IN: unicode.case -: >lower ( string -- lower ) - i-dot? [ turk>lower ] when - final-sigma [ lower>> ] [ ch>lower ] map-case ; -: >upper ( string -- upper ) - i-dot? [ turk>upper ] when +: (>lower) ( string -- lower ) + [ lower>> ] [ ch>lower ] map-case ; + +: (>title) ( string -- title ) + [ title>> ] [ ch>title ] map-case ; + +: (>upper) ( string -- upper ) [ upper>> ] [ ch>upper ] map-case ; +: title-word ( string -- title ) + unclip 1string [ (>lower) ] [ (>title) ] bi* prepend ; + +PRIVATE> + +: >lower ( string -- lower ) + i-dot? [ turk>lower ] when + final-sigma (>lower) ; + +: >upper ( string -- upper ) + i-dot? [ turk>upper ] when (>upper) ; + : >title ( string -- title ) - final-sigma - CHAR: \s swap - [ tuck word-boundary swapd - [ title>> ] [ lower>> ] if ] - [ tuck word-boundary swapd - [ ch>title ] [ ch>lower ] if ] - map-case nip ; + final-sigma >words [ title-word ] map concat ; : >case-fold ( string -- fold ) >upper >lower ; diff --git a/basis/unicode/collation/collation-tests.factor b/basis/unicode/collation/collation-tests.factor index be6af2d920..d3d0b8199d 100644 --- a/basis/unicode/collation/collation-tests.factor +++ b/basis/unicode/collation/collation-tests.factor @@ -1,6 +1,6 @@ USING: io io.files splitting grouping unicode.collation sequences kernel io.encodings.utf8 math.parser math.order -tools.test assocs io.streams.null words ; +tools.test assocs words ; IN: unicode.collation.tests : parse-test ( -- strings ) @@ -25,4 +25,4 @@ IN: unicode.collation.tests unit-test parse-test 2 -[ [ test-two ] assoc-each ] with-null-writer +[ test-two ] assoc-each diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index f13eb07594..58ce412a2e 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -155,7 +155,7 @@ DEFER: compose-iter ] if (compose) ] when* ; -: compose ( str -- comp ) +: combine ( str -- comp ) [ main-str set 0 ind set @@ -166,7 +166,7 @@ DEFER: compose-iter PRIVATE> : nfc ( string -- nfc ) - nfd compose ; + nfd combine ; : nfkc ( string -- nfkc ) - nfkd compose ; + nfkd combine ;