! See http://factorcode.org/license.txt for BSD license.
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
+io.encodings.utf8 io.files kernel make math math.bitwise
+math.order math.parser ranges namespaces sequences
sets simple-flat-file sorting splitting strings.parser ;
IN: unicode.data
CONSTANT: special-casing H{ }
CONSTANT: properties H{ }
-: >2ch ( a b -- c ) [ 21 shift ] dip + ;
-: 2ch> ( c -- a b ) [ -21 shift ] [ 21 on-bits mask ] bi ;
+: >2ch ( a b -- c ) [ 21 shift ] dip + ; inline
+: 2ch> ( c -- a b ) [ -21 shift ] [ 21 on-bits mask ] bi ; inline
PRIVATE>
: combining-class ( char -- n ) class-map at ; inline
: non-starter? ( char -- ? ) combining-class { 0 f } member? not ; inline
: property ( property -- interval-map ) properties at ; foldable
-: property? ( char property -- ? ) property interval-sets:in? ; inline
+: property? ( char property -- ? ) property interval-in? ; inline
: special-case ( ch -- casing-tuple ) special-casing at ; inline
! For non-existent characters, use Cn
MEMO: categories-map ( -- hashtable )
categories H{ } zip-index-as ;
-CONSTANT: num-chars 0x2FA1E
+CONSTANT: NUM-CHARS 0x2FA25
PRIVATE>
-: category# ( char -- n )
+: category-num ( char -- n )
! There are a few characters that should be Cn
! that this gives Cf or Mn
! Cf = 26; Mn = 5; Cn = 29
] ?if ; inline
: category ( char -- category )
- category# categories nth ;
+ category-num categories nth ;
<PRIVATE
! Loading data from UnicodeData.txt
-: load-data ( -- data )
- "vocab:unicode/data/UnicodeData.txt" load-data-file ;
+: load-unicode-data ( -- data )
+ "vocab:unicode/UCD/UnicodeData.txt" load-data-file ;
: (process-data) ( index data -- newdata )
[ [ nth ] keep first swap ] with { } map>assoc
: (process-decomposed) ( data -- alist )
5 swap (process-data)
- [ " " split [ hex> ] map ] assoc-map ;
+ [ split-words [ hex> ] map ] assoc-map ;
: exclusions-file ( -- filename )
- "vocab:unicode/data/CompositionExclusions.txt" ;
+ "vocab:unicode/UCD/CompositionExclusions.txt" ;
: exclusions ( -- set )
exclusions-file utf8 file-lines
- [ "#" split1 drop [ blank? ] trim-tail hex> ] map
- [ 0 = ] reject ;
+ [ "#" split1 drop [ ascii:blank? ] trim-tail hex> ] map
+ 0 swap remove ;
+
+: unique ( seq -- assoc )
+ [ dup ] H{ } map>assoc ;
: remove-exclusions ( alist -- alist )
exclusions unique assoc-diff ;
name-map sort-values keys
[ { [ "first>" tail? ] [ "last>" tail? ] } 1|| ] filter
2 group [
- [ name-map at ] bi@ [ [a,b] ] [ table ?nth ] bi
+ [ name-map at ] bi@ [ [a..b] ] [ table ?nth ] bi
[ swap table ?set-nth ] curry each
] assoc-each table ;
:: process-category ( data -- category-listing )
- num-chars <byte-array> :> table
+ NUM-CHARS <byte-array> :> table
2 data (process-data) [| char cat |
cat categories-map at char table ?set-nth
] assoc-each table fill-ranges ;
] H{ } assoc-map-as ;
: multihex ( hexstring -- string )
- " " split [ hex> ] map sift ;
+ split-words [ hex> ] map sift ;
PRIVATE>
! Extra properties {{[a,b],prop}}
: parse-properties ( -- assoc )
- "vocab:unicode/data/PropList.txt" load-data-file [
+ "vocab:unicode/UCD/PropList.txt" load-data-file [
[
".." split1 [ dup ] unless*
[ hex> ] bi@ 2array
! Special casing data
: load-special-casing ( -- special-casing )
- "vocab:unicode/data/SpecialCasing.txt" load-data-file
+ "vocab:unicode/UCD/SpecialCasing.txt" load-data-file
[ length 5 = ] filter
[ [ set-code-point ] each ] H{ } make ;
-load-data {
+load-unicode-data {
[ process-names name-map swap assoc-union! drop ]
[ 13 swap process-data simple-lower swap assoc-union! drop ]
[ 12 swap process-data simple-upper swap assoc-union! drop ]
PRIVATE>
+ERROR: invalid-unicode-character name ;
+
[
- name-map at [ "Invalid character" throw ] unless*
+ name-map ?at [ invalid-unicode-character ] unless
] name>char-hook set-global