steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove dan's make*

db4
Slava Pestov 2008-02-01 18:36:20 -06:00
parent 9f1bcc5d22
commit 6851b16b39
2 changed files with 8 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
extra/unicode/case/case.factor
View File

@ -1,5 +1,6 @@
USING: kernel unicode.data sequences sequences.next namespaces assocs.lib USING: kernel unicode.data sequences sequences.next namespaces
unicode.normalize math unicode.categories combinators assocs ; assocs.lib unicode.normalize math unicode.categories combinators
assocs ;
IN: unicode.case IN: unicode.case
: ch>lower ( ch -- lower ) simple-lower at-default ; : ch>lower ( ch -- lower ) simple-lower at-default ;
@ -20,7 +21,7 @@ SYMBOL: locale ! Just casing locale, or overall?
[ swap dot-over = over "ij" member? and swap , ] if ; [ swap dot-over = over "ij" member? and swap , ] if ;
: lithuanian>upper ( string -- lower ) : lithuanian>upper ( string -- lower )
[ f swap [ lithuanian-ch>upper ] each-next drop ] "" make* ; [ f swap [ lithuanian-ch>upper ] each-next drop ] "" make ;
: mark-above? ( ch -- ? ) : mark-above? ( ch -- ? )
combining-class 230 = ; combining-class 230 = ;
@ -32,14 +33,14 @@ SYMBOL: locale ! Just casing locale, or overall?
dup , "IJ" member? swap mark-above? and [ dot-over , ] when ; dup , "IJ" member? swap mark-above? and [ dot-over , ] when ;
: lithuanian>lower ( string -- lower ) : lithuanian>lower ( string -- lower )
[ [ lithuanian-ch>lower ] each-next ] "" make* ; [ [ lithuanian-ch>lower ] each-next ] "" make ;
: turk-ch>upper ( ch -- ) : turk-ch>upper ( ch -- )
dup CHAR: i = dup CHAR: i =
[ drop CHAR: I , dot-over , ] [ , ] if ; [ drop CHAR: I , dot-over , ] [ , ] if ;
: turk>upper ( string -- upper-i ) : turk>upper ( string -- upper-i )
[ [ turk-ch>upper ] each ] "" make* ; [ [ turk-ch>upper ] each ] "" make ;
: turk-ch>lower ( ? next ch -- ? ) : turk-ch>lower ( ? next ch -- ? )
{ {
@ -52,7 +53,7 @@ SYMBOL: locale ! Just casing locale, or overall?
} cond ; } cond ;
: turk>lower ( string -- lower-i ) : turk>lower ( string -- lower-i )
[ f swap [ turk-ch>lower ] each-next drop ] "" make* ; [ f swap [ turk-ch>lower ] each-next drop ] "" make ;
: word-boundary ( prev char -- new ? ) : word-boundary ( prev char -- new ? )
dup non-starter? [ drop dup ] when dup non-starter? [ drop dup ] when
@ -76,7 +77,7 @@ SYMBOL: locale ! Just casing locale, or overall?
[ -rot nip call , ] ?if [ -rot nip call , ] ?if
] 2keep ] 2keep
] each 2drop ] each 2drop
] "" make* ; inline ] "" make ; inline
: >lower ( string -- lower ) : >lower ( string -- lower )
i-dot? [ turk>lower ] when i-dot? [ turk>lower ] when

11
extra/unicode/normalize/normalize.factor
View File

@ -2,17 +2,6 @@ USING: sequences namespaces unicode.data kernel combinators.lib
math arrays ; math arrays ;
IN: unicode.normalize IN: unicode.normalize
! Utility word--probably unnecessary
: make* ( seq quot exemplar -- newseq )
! quot has access to original seq on stack
! this just makes the new-resizable the same length as seq
[
[
pick length swap new-resizable
[ building set call ] keep
] keep like
] with-scope ; inline
! Conjoining Jamo behavior ! Conjoining Jamo behavior
: hangul-base HEX: ac00 ; inline : hangul-base HEX: ac00 ; inline