]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/unicode/normalize/normalize.factor
factor: trim some using lists
[factor.git] / basis / unicode / normalize / normalize.factor
index aca96a56942c315303dc84afd4c52a9061883c7c..cc22e6d339feaaab058c751e545dc51c3bd06dce 100644 (file)
@@ -1,18 +1,19 @@
 ! Copyright (C) 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ascii sequences namespaces make unicode.data kernel math arrays
-locals sorting.insertion accessors assocs math.order combinators
-strings sbufs hints combinators.short-circuit vectors ;
+USING: accessors arrays ascii combinators
+combinators.short-circuit hints kernel make math
+math.order sbufs sequences sorting.insertion strings
+unicode.data vectors ;
 IN: unicode.normalize
 
 <PRIVATE
 ! Conjoining Jamo behavior
 
-CONSTANT: hangul-base HEX: ac00
-CONSTANT: hangul-end HEX: D7AF
-CONSTANT: initial-base HEX: 1100
-CONSTANT: medial-base HEX: 1161
-CONSTANT: final-base HEX: 11a7
+CONSTANT: hangul-base 0xac00
+CONSTANT: hangul-end 0xD7AF
+CONSTANT: initial-base 0x1100
+CONSTANT: medial-base 0x1161
+CONSTANT: final-base 0x11a7
 
 CONSTANT: initial-count 19
 CONSTANT: medial-count 21
@@ -22,13 +23,13 @@ CONSTANT: final-count 28
     pick [ between? ] [ 3drop f ] if ; inline
 
 : hangul? ( ch -- ? ) hangul-base hangul-end ?between? ; inline
-: jamo? ( ch -- ? ) HEX: 1100 HEX: 11FF ?between? ; inline
+: jamo? ( ch -- ? ) 0x1100 0x11FF ?between? ; inline
 
 ! These numbers come from UAX 29
 : initial? ( ch -- ? )
-    dup HEX: 1100 HEX: 1159 ?between? [ ] [ HEX: 115F = ] ?if ; inline
-: medial? ( ch -- ? ) HEX: 1160 HEX: 11A2 ?between? ; inline
-: final? ( ch -- ? ) HEX: 11A8 HEX: 11F9 ?between? ; inline
+    dup 0x1100 0x1159 ?between? [ ] [ 0x115F = ] ?if ; inline
+: medial? ( ch -- ? ) 0x1160 0x11A2 ?between? ; inline
+: final? ( ch -- ? ) 0x11A8 0x11F9 ?between? ; inline
 
 : hangul>jamo ( hangul -- jamo-string )
     hangul-base - final-count /mod final-base +
@@ -44,7 +45,7 @@ CONSTANT: final-count 28
         medial-base - + final-count *
     ] dip final-base - + hangul-base + ;
 
-! Normalization -- Decomposition 
+! Normalization -- Decomposition
 
 : reorder-slice ( string start -- slice done? )
     2dup swap [ non-starter? not ] find-from drop
@@ -88,43 +89,26 @@ HINTS: (nfd) string ;
 
 HINTS: (nfkd) string ;
 
-PRIVATE>
-
-: nfd ( string -- nfd )
-    [ (nfd) ] with-string ;
-
-: nfkd ( string -- nfkd )
-    [ (nfkd) ] with-string ;
-
-: string-append ( s1 s2 -- string )
-    [ append ] keep
-    0 over ?nth non-starter?
-    [ length dupd reorder-back ] [ drop ] if ;
-
-HINTS: string-append string string ;
-
-<PRIVATE
-
 ! Normalization -- Composition
 
 : initial-medial? ( str i -- ? )
-    { [ swap nth initial? ] [ 1+ swap ?nth medial? ] } 2&& ;
+    { [ swap nth initial? ] [ 1 + swap ?nth medial? ] } 2&& ;
 
 : --final? ( str i -- ? )
     2 + swap ?nth final? ;
 
-: imf, ( str i -- str i )
+: imf% ( str i -- str i )
     [ tail-slice first3 jamo>hangul , ]
     [ 3 + ] 2bi ;
 
-: im, ( str i -- str i )
+: im% ( str i -- str i )
     [ tail-slice first2 final-base jamo>hangul , ]
     [ 2 + ] 2bi ;
 
 : compose-jamo ( str i -- str i )
     2dup initial-medial? [
-        2dup --final? [ imf, ] [ im, ] if
-    ] [ 2dup swap nth , 1+ ] if ;
+        2dup --final? [ imf% ] [ im% ] if
+    ] [ 2dup swap nth , 1 + ] if ;
 
 : pass-combining ( str -- str i )
     dup [ non-starter? not ] find drop
@@ -136,7 +120,7 @@ TUPLE: compose-state i str char after last-class ;
 : get-str ( state i -- ch )
     swap [ i>> + ] [ str>> ] bi ?nth ; inline
 : current ( state -- ch ) 0 get-str ; inline
-: to ( state -- state ) [ 1+ ] change-i ; inline
+: to ( state -- state ) [ 1 + ] change-i ; inline
 : push-after ( ch state -- state ) [ ?push ] change-after ; inline
 
 :: try-compose ( state new-char current-class -- state )
@@ -153,7 +137,7 @@ DEFER: compose-iter
 
 : try-noncombining ( state char -- state )
     [ drop ] [ [ char>> ] dip combine-chars ] 2bi
-    [ >>char to f >>last-class compose-iter ] when* ; inline
+    [ >>char to f >>last-class compose-iter ] when* ; inline recursive
 
 : compose-iter ( state -- state )
     dup current [
@@ -177,8 +161,8 @@ DEFER: compose-iter
 :: (compose) ( str i -- )
     i str ?nth [
         dup jamo? [ drop str i compose-jamo ] [
-            i 1+ str ?nth combining-class
-            [ str i 1+ compose-combining ] [ , str i 1+ ] if
+            i 1 + str ?nth combining-class
+            [ str i 1 + compose-combining ] [ , str i 1 + ] if
         ] if (compose)
     ] when* ; inline recursive
 
@@ -188,9 +172,3 @@ DEFER: compose-iter
 HINTS: combine string ;
 
 PRIVATE>
-
-: nfc ( string -- nfc )
-    [ (nfd) combine ] with-string ;
-
-: nfkc ( string -- nfkc )
-    [ (nfkd) combine ] with-string ;