use reject instead of [ ... not ] filter.

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

diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor
index 03fc3b98ad3856141d45a58652bb5a703a6613d8..1f7336495cae1574b58ee6cfbb5a1264d9523fe4 100644 (file)
--- a/basis/unicode/data/data.factor
+++ b/basis/unicode/data/data.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2008, 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit assocs math kernel sequences
-io.files hashtables quotations splitting grouping arrays io
-math.parser math.order byte-arrays namespaces math.bitwise
-compiler.units parser io.encodings.ascii interval-maps
-ascii sets combinators locals math.ranges sorting make
-strings.parser io.encodings.utf8 memoize simple-flat-file ;
+USING: arrays ascii assocs byte-arrays combinators
+combinators.short-circuit grouping hashtables interval-sets
+io.encodings.utf8 io.files kernel locals make math math.bitwise
+math.order math.parser math.ranges memoize namespaces sequences
+sets simple-flat-file sorting splitting strings.parser ;
+QUALIFIED: interval-sets
 IN: unicode.data
 
 <PRIVATE
@@ -17,7 +17,7 @@ CONSTANT: canonical-map H{ }
 CONSTANT: combine-map H{ }
 CONSTANT: class-map H{ }
 CONSTANT: compatibility-map H{ }
-SYMBOL: category-map ! B{ }
+CONSTANT: category-map BV{ }
 CONSTANT: special-casing H{ }
 CONSTANT: properties H{ }
 
@@ -35,22 +35,24 @@ CONSTANT: name-map H{ }
 : non-starter? ( char -- ? ) combining-class { 0 f } member? not ; inline
 : name>char ( name -- char ) name-map at ; inline
 : char>name ( char -- name ) name-map value-at ; inline
-: property? ( char property -- ? ) properties at interval-key? ; inline
+: property ( property -- interval-map ) properties at ; foldable
+: property? ( char property -- ? ) property interval-sets:in? ; inline
 : ch>lower ( ch -- lower ) simple-lower ?at drop ; inline
 : ch>upper ( ch -- upper ) simple-upper ?at drop ; inline
 : ch>title ( ch -- title ) simple-title ?at drop ; inline
 : special-case ( ch -- casing-tuple ) special-casing at ; inline
 
 ! For non-existent characters, use Cn
-CONSTANT: categories
-    { "Cn"
-      "Lu" "Ll" "Lt" "Lm" "Lo"
-      "Mn" "Mc" "Me"
-      "Nd" "Nl" "No"
-      "Pc" "Pd" "Ps" "Pe" "Pi" "Pf" "Po"
-      "Sm" "Sc" "Sk" "So"
-      "Zs" "Zl" "Zp"
-      "Cc" "Cf" "Cs" "Co" }
+CONSTANT: categories {
+    "Cn"
+    "Lu" "Ll" "Lt" "Lm" "Lo"
+    "Mn" "Mc" "Me"
+    "Nd" "Nl" "No"
+    "Pc" "Pd" "Ps" "Pe" "Pi" "Pf" "Po"
+    "Sm" "Sc" "Sk" "So"
+    "Zs" "Zl" "Zp"
+    "Cc" "Cf" "Cs" "Co"
+}
 
 <PRIVATE
 
@@ -66,7 +68,7 @@ PRIVATE>
     ! that this gives Cf or Mn
     ! Cf = 26; Mn = 5; Cn = 29
     ! Use a compressed array instead?
-    dup category-map get-global ?nth [ ] [
+    dup category-map ?nth [ ] [
         dup 0xE0001 0xE007F between?
         [ drop 26 ] [
             0xE0100 0xE01EF between?  5 29 ?
@@ -92,7 +94,7 @@ PRIVATE>
 
 : (chain-decomposed) ( hash value -- newvalue )
     [
-        2dup swap at
+        2dup of
         [ (chain-decomposed) ] [ 1array nip ] ?if
     ] with map concat ;
 
@@ -112,7 +114,7 @@ PRIVATE>
 : exclusions ( -- set )
     exclusions-file utf8 file-lines
     [ "#" split1 drop [ blank? ] trim-tail hex> ] map
-    [ 0 = not ] filter ;
+    [ 0 = ] reject ;
 
 : remove-exclusions ( alist -- alist )
     exclusions unique assoc-diff ;
@@ -127,7 +129,7 @@ PRIVATE>
 : process-compatibility ( data -- hash )
     (process-decomposed)
     [ dup first* [ first2 rest 2array ] unless ] map
-    [ second empty? not ] filter
+    [ second empty? ] reject
     >hashtable chain-decomposed ;
 
 : process-combining ( data -- hash )
@@ -138,9 +140,6 @@ PRIVATE>
 
 ! the maximum unicode char in the first 3 planes
 
-: ?set-nth ( val index seq -- )
-    2dup bounds-check? [ set-nth ] [ 3drop ] if ;
-
 :: fill-ranges ( table -- table )
     name-map sort-values keys
     [ { [ "first>" tail? ] [ "last>" tail? ] } 1|| ] filter
@@ -206,11 +205,11 @@ load-data {
     [ process-combining class-map swap assoc-union! drop ]
     [ process-canonical canonical-map swap assoc-union! drop combine-map swap assoc-union! drop ]
     [ process-compatibility compatibility-map swap assoc-union! drop ]
-    [ process-category category-map set-global ]
+    [ process-category category-map push-all ]
 } cleave
 
 combine-map keys [ 2ch> nip ] map
-[ combining-class not ] filter
+[ combining-class ] reject
 [ 0 swap class-map set-at ] each
 
 load-special-casing special-casing swap assoc-union! drop
@@ -219,3 +218,5 @@ load-properties properties swap assoc-union! drop
 
 [ name>char [ "Invalid character" throw ] unless* ]
 name>char-hook set-global
+
+PRIVATE>