use radix literals

[factor.git] / basis / unicode / collation / collation.factor

diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor
old mode 100755 (executable)
new mode 100644 (file)
index b6eddcc..50d032d
--- a/basis/unicode/collation/collation.factor
+++ b/basis/unicode/collation/collation.factor
@@ -1,11 +1,10 @@
 ! Copyright (C) 2008 Daniel Ehrenberg.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: combinators.short-circuit sequences io.files\r
-io.encodings.ascii kernel values splitting accessors math.parser\r
-ascii io assocs strings math namespaces make sorting combinators\r
-math.order arrays unicode.normalize unicode.data locals\r
-macros sequences.deep words unicode.breaks\r
-quotations combinators.short-circuit simple-flat-file ;\r
+USING: sequences io.files io.encodings.ascii kernel values splitting\r
+accessors math.parser ascii io assocs strings math namespaces make\r
+sorting combinators math.order arrays unicode.normalize unicode.data\r
+locals macros sequences.deep words unicode.breaks quotations\r
+combinators.short-circuit simple-flat-file ;\r
 IN: unicode.collation\r
 \r
 <PRIVATE\r
@@ -26,7 +25,7 @@ TUPLE: weight primary secondary tertiary ignorable? ;
 : parse-ducet ( file -- ducet )\r
     data [ [ parse-keys ] [ parse-weight ] bi* ] H{ } assoc-map-as ;\r
 \r
-"vocab:unicode/collation/allkeys.txt" parse-ducet to: ducet\r
+"vocab:unicode/collation/allkeys.txt" parse-ducet \ ducet set-value\r
 \r
 ! Fix up table for long contractions\r
 : help-one ( assoc key -- )\r
@@ -44,17 +43,17 @@ ducet insert-helpers
 \r
 : base ( char -- base )\r
     {\r
-        { [ dup HEX: 3400 HEX:  4DB5 between? ] [ drop HEX: FB80 ] } ! Extension A\r
-        { [ dup HEX: 20000 HEX: 2A6D6 between? ] [ drop HEX: FB80 ] } ! Extension B\r
-        { [ dup HEX: 4E00 HEX: 9FC3 between? ] [ drop HEX: FB40 ] } ! CJK\r
-        [ drop HEX: FBC0 ] ! Other\r
+        { [ dup 0x3400 0x4DB5 between? ] [ drop 0xFB80 ] } ! Extension A\r
+        { [ dup 0x20000 0x2A6D6 between? ] [ drop 0xFB80 ] } ! Extension B\r
+        { [ dup 0x4E00 0x9FC3 between? ] [ drop 0xFB40 ] } ! CJK\r
+        [ drop 0xFBC0 ] ! Other\r
     } cond ;\r
 \r
 : AAAA ( char -- weight )\r
-    [ base ] [ -15 shift ] bi + HEX: 20 2 f weight boa ;\r
+    [ base ] [ -15 shift ] bi + 0x20 2 f weight boa ;\r
 \r
 : BBBB ( char -- weight )\r
-    HEX: 7FFF bitand HEX: 8000 bitor 0 0 f weight boa ;\r
+    0x7FFF bitand 0x8000 bitor 0 0 f weight boa ;\r
 \r
 : illegal? ( char -- ? )\r
     { [ "Noncharacter_Code_Point" property? ] [ category "Cs" = ] } 1|| ;\r
@@ -64,27 +63,26 @@ ducet insert-helpers
     [ drop { } ]\r
     [ [ AAAA ] [ BBBB ] bi 2array ] if ;\r
 \r
-: last ( -- char )\r
-    building get empty? [ 0 ] [ building get peek peek ] if ;\r
+: building-last ( -- char )\r
+    building get empty? [ 0 ] [ building get last last ] if ;\r
 \r
 : blocked? ( char -- ? )\r
     combining-class dup { 0 f } member?\r
-    [ drop last non-starter? ]\r
-    [ last combining-class = ] if ;\r
+    [ drop building-last non-starter? ]\r
+    [ building-last combining-class = ] if ;\r
 \r
 : possible-bases ( -- slice-of-building )\r
     building get dup [ first non-starter? not ] find-last\r
     drop [ 0 ] unless* tail-slice ;\r
 \r
 :: ?combine ( char slice i -- ? )\r
-    [let | str [ i slice nth char suffix ] |\r
-        str ducet key? dup\r
-        [ str i slice set-nth ] when\r
-    ] ;\r
+    i slice nth char suffix :> str\r
+    str ducet key? dup\r
+    [ str i slice set-nth ] when ;\r
 \r
 : add ( char -- )\r
     dup blocked? [ 1string , ] [\r
-        dup possible-bases dup length\r
+        dup possible-bases dup length iota\r
         [ ?combine ] with with any?\r
         [ drop ] [ 1string , ] if\r
     ] if ;\r
@@ -103,7 +101,7 @@ ducet insert-helpers
     map [ zero? not ] filter % 0 , ; inline\r
 \r
 : variable-weight ( weight -- )\r
-    dup ignorable?>> [ primary>> ] [ drop HEX: FFFF ] if , ;\r
+    dup ignorable?>> [ primary>> ] [ drop 0xFFFF ] if , ;\r
 \r
 : weights>bytes ( weights -- byte-array )\r
     [\r
@@ -151,10 +149,8 @@ PRIVATE>
 : quaternary= ( str1 str2 -- ? )\r
     0 insensitive= ;\r
 \r
-<PRIVATE\r
 : w/collation-key ( str -- {str,key} )\r
     [ collation-key ] keep 2array ;\r
-PRIVATE>\r
 \r
 : sort-strings ( strings -- sorted )\r
     [ w/collation-key ] map natural-sort values ;\r