#!perl
#
-# This script generates "unfcan.h", "unfcpt.h", "unfcmb.h",
-# "unfcmp.h", and "unfexc.h"
-# from CombiningClass.pl, Decomposition.pl, CompExcl.txt
-# in lib/unicore or unicode directory
-# for Unicode::Normalize.xs. (cf. Makefile.PL)
+# This auxiliary script makes five header files
+# used for building XSUB of Unicode::Normalize.
+#
+# Usage:
+# <do 'mkheader'> in perl, or <perl mkheader> in command line
+#
+# Input files:
+# unicore/CombiningClass.pl (or unicode/CombiningClass.pl)
+# unicore/Decomposition.pl (or unicode/Decomposition.pl)
+# unicore/CompositionExclusions.txt (or unicode/CompExcl.txt)
+#
+# Output files:
+# unfcan.h
+# unfcpt.h
+# unfcmb.h
+# unfcmp.h
+# unfexc.h
#
use 5.006;
use strict;
use warnings;
use Carp;
+use File::Spec;
+
+BEGIN {
+ unless ("A" eq pack('U', 0x41)) {
+ die "Unicode::Normalize cannot stringify a Unicode code point\n";
+ }
+}
our $PACKAGE = 'Unicode::Normalize, mkheader';
our $Combin = do "unicore/CombiningClass.pl"
- || do "unicode/CombiningClass.pl"
- || croak "$PACKAGE: CombiningClass.pl not found";
+ || do "unicode/CombiningClass.pl"
+ || croak "$PACKAGE: CombiningClass.pl not found";
our $Decomp = do "unicore/Decomposition.pl"
- || do "unicode/Decomposition.pl"
- || croak "$PACKAGE: Decomposition.pl not found";
-
-our %Combin; # $codepoint => $number : combination class
-our %Canon; # $codepoint => $hexstring : canonical decomp.
-our %Compat; # $codepoint => $hexstring : compat. decomp.
-our %Compos; # $string => $codepoint : composite
-
-our %Exclus; # $codepoint => 1 : composition exclusions
+ || do "unicode/Decomposition.pl"
+ || croak "$PACKAGE: Decomposition.pl not found";
+
+our %Combin; # $codepoint => $number : combination class
+our %Canon; # $codepoint => \@codepoints : canonical decomp.
+our %Compat; # $codepoint => \@codepoints : compat. decomp.
+# after _U_stringify(), ($codepoint => $hexstring) for %Canon and %Compat
+our %Exclus; # $codepoint => 1 : composition exclusions
+our %Single; # $codepoint => 1 : singletons
+our %NonStD; # $codepoint => 1 : non-starter decompositions
+
+our %Comp1st; # $codepoint => $listname : may be composed with a next char.
+our %Comp2nd; # $codepoint => 1 : may be composed with a prev char.
+our %CompList; # $listname,$2nd => $codepoint : composite
+
+our $prefix = "UNF_";
+our $structname = "${prefix}complist";
+
+########## definition of Hangul constants ##########
+use constant SBase => 0xAC00;
+use constant SFinal => 0xD7A3; # SBase -1 + SCount
+use constant SCount => 11172; # LCount * NCount
+use constant NCount => 588; # VCount * TCount
+use constant LBase => 0x1100;
+use constant LFinal => 0x1112;
+use constant LCount => 19;
+use constant VBase => 0x1161;
+use constant VFinal => 0x1175;
+use constant VCount => 21;
+use constant TBase => 0x11A7;
+use constant TFinal => 0x11C2;
+use constant TCount => 28;
+
+sub decomposeHangul {
+ my $SIndex = $_[0] - SBase;
+ my $LIndex = int( $SIndex / NCount);
+ my $VIndex = int(($SIndex % NCount) / TCount);
+ my $TIndex = $SIndex % TCount;
+ my @ret = (
+ LBase + $LIndex,
+ VBase + $VIndex,
+ $TIndex ? (TBase + $TIndex) : (),
+ );
+ wantarray ? @ret : pack('U*', @ret);
+ # any element in @ret greater than 0xFF, so no need of u2n conversion.
+}
+########## getting full decomposion ##########
{
- my($f, $fh);
- foreach my $d (@INC) {
- use File::Spec;
- $f = File::Spec->catfile($d, "unicore", "CompositionExclusions.txt");
- last if open($fh, $f);
- $f = File::Spec->catfile($d, "unicode", "CompExcl.txt");
- last if open($fh, $f);
- $f = undef;
- }
- croak "$PACKAGE: CompExcl.txt not found in @INC" unless defined $f;
- while(<$fh>) {
- next if /^#/ or /^$/;
- s/#.*//;
- $Exclus{ hex($1) } =1 if /([0-9A-Fa-f]+)/;
- }
- close $fh;
-}
+ my($f, $fh);
+ foreach my $d (@INC) {
+ $f = File::Spec->catfile($d, "unicore", "CompositionExclusions.txt");
+ last if open($fh, $f);
+ $f = File::Spec->catfile($d, "unicode", "CompExcl.txt");
+ last if open($fh, $f);
+ $f = undef;
+ }
+ croak "$PACKAGE: neither unicore/CompositionExclusions.txt "
+ . "nor unicode/CompExcl.txt is found in @INC" unless defined $f;
-while($Combin =~ /(.+)/g) {
- my @tab = split /\t/, $1;
- my $ini = hex $tab[0];
- if($tab[1] eq '') {
- $Combin{ $ini } = $tab[2];
- } else {
- $Combin{ $_ } = $tab[2] foreach $ini .. hex($tab[1]);
- }
+ while (<$fh>) {
+ next if /^#/ or /^$/;
+ s/#.*//;
+ $Exclus{ hex($1) } = 1 if /([0-9A-Fa-f]+)/;
+ }
+ close $fh;
}
-while($Decomp =~ /(.+)/g) {
- my @tab = split /\t/, $1;
- my $compat = $tab[2] =~ s/<[^>]+>//;
- my $dec = [ _getHexArray($tab[2]) ]; # decomposition
- my $com = pack('U*', @$dec); # composable sequence
- my $ini = hex($tab[0]);
- if($tab[1] eq '') {
- $Compat{ $ini } = $dec;
- if(! $compat) {
- $Canon{ $ini } = $dec;
- $Compos{ $com } = $ini if @$dec > 1;
+##
+## converts string "hhhh hhhh hhhh" to a numeric list
+##
+sub _getHexArray { map hex, $_[0] =~ /([0-9A-Fa-f]+)/g }
+
+while ($Combin =~ /(.+)/g) {
+ my @tab = split /\t/, $1;
+ my $ini = hex $tab[0];
+ if ($tab[1] eq '') {
+ $Combin{ $ini } = $tab[2];
+ } else {
+ $Combin{ $_ } = $tab[2] foreach $ini .. hex($tab[1]);
}
- } else {
- foreach my $u ($ini .. hex($tab[1])){
- $Compat{ $u } = $dec;
- if(! $compat){
- $Canon{ $u } = $dec;
- $Compos{ $com } = $ini if @$dec > 1;
- }
- }
- }
}
-# exhaustive decomposition
-foreach my $key (keys %Canon) {
- $Canon{$key} = [ getCanonList($key) ];
+while ($Decomp =~ /(.+)/g) {
+ my @tab = split /\t/, $1;
+ my $compat = $tab[2] =~ s/<[^>]+>//;
+ my $dec = [ _getHexArray($tab[2]) ]; # decomposition
+ my $ini = hex($tab[0]); # initial decomposable character
+
+ my $listname =
+ @$dec == 2 ? sprintf("${structname}_%06x", $dec->[0]) : 'USELESS';
+ # %04x is bad since it'd place _3046 after _1d157.
+
+ if ($tab[1] eq '') {
+ $Compat{ $ini } = $dec;
+
+ if (! $compat) {
+ $Canon{ $ini } = $dec;
+
+ if (@$dec == 2) {
+ if ($Combin{ $dec->[0] }) {
+ $NonStD{ $ini } = 1;
+ } else {
+ $CompList{ $listname }{ $dec->[1] } = $ini;
+ $Comp1st{ $dec->[0] } = $listname;
+ $Comp2nd{ $dec->[1] } = 1 if ! $Exclus{$ini};
+ }
+ } elsif (@$dec == 1) {
+ $Single{ $ini } = 1;
+ } else {
+ croak("Weird Canonical Decomposition of U+$tab[0]");
+ }
+ }
+ } else {
+ foreach my $u ($ini .. hex($tab[1])) {
+ $Compat{ $u } = $dec;
+
+ if (! $compat) {
+ $Canon{ $u } = $dec;
+
+ if (@$dec == 2) {
+ if ($Combin{ $dec->[0] }) {
+ $NonStD{ $u } = 1;
+ } else {
+ $CompList{ $listname }{ $dec->[1] } = $u;
+ $Comp1st{ $dec->[0] } = $listname;
+ $Comp2nd{ $dec->[1] } = 1 if ! $Exclus{$u};
+ }
+ } elsif (@$dec == 1) {
+ $Single{ $u } = 1;
+ } else {
+ croak("Weird Canonical Decomposition of U+$tab[0]");
+ }
+ }
+ }
+ }
}
-# exhaustive decomposition
-foreach my $key (keys %Compat) {
- $Compat{$key} = [ getCompatList($key) ];
+# modern HANGUL JUNGSEONG and HANGUL JONGSEONG jamo
+foreach my $j (0x1161..0x1175, 0x11A8..0x11C2) {
+ $Comp2nd{$j} = 1;
}
sub getCanonList {
- my @src = @_;
- my @dec = map $Canon{$_} ? @{ $Canon{$_} } : $_, @src;
- join(" ",@src) eq join(" ",@dec) ? @dec : getCanonList(@dec);
- # condition @src == @dec is not ok.
+ my @src = @_;
+ my @dec = map {
+ (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
+ : $Canon{$_} ? @{ $Canon{$_} } : $_
+ } @src;
+ return join(" ",@src) eq join(" ",@dec) ? @dec : getCanonList(@dec);
+ # condition @src == @dec is not ok.
}
sub getCompatList {
- my @src = @_;
- my @dec = map $Compat{$_} ? @{ $Compat{$_} } : $_, @src;
- join(" ",@src) eq join(" ",@dec) ? @dec : getCompatList(@dec);
- # condition @src == @dec is not ok.
+ my @src = @_;
+ my @dec = map {
+ (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
+ : $Compat{$_} ? @{ $Compat{$_} } : $_
+ } @src;
+ return join(" ",@src) eq join(" ",@dec) ? @dec : getCompatList(@dec);
+ # condition @src == @dec is not ok.
}
-sub _getHexArray {
- my $str = shift;
- map hex(), $str =~ /([0-9A-Fa-f]+)/g;
+# exhaustive decomposition
+foreach my $key (keys %Canon) {
+ $Canon{$key} = [ getCanonList($key) ];
}
-sub _U_stringify {
- sprintf '"%s"', join '',
- map sprintf("\\x%02x", $_), unpack 'C*', pack 'U*', @_;
+# exhaustive decomposition
+foreach my $key (keys %Compat) {
+ $Compat{$key} = [ getCompatList($key) ];
}
-foreach my $hash (\%Canon, \%Compat) {
- foreach my $key (keys %$hash) {
- $hash->{$key} = _U_stringify( @{ $hash->{$key} } );
- }
+sub _pack_U {
+ return pack('U*', @_);
}
-my $prefix = "UNF_";
-
-my $structname = "${prefix}complist";
-
-our (%Comp1st, %CompList);
-
-foreach(sort keys %Compos) {
- my @a = unpack('U*', $_);
- my $val = $Compos{$_};
- my $name = sprintf "${structname}_%06x", $a[0];
- $Comp1st{ $a[0] } = $name;
- $CompList{ $name }{ $a[1] } = $val;
+sub _U_stringify {
+ sprintf '"%s"', join '',
+ map sprintf("\\x%02x", $_), unpack 'C*', _pack_U(@_);
}
-my $compinit =
- "typedef struct { UV nextchar; UV composite; } $structname;\n\n";
-
-foreach my $i (sort keys %CompList) {
- $compinit .= "$structname $i [] = {\n";
- $compinit .= join ",\n",
- map sprintf("\t{ %d, %d }", $_, $CompList{$i}{$_}),
- sort {$a <=> $b } keys %{ $CompList{$i} };
- $compinit .= ",\n{0,0}\n};\n\n"; # with sentinel
+foreach my $hash (\%Canon, \%Compat) {
+ foreach my $key (keys %$hash) {
+ $hash->{$key} = _U_stringify( @{ $hash->{$key} } );
+ }
}
-####################################
-
-my @Exclus = sort {$a <=> $b} keys %Exclus;
+########## writing header files ##########
+
+my @boolfunc = (
+ {
+ name => "Exclusion",
+ type => "bool",
+ hash => \%Exclus,
+ },
+ {
+ name => "Singleton",
+ type => "bool",
+ hash => \%Single,
+ },
+ {
+ name => "NonStDecomp",
+ type => "bool",
+ hash => \%NonStD,
+ },
+ {
+ name => "Comp2nd",
+ type => "bool",
+ hash => \%Comp2nd,
+ },
+);
my $file = "unfexc.h";
open FH, ">$file" or croak "$PACKAGE: $file can't be made";
binmode FH; select FH;
-print "bool isExclusion (UV uv) \n{\nreturn\n\t";
+ print << 'EOF';
+/*
+ * This file is auto-generated by mkheader.
+ * Any changes here will be lost!
+ */
+EOF
-while(@Exclus) {
- my $cur = shift @Exclus;
- if(@Exclus && $cur + 1 == $Exclus[0]) {
- print "($cur <= uv && uv <= ";
- while(@Exclus && $cur + 1 == $Exclus[0]) {
- $cur = shift @Exclus;
+foreach my $tbl (@boolfunc) {
+ my @temp = sort {$a <=> $b} keys %{$tbl->{hash}};
+ my $type = $tbl->{type};
+ my $name = $tbl->{name};
+ print "$type is$name (UV uv)\n{\nreturn\n\t";
+
+ while (@temp) {
+ my $cur = shift @temp;
+ if (@temp && $cur + 1 == $temp[0]) {
+ print "($cur <= uv && uv <= ";
+ while (@temp && $cur + 1 == $temp[0]) {
+ $cur = shift @temp;
+ }
+ print "$cur)";
+ print "\n\t|| " if @temp;
+ } else {
+ print "uv == $cur";
+ print "\n\t|| " if @temp;
+ }
}
- print "$cur)";
- print "\n\t|| " if @Exclus;
- } else {
- print "uv == $cur";
- print "\n\t|| " if @Exclus;
- }
+ print "\n\t? TRUE : FALSE;\n}\n\n";
}
-print "\n\t? TRUE : FALSE;\n}\n\n";
close FH;
####################################
+my $compinit =
+ "typedef struct { UV nextchar; UV composite; } $structname;\n\n";
+
+foreach my $i (sort keys %CompList) {
+ $compinit .= "$structname $i [] = {\n";
+ $compinit .= join ",\n",
+ map sprintf("\t{ %d, %d }", $_, $CompList{$i}{$_}),
+ sort {$a <=> $b } keys %{ $CompList{$i} };
+ $compinit .= ",\n{0,0}\n};\n\n"; # with sentinel
+}
+
my @tripletable = (
- {
- file => "unfcmb",
- name => "combin",
- type => "STDCHAR",
- hash => \%Combin,
- null => 0,
- },
- {
- file => "unfcan",
- name => "canon",
- type => "char*",
- hash => \%Canon,
- null => "NULL",
- },
- {
- file => "unfcpt",
- name => "compat",
- type => "char*",
- hash => \%Compat,
- null => "NULL",
- },
- {
- file => "unfcmp",
- name => "compos",
- type => "$structname *",
- hash => \%Comp1st,
- null => "NULL",
- init => $compinit,
- },
+ {
+ file => "unfcmb",
+ name => "combin",
+ type => "STDCHAR",
+ hash => \%Combin,
+ null => 0,
+ },
+ {
+ file => "unfcan",
+ name => "canon",
+ type => "char*",
+ hash => \%Canon,
+ null => "NULL",
+ },
+ {
+ file => "unfcpt",
+ name => "compat",
+ type => "char*",
+ hash => \%Compat,
+ null => "NULL",
+ },
+ {
+ file => "unfcmp",
+ name => "compos",
+ type => "$structname *",
+ hash => \%Comp1st,
+ null => "NULL",
+ init => $compinit,
+ },
);
foreach my $tbl (@tripletable) {
- my $file = "$tbl->{file}.h";
- my $head = "${prefix}$tbl->{name}";
- my $type = $tbl->{type};
- my $hash = $tbl->{hash};
- my $null = $tbl->{null};
- my $init = $tbl->{init};
-
- open FH, ">$file" or croak "$PACKAGE: $file can't be made";
- binmode FH; select FH;
- my %val;
-
- print FH << 'EOF';
+ my $file = "$tbl->{file}.h";
+ my $head = "${prefix}$tbl->{name}";
+ my $type = $tbl->{type};
+ my $hash = $tbl->{hash};
+ my $null = $tbl->{null};
+ my $init = $tbl->{init};
+
+ open FH, ">$file" or croak "$PACKAGE: $file can't be made";
+ binmode FH; select FH;
+ my %val;
+
+ print FH << 'EOF';
/*
* This file is auto-generated by mkheader.
* Any changes here will be lost!
*/
EOF
- print $init if defined $init;
-
- foreach my $uv (keys %$hash) {
- my @c = unpack 'CCCC', pack 'N', $uv;
- $val{ $c[1] }{ $c[2] }{ $c[3] } = $hash->{$uv};
- }
-
- foreach my $p (sort { $a <=> $b } keys %val) {
- next if ! $val{ $p };
- for(my $r = 0; $r < 256; $r++){
- next if ! $val{ $p }{ $r };
- printf "$type ${head}_%02x_%02x [256] = {\n", $p, $r;
- for(my $c = 0; $c < 256; $c++){
- print "\t", defined $val{$p}{$r}{$c} ? "($type)".$val{$p}{$r}{$c} : $null;
- print ',' if $c != 255;
- print "\n" if $c % 8 == 7;
- }
- print "};\n\n";
+ print $init if defined $init;
+
+ foreach my $uv (keys %$hash) {
+ croak sprintf("a Unicode code point 0x%04X over 0x10FFFF.", $uv)
+ unless $uv <= 0x10FFFF;
+ my @c = unpack 'CCCC', pack 'N', $uv;
+ $val{ $c[1] }{ $c[2] }{ $c[3] } = $hash->{$uv};
+ }
+
+ foreach my $p (sort { $a <=> $b } keys %val) {
+ next if ! $val{ $p };
+ for (my $r = 0; $r < 256; $r++) {
+ next if ! $val{ $p }{ $r };
+ printf "$type ${head}_%02x_%02x [256] = {\n", $p, $r;
+ for (my $c = 0; $c < 256; $c++) {
+ print "\t", defined $val{$p}{$r}{$c}
+ ? "($type)".$val{$p}{$r}{$c}
+ : $null;
+ print ',' if $c != 255;
+ print "\n" if $c % 8 == 7;
+ }
+ print "};\n\n";
+ }
+ }
+ foreach my $p (sort { $a <=> $b } keys %val) {
+ next if ! $val{ $p };
+ printf "$type* ${head}_%02x [256] = {\n", $p;
+ for (my $r = 0; $r < 256; $r++) {
+ print $val{ $p }{ $r }
+ ? sprintf("${head}_%02x_%02x", $p, $r)
+ : "NULL";
+ print ',' if $r != 255;
+ print "\n" if $val{ $p }{ $r } || ($r+1) % 8 == 0;
+ }
+ print "};\n\n";
}
- }
- foreach my $p (sort { $a <=> $b } keys %val) {
- next if ! $val{ $p };
- printf "$type* ${head}_%02x [256] = {\n", $p;
- for(my $r = 0; $r < 256; $r++){
- print $val{ $p }{ $r } ? sprintf("${head}_%02x_%02x", $p, $r) : "NULL";
- print ',' if $r != 255;
- print "\n" if $val{ $p }{ $r } || ($r+1) % 8 == 0;
+ print "$type** $head [] = {\n";
+ for (my $p = 0; $p <= 0x10; $p++) {
+ print $val{ $p } ? sprintf("${head}_%02x", $p) : "NULL";
+ print ',' if $p != 0x10;
+ print "\n";
}
print "};\n\n";
- }
- print "$type** $head [] = {\n";
- for(my $p = 0; $p <= 0x10; $p++){
- print $val{ $p } ? sprintf("${head}_%02x", $p) : "NULL";
- print ',' if $p != 0x10;
- print "\n";
- }
- print "};\n\n";
- close FH;
+ close FH;
}
+1;
__END__
https://perl5.git.perl.org / perl5.git / blobdiff