1#!perl -w 2use 5.015; 3use strict; 4use warnings; 5use Unicode::UCD qw(prop_aliases 6 prop_values 7 prop_value_aliases 8 prop_invlist 9 prop_invmap search_invlist 10 charprop 11 num 12 charblock 13 ); 14use constant DEBUG => $ENV{DEBUG} // 0; 15require './regen/regen_lib.pl'; 16require './regen/charset_translations.pl'; 17require './lib/unicore/UCD.pl'; 18require './regen/mph.pl'; 19use re "/aa"; 20 21print "Starting...\n" if DEBUG; 22 23# This program outputs charclass_invlists.h, which contains various inversion 24# lists in the form of C arrays that are to be used as-is for inversion lists. 25# Thus, the lists it contains are essentially pre-compiled, and need only a 26# light-weight fast wrapper to make them usable at run-time. 27 28# As such, this code knows about the internal structure of these lists, and 29# any change made to that has to be done here as well. A random number stored 30# in the headers is used to minimize the possibility of things getting 31# out-of-sync, or the wrong data structure being passed. Currently that 32# random number is: 33 34my $VERSION_DATA_STRUCTURE_TYPE = 148565664; 35 36# charclass_invlists.h now also contains inversion maps and enum definitions 37# for those maps that have a finite number of possible values 38 39# integer or float (no exponent) 40my $integer_or_float_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x; 41 42# Also includes rationals 43my $numeric_re = qr! $integer_or_float_re | ^ -? \d+ / \d+ $ !x; 44 45# More than one code point may have the same code point as their fold. This 46# gives the maximum number in the current Unicode release. (The folded-to 47# code point is not included in this count.) Most folds are pairs of code 48# points, like 'B' and 'b', so this number is at least one. 49my $max_fold_froms = 1; 50 51my %keywords; 52my $table_name_prefix = "UNI_"; 53 54# Matches valid C language enum names: begins with ASCII alphabetic, then any 55# ASCII \w 56my $enum_name_re = qr / ^ [[:alpha:]] \w* $ /ax; 57 58my $out_fh = open_new('charclass_invlists.h', '>', 59 {style => '*', by => 'regen/mk_invlists.pl', 60 from => "Unicode::UCD"}); 61 62my $in_file_pound_if = ""; 63 64my $max_hdr_len = 3; # In headings, how wide a name is allowed? 65 66print $out_fh "/* See the generating file for comments */\n\n"; 67 68print $out_fh <<'EOF'; 69/* This gives the number of code points that can be in the bitmap of an ANYOF 70 * node. The shift number must currently be one of: 8..12. It can't be less 71 * than 8 (256) because some code relies on it being at least that. Above 12 72 * (4096), and you start running into warnings that some data structure widths 73 * have been exceeded, though the test suite as of this writing still passes 74 * for up through 16, which is as high as anyone would ever want to go, 75 * encompassing all of the Unicode BMP, and thus including all the economically 76 * important world scripts. At 12 most of them are: including Arabic, 77 * Cyrillic, Greek, Hebrew, Indian subcontinent, Latin, and Thai; but not Han, 78 * Japanese, nor Korean. The regnode sizing data structure in regnodes.h currently 79 * uses a U8, and the trie types TRIEC and AHOCORASICKC are larger than U8 for 80 * shift values above 12.) Be sure to benchmark before changing, as larger sizes 81 * do significantly slow down the test suite. */ 82 83EOF 84 85my $num_anyof_code_points = '(1 << 8)'; 86 87print $out_fh "#define NUM_ANYOF_CODE_POINTS $num_anyof_code_points\n\n"; 88 89$num_anyof_code_points = eval $num_anyof_code_points; 90 91no warnings 'once'; 92print $out_fh <<"EOF"; 93/* The precision to use in "%.*e" formats */ 94#define PL_E_FORMAT_PRECISION $Unicode::UCD::e_precision 95EOF 96 97# enums that should be made public 98my %public_enums = ( 99 _Perl_SCX => 1 100 ); 101 102# The symbols generated by this program are all currently defined only in a 103# single dot c each. The code knows where most of them go, but this hash 104# gives overrides for the exceptions to the typical place 105my %exceptions_to_where_to_define = 106 ( 107 #_Perl_IVCF => 'PERL_IN_REGCOMP_C', 108 ); 109 110my %where_to_define_enums = (); 111 112my $applies_to_all_charsets_text = "all charsets"; 113 114my %gcb_enums; 115my @gcb_short_enums; 116my %gcb_abbreviations; 117my %lb_enums; 118my @lb_short_enums; 119my %lb_abbreviations; 120my %wb_enums; 121my @wb_short_enums; 122my %wb_abbreviations; 123 124my @a2n; 125 126my %prop_name_aliases; 127# Invert this hash so that for each canonical name, we get a list of things 128# that map to it (excluding itself) 129foreach my $name (sort keys %Unicode::UCD::loose_property_name_of) { 130 my $canonical = $Unicode::UCD::loose_property_name_of{$name}; 131 push @{$prop_name_aliases{$canonical}}, $name if $canonical ne $name; 132} 133 134# Output these tables in the same vicinity as each other, so that will get 135# paged in at about the same time. These are also assumed to be the exact 136# same list as those properties used internally by perl. 137my %keep_together = ( 138 assigned => 1, 139 ascii => 1, 140 upper => 1, 141 lower => 1, 142 title => 1, 143 cased => 1, 144 uppercaseletter => 1, 145 lowercaseletter => 1, 146 titlecaseletter => 1, 147 casedletter => 1, 148 vertspace => 1, 149 xposixalnum => 1, 150 xposixalpha => 1, 151 xposixblank => 1, 152 xposixcntrl => 1, 153 xposixdigit => 1, 154 xposixgraph => 1, 155 xposixlower => 1, 156 xposixprint => 1, 157 xposixpunct => 1, 158 xposixspace => 1, 159 xposixupper => 1, 160 xposixword => 1, 161 xposixxdigit => 1, 162 posixalnum => 1, 163 posixalpha => 1, 164 posixblank => 1, 165 posixcntrl => 1, 166 posixdigit => 1, 167 posixgraph => 1, 168 posixlower => 1, 169 posixprint => 1, 170 posixpunct => 1, 171 posixspace => 1, 172 posixupper => 1, 173 posixword => 1, 174 posixxdigit => 1, 175 _perl_any_folds => 1, 176 _perl_folds_to_multi_char => 1, 177 _perl_is_in_multi_char_fold => 1, 178 _perl_non_final_folds => 1, 179 _perl_idstart => 1, 180 _perl_idcont => 1, 181 _perl_charname_begin => 1, 182 _perl_charname_continue => 1, 183 _perl_problematic_locale_foldeds_start => 1, 184 _perl_problematic_locale_folds => 1, 185 _perl_quotemeta => 1, 186 ); 187my %perl_tags; # So can find synonyms of the above properties 188 189my $unused_table_hdr = 'u'; # Heading for row or column for unused values 190 191sub uniques { 192 # Returns non-duplicated input values. From "Perl Best Practices: 193 # Encapsulated Cleverness". p. 455 in first edition. 194 195 my %seen; 196 return grep { ! $seen{$_}++ } @_; 197} 198 199sub caselessly { lc $a cmp lc $b } 200 201sub a2n($) { 202 my $cp = shift; 203 204 # Returns the input Unicode code point translated to native. 205 206 return $cp if $cp !~ $integer_or_float_re || $cp > 255; 207 return $a2n[$cp]; 208} 209 210sub end_file_pound_if { 211 if ($in_file_pound_if) { 212 print $out_fh "\n#endif\t/* $in_file_pound_if */\n"; 213 $in_file_pound_if = ""; 214 } 215} 216 217sub end_charset_pound_if { 218 print $out_fh "\n" . get_conditional_compile_line_end(); 219} 220 221sub switch_pound_if ($$;$) { 222 my $name = shift; 223 my $new_pound_if = shift; 224 my $charset = shift; 225 226 my @new_pound_if = ref ($new_pound_if) 227 ? sort @$new_pound_if 228 : $new_pound_if; 229 230 # Switch to new #if given by the 2nd argument. If there is an override 231 # for this, it instead switches to that. The 1st argument is the 232 # static's name, used only to check if there is an override for this 233 # 234 # The 'charset' parmameter, if present, is used to first end the charset 235 # #if if we actually do a switch, and then restart it afterwards. This 236 # code, then assumes that the charset #if's are enclosed in the file ones. 237 238 if (exists $exceptions_to_where_to_define{$name}) { 239 @new_pound_if = $exceptions_to_where_to_define{$name}; 240 } 241 242 foreach my $element (@new_pound_if) { 243 244 # regcomp.c is arranged so that the tables are not compiled in 245 # re_comp.c, but general enums and defines (which take no space) are 246 # compiled */ 247 my $no_xsub = 1 if $name !~ /enum|define/ 248 && $element =~ / PERL_IN_ (?: REGCOMP ) _C /x; 249 $element = "defined($element)"; 250 $element = "($element && ! defined(PERL_IN_XSUB_RE))" if $no_xsub; 251 } 252 $new_pound_if = join " || ", @new_pound_if; 253 254 # Change to the new one if different from old 255 if ($in_file_pound_if ne $new_pound_if) { 256 257 end_charset_pound_if() if defined $charset; 258 259 # Exit any current #if 260 if ($in_file_pound_if) { 261 end_file_pound_if; 262 } 263 264 $in_file_pound_if = $new_pound_if; 265 print $out_fh "\n#if $in_file_pound_if\n"; 266 267 start_charset_pound_if ($charset, 1) if defined $charset; 268 } 269} 270 271sub start_charset_pound_if ($;$) { 272 print $out_fh "\n" . get_conditional_compile_line_start(shift, shift); 273} 274 275{ # Closure 276 my $fh; 277 my $in_doinit = 0; 278 279 sub output_table_header($$$;$@) { 280 281 # Output to $fh the heading for a table given by the other inputs 282 283 $fh = shift; 284 my ($type, # typedef of table, like UV, UV* 285 $name, # name of table 286 $comment, # Optional comment to put on header line 287 @sizes # Optional sizes of each array index. If omitted, 288 # there is a single index whose size is computed by 289 # the C compiler. 290 ) = @_; 291 292 $type =~ s/ \s+ $ //x; 293 294 # If a the typedef is a ptr, add in an extra const 295 $type .= " const" if $type =~ / \* $ /x; 296 297 $comment = "" unless defined $comment; 298 $comment = " /* $comment */" if $comment; 299 300 my $array_declaration; 301 if (@sizes) { 302 $array_declaration = ""; 303 $array_declaration .= "[$_]" for @sizes; 304 } 305 else { 306 $array_declaration = '[]'; 307 } 308 309 my $declaration = "$type ${name}$array_declaration"; 310 311 # Things not matching this are static. Otherwise, it is an external 312 # constant, initialized only under DOINIT. 313 # 314 # (Currently everything is static) 315 if ($in_file_pound_if !~ / PERL_IN_ (?: ) _C /x) { 316 $in_doinit = 0; 317 print $fh "\nstatic const $declaration = {$comment\n"; 318 } 319 else { 320 $in_doinit = 1; 321 print $fh <<EOF; 322 323# ifndef DOINIT 324 325EXTCONST $declaration; 326 327# else 328 329EXTCONST $declaration = {$comment 330EOF 331 } 332 } 333 334 sub output_table_trailer() { 335 336 # Close out a table started by output_table_header() 337 338 print $fh "};\n"; 339 if ($in_doinit) { 340 print $fh "\n# endif /* DOINIT */\n\n"; 341 $in_doinit = 0; 342 } 343 } 344} # End closure 345 346 347sub output_invlist ($$;$) { 348 my $name = shift; 349 my $invlist = shift; # Reference to inversion list array 350 my $charset = shift // ""; # name of character set for comment 351 352 print " output_invlist($name) $charset\n" if DEBUG; 353 354 die "No inversion list for $name" unless defined $invlist 355 && ref $invlist eq 'ARRAY'; 356 357 # Output the inversion list $invlist using the name $name for it. 358 # It is output in the exact internal form for inversion lists. 359 360 # Is the last element of the header 0, or 1 ? 361 my $zero_or_one = 0; 362 if (@$invlist && $invlist->[0] != 0) { 363 unshift @$invlist, 0; 364 $zero_or_one = 1; 365 } 366 367 $charset = "for $charset" if $charset; 368 output_table_header($out_fh, "UV", "${name}_invlist", $charset); 369 370 my $count = @$invlist; 371 print $out_fh <<EOF; 372\t$count,\t/* Number of elements */ 373\t$VERSION_DATA_STRUCTURE_TYPE, /* Version and data structure type */ 374\t$zero_or_one,\t/* 0 if the list starts at 0; 375\t\t 1 if it starts at the element beyond 0 */ 376EOF 377 378 # The main body are the UVs passed in to this routine. Do the final 379 # element separately 380 for my $i (0 .. @$invlist - 1) { 381 printf $out_fh "\t0x%X", $invlist->[$i]; 382 print $out_fh "," if $i < @$invlist - 1; 383 print $out_fh "\n"; 384 } 385 386 output_table_trailer(); 387} 388 389sub output_invmap ($$$$$$$) { 390 my $name = shift; 391 my $invmap = shift; # Reference to inversion map array 392 my $prop_name = shift; 393 my $input_format = shift; # The inversion map's format 394 my $default = shift; # The property value for code points who 395 # otherwise don't have a value specified. 396 my $extra_enums = shift; # comma-separated list of our additions to the 397 # property's standard possible values 398 my $charset = shift // ""; # name of character set for comment 399 400 print " output_invmap($name,$prop_name) $charset\n" if DEBUG; 401 402 # Output the inversion map $invmap for property $prop_name, but use $name 403 # as the actual data structure's name. 404 405 my $count = @$invmap; 406 407 my $output_format; 408 my $invmap_declaration_type; 409 my $enum_declaration_type; 410 my $aux_declaration_type; 411 my %enums; 412 my $name_prefix; 413 414 if ($input_format =~ / ^ [as] l? $ /x) { 415 $prop_name = (prop_aliases($prop_name))[1] 416 // $prop_name =~ s/^_Perl_//r; # Get full name 417 my $short_name = (prop_aliases($prop_name))[0] // $prop_name; 418 my @input_enums; 419 420 # Find all the possible input values. These become the enum names 421 # that comprise the inversion map. For inputs that don't have sub 422 # lists, we can just get the unique values. Otherwise, we have to 423 # expand the sublists first. 424 if ($input_format !~ / ^ a /x) { 425 if ($input_format ne 'sl') { 426 @input_enums = sort caselessly uniques(@$invmap); 427 } 428 else { 429 foreach my $element (@$invmap) { 430 if (ref $element) { 431 push @input_enums, @$element; 432 } 433 else { 434 push @input_enums, $element; 435 } 436 } 437 @input_enums = sort caselessly uniques(@input_enums); 438 } 439 } 440 441 # The internal enums come last, and in the order specified. 442 # 443 # The internal one named EDGE is also used a marker. Any ones that 444 # come after it are used in the algorithms below, and so must be 445 # defined, even if the release of Unicode this is being compiled for 446 # doesn't use them. But since no code points are assigned to them in 447 # such a release, those values will never be accessed. We collapse 448 # all of them into a single placholder row and a column. The 449 # algorithms below will fill in those cells with essentially garbage, 450 # but they are never read, so it doesn't matter. This allows the 451 # algorithm to remain the same from release to release. 452 # 453 # In one case, regexec.c also uses a placeholder which must be defined 454 # here, and we put it in the unused row and column as its value is 455 # never read. 456 # 457 my @enums = @input_enums; 458 my @extras; 459 my @unused_enums; 460 my $unused_enum_value = @enums; 461 if ($extra_enums ne "") { 462 @extras = split /,/, $extra_enums; 463 my $seen_EDGE = 0; 464 465 # Don't add if already there. 466 foreach my $this_extra (@extras) { 467 next if grep { $_ eq $this_extra } @enums; 468 if ($this_extra eq 'EDGE') { 469 push @enums, $this_extra; 470 $seen_EDGE = 1; 471 } 472 elsif ($seen_EDGE) { 473 push @unused_enums, $this_extra; 474 } 475 else { 476 push @enums, $this_extra; 477 } 478 } 479 480 @unused_enums = sort caselessly @unused_enums; 481 $unused_enum_value = @enums; # All unused have the same value, 482 # one beyond the final used one 483 } 484 485 # These properties have extra tables written out for them that we want 486 # to make as compact and legible as possible. So we find short names 487 # for their property values. For non-official ones we will need to 488 # add a legend at the top of the table to say what the abbreviation 489 # stands for. 490 my $property_needs_table_re = qr/ ^ _Perl_ (?: GCB | LB | WB ) $ /x; 491 492 my %short_enum_name; 493 my %need_explanation; # For non-official abbreviations, we will need 494 # to explain what the one we come up with 495 # stands for 496 my $type = lc $prop_name; 497 if ($name =~ $property_needs_table_re) { 498 my @short_names; # List of already used abbreviations, so we 499 # don't duplicate 500 for my $enum (@enums) { 501 my $short_enum; 502 my $is_official_name = 0; 503 504 # Special case this wb property value to make the 505 # name more clear 506 if ($enum eq 'Perl_Tailored_HSpace') { 507 $short_enum = 'hs'; 508 } 509 else { 510 511 # Use the official short name, if found. 512 ($short_enum) = prop_value_aliases($type, $enum); 513 if ( defined $short_enum) { 514 $is_official_name = 1; 515 } 516 else { 517 # But if there is no official name, use the name that 518 # came from the data (if any). Otherwise, the name 519 # had to come from the extras list. There are two 520 # types of values in that list. 521 # 522 # First are those enums that are not part of the 523 # property, but are defined by the code in this file. 524 # By convention these have all-caps names. We use the 525 # lowercased name for these. 526 # 527 # Second are enums that are needed to get the 528 # algorithms below to work and/or to get regexec.c to 529 # compile, but don't exist in all Unicode releases. 530 # These are handled outside this loop as 531 # 'unused_enums' (as they are unused they all get 532 # collapsed into a single column, and their names 533 # don't matter) 534 if (grep { $_ eq $enum } @input_enums) { 535 $short_enum = $enum 536 } 537 else { 538 $short_enum = lc $enum; 539 } 540 } 541 542 # If our short name is too long, or we already know that 543 # the name is an abbreviation, truncate to make sure it's 544 # short enough, and remember that we did this so we can 545 # later add a comment in the generated file 546 if (length $short_enum > $max_hdr_len) { 547 # First try using just the uppercase letters of the name; 548 # if it is something like FooBar, FB is a better 549 # abbreviation than Foo. That's not the case if it is 550 # entirely lowercase. 551 my $uc = $short_enum; 552 $uc =~ s/[[:^upper:]]//g; 553 $short_enum = $uc if length $uc > 1 554 && length $uc < length $short_enum; 555 556 $short_enum = substr($short_enum, 0, $max_hdr_len); 557 $is_official_name = 0; 558 } 559 } 560 561 # If the name we are to display conflicts, try another. 562 if (grep { $_ eq $short_enum } @short_names) { 563 $is_official_name = 0; 564 do { # The increment operator on strings doesn't work on 565 # those containing an '_', so get rid of any final 566 # portion. 567 $short_enum =~ s/_//g; 568 $short_enum++; 569 } while grep { $_ eq $short_enum } @short_names; 570 } 571 572 push @short_names, $short_enum; 573 $short_enum_name{$enum} = $short_enum; 574 $need_explanation{$enum} = $short_enum unless $is_official_name; 575 } 576 } # End of calculating short enum names for certain properties 577 578 # Assign a value to each element of the enum type we are creating. 579 # The default value always gets 0; the others are arbitrarily 580 # assigned, but for the properties which have the extra table, it is 581 # in the order we have computed above so the rows and columns appear 582 # alphabetically by heading abbreviation. 583 my $enum_val = 0; 584 my $canonical_default = prop_value_aliases($prop_name, $default); 585 $default = $canonical_default if defined $canonical_default; 586 $enums{$default} = $enum_val++; 587 588 for my $enum (sort { ($name =~ $property_needs_table_re) 589 ? lc $short_enum_name{$a} 590 cmp lc $short_enum_name{$b} 591 : lc $a cmp lc $b 592 } @enums) 593 { 594 $enums{$enum} = $enum_val++ unless exists $enums{$enum}; 595 } 596 597 # Now calculate the data for the special tables output for these 598 # properties. 599 if ($name =~ $property_needs_table_re) { 600 601 # The data includes the hashes %gcb_enums, %lb_enums, etc. 602 # Similarly we calculate column headings for the tables. 603 # 604 # We use string evals to allow the same code to work on 605 # all the tables 606 607 # Skip if we've already done this code, which populated 608 # this hash 609 if (eval "! \%${type}_enums") { 610 611 # For each enum in the type ... 612 foreach my $enum (keys %enums) { 613 my $value = $enums{$enum}; 614 my $short_enum = $short_enum_name{$enum}; 615 616 # Remember the mapping from the property value 617 # (enum) name to its value. 618 eval "\$${type}_enums{$enum} = $value"; 619 die $@ if $@; 620 621 # Remember the inverse mapping to the short name 622 # so that we can properly label the generated 623 # table's rows and columns 624 eval "\$${type}_short_enums[$value] = '$short_enum'"; 625 die $@ if $@; 626 627 # And note the abbreviations that need explanation 628 if ($need_explanation{$enum}) { 629 eval "\$${type}_abbreviations{$short_enum} = '$enum'"; 630 die $@ if $@; 631 } 632 } 633 634 # Each unused enum has the same value. They all are collapsed 635 # into one row and one column, named $unused_table_hdr. 636 if (@unused_enums) { 637 eval "\$${type}_short_enums['$unused_enum_value'] = '$unused_table_hdr'"; 638 die $@ if $@; 639 640 foreach my $enum (@unused_enums) { 641 eval "\$${type}_enums{$enum} = $unused_enum_value"; 642 die $@ if $@; 643 } 644 } 645 } 646 } 647 648 # The short property names tend to be two lower case letters, but it 649 # looks better for those if they are upper. XXX 650 $short_name = uc($short_name) if length($short_name) < 3 651 || substr($short_name, 0, 1) =~ /[[:lower:]]/; 652 $name_prefix = "${short_name}_"; 653 654 # Start the enum definition for this map 655 my @enum_definition; 656 my @enum_list; 657 foreach my $enum (keys %enums) { 658 $enum_list[$enums{$enum}] = $enum; 659 } 660 foreach my $i (0 .. @enum_list - 1) { 661 push @enum_definition, ",\n" if $i > 0; 662 663 my $name = $enum_list[$i]; 664 push @enum_definition, "\t${name_prefix}$name = $i"; 665 } 666 if (@unused_enums) { 667 foreach my $unused (@unused_enums) { 668 push @enum_definition, 669 ",\n\t${name_prefix}$unused = $unused_enum_value"; 670 } 671 } 672 673 # For an 'l' property, we need extra enums, because some of the 674 # elements are lists. Each such distinct list is placed in its own 675 # auxiliary map table. Here, we go through the inversion map, and for 676 # each distinct list found, create an enum value for it, numbered -1, 677 # -2, .... 678 my %multiples; 679 my $aux_table_prefix = "AUX_TABLE_"; 680 if ($input_format =~ /l/) { 681 foreach my $element (@$invmap) { 682 683 # A regular scalar is not one of the lists we're looking for 684 # at this stage. 685 next unless ref $element; 686 687 my $joined; 688 if ($input_format =~ /a/) { # These are already ordered 689 $joined = join ",", @$element; 690 } 691 else { 692 $joined = join ",", sort caselessly @$element; 693 } 694 my $already_found = exists $multiples{$joined}; 695 696 my $i; 697 if ($already_found) { # Use any existing one 698 $i = $multiples{$joined}; 699 } 700 else { # Otherwise increment to get a new table number 701 $i = keys(%multiples) + 1; 702 $multiples{$joined} = $i; 703 } 704 705 # This changes the inversion map for this entry to not be the 706 # list 707 $element = "use_$aux_table_prefix$i"; 708 709 # And add to the enum values 710 if (! $already_found) { 711 push @enum_definition, ",\n\t${name_prefix}$element = -$i"; 712 } 713 } 714 } 715 716 $enum_declaration_type = "${name_prefix}enum"; 717 718 # Finished with the enum definition. Inversion map stuff is used only 719 # by regexec or utf-8 (if it is for code points) , unless it is in the 720 # enum exception list 721 my $where = (exists $where_to_define_enums{$name}) 722 ? $where_to_define_enums{$name} 723 : ($input_format =~ /a/) 724 ? 'PERL_IN_UTF8_C' 725 : 'PERL_IN_REGEXEC_C'; 726 727 if (! exists $public_enums{$name}) { 728 switch_pound_if($name, $where, $charset); 729 } 730 else { 731 end_charset_pound_if; 732 end_file_pound_if; 733 start_charset_pound_if($charset, 1); 734 } 735 736 # If the enum only contains one element, that is a dummy, default one 737 if (scalar @enum_definition > 1) { 738 739 # Currently unneeded 740 #print $out_fh "\n#define ${name_prefix}ENUM_COUNT ", 741 # ..scalar keys %enums, "\n"; 742 743 if ($input_format =~ /l/) { 744 print $out_fh 745 "\n", 746 "/* Negative enum values indicate the need to use an", 747 " auxiliary table\n", 748 " * consisting of the list of enums this one expands to.", 749 " The absolute\n", 750 " * values of the negative enums are indices into a table", 751 " of the auxiliary\n", 752 " * tables' addresses */"; 753 } 754 print $out_fh "\ntypedef enum {\n"; 755 print $out_fh join "", @enum_definition; 756 print $out_fh "\n"; 757 print $out_fh "} $enum_declaration_type;\n"; 758 } 759 760 switch_pound_if($name, $where, $charset); 761 762 # The inversion lists here have to be UV because inversion lists are 763 # capable of storing any code point, and even though the ones here 764 # are only Unicode ones, which need just 21 bits, they are linked to 765 # directly, rather than copied. The inversion map and aux tables also 766 # only need be 21 bits, and so we can get away with declaring them 767 # 32-bits to save a little space and memory (on some 64-bit 768 # platforms), as they are copied. 769 $invmap_declaration_type = ($input_format =~ /s/) 770 ? $enum_declaration_type 771 : "I32"; 772 $aux_declaration_type = ($input_format =~ /s/) 773 ? $enum_declaration_type 774 : "U32"; 775 776 $output_format = "${name_prefix}%s"; 777 778 # If there are auxiliary tables, output them. 779 if (%multiples) { 780 781 print $out_fh "\n#define HAS_${name_prefix}AUX_TABLES\n"; 782 783 # Invert keys and values 784 my %inverted_mults; 785 while (my ($key, $value) = each %multiples) { 786 $inverted_mults{$value} = $key; 787 } 788 789 # Output them in sorted order 790 my @sorted_table_list = sort { $a <=> $b } keys %inverted_mults; 791 792 # Keep track of how big each aux table is 793 my @aux_counts; 794 795 # Output each aux table. 796 foreach my $table_number (@sorted_table_list) { 797 my $table = $inverted_mults{$table_number}; 798 output_table_header($out_fh, 799 $aux_declaration_type, 800 "$name_prefix$aux_table_prefix$table_number"); 801 802 # Earlier, we joined the elements of this table together with 803 # a comma 804 my @elements = split ",", $table; 805 806 $aux_counts[$table_number] = scalar @elements; 807 for my $i (0 .. @elements - 1) { 808 print $out_fh ",\n" if $i > 0; 809 if ($input_format =~ /a/) { 810 printf $out_fh "\t0x%X", $elements[$i]; 811 } 812 else { 813 print $out_fh "\t${name_prefix}$elements[$i]"; 814 } 815 } 816 817 print $out_fh "\n"; 818 output_table_trailer(); 819 } 820 821 # Output the table that is indexed by the absolute value of the 822 # aux table enum and contains pointers to the tables output just 823 # above 824 output_table_header($out_fh, "$aux_declaration_type *", 825 "${name_prefix}${aux_table_prefix}ptrs"); 826 print $out_fh "\tNULL,\t/* Placeholder */\n"; 827 for my $i (1 .. @sorted_table_list) { 828 print $out_fh ",\n" if $i > 1; 829 print $out_fh "\t$name_prefix$aux_table_prefix$i"; 830 } 831 print $out_fh "\n"; 832 output_table_trailer(); 833 834 print $out_fh 835 "\n/* Parallel table to the above, giving the number of elements" 836 . " in each table\n * pointed to */\n"; 837 output_table_header($out_fh, "U8", 838 "${name_prefix}${aux_table_prefix}lengths"); 839 print $out_fh "\t0,\t/* Placeholder */\n"; 840 for my $i (1 .. @sorted_table_list) { 841 print $out_fh ",\n" if $i > 1; 842 print $out_fh 843 "\t$aux_counts[$i]\t/* $name_prefix$aux_table_prefix$i */"; 844 } 845 print $out_fh "\n"; 846 output_table_trailer(); 847 } # End of outputting the auxiliary and associated tables 848 849 # The scx property used in regexec.c needs a specialized table which 850 # is most convenient to output here, while the data structures set up 851 # above are still extant. This table contains the code point that is 852 # the zero digit of each script, indexed by script enum value. 853 if (lc $short_name eq 'scx') { 854 my @decimals_invlist = prop_invlist("Numeric_Type=Decimal"); 855 my %script_zeros; 856 857 # Find all the decimal digits. The 0 of each range is always the 858 # 0th element, except in some early Unicode releases, so check for 859 # that. 860 for (my $i = 0; $i < @decimals_invlist; $i += 2) { 861 my $code_point = $decimals_invlist[$i]; 862 next if num(chr($code_point)) ne '0'; 863 864 # Turn the scripts this zero is in into a list. 865 my @scripts = split ",", 866 charprop($code_point, "_Perl_SCX", '_perl_core_internal_ok'); 867 $code_point = sprintf("0x%x", $code_point); 868 869 foreach my $script (@scripts) { 870 if (! exists $script_zeros{$script}) { 871 $script_zeros{$script} = $code_point; 872 } 873 elsif (ref $script_zeros{$script}) { 874 push $script_zeros{$script}->@*, $code_point; 875 } 876 else { # Turn into a list if this is the 2nd zero of the 877 # script 878 my $existing = $script_zeros{$script}; 879 undef $script_zeros{$script}; 880 push $script_zeros{$script}->@*, $existing, $code_point; 881 } 882 } 883 } 884 885 # @script_zeros contains the zero, sorted by the script's enum 886 # value 887 my @script_zeros; 888 foreach my $script (keys %script_zeros) { 889 my $enum_value = $enums{$script}; 890 $script_zeros[$enum_value] = $script_zeros{$script}; 891 } 892 893 print $out_fh 894 "\n/* This table, indexed by the script enum, gives the zero" 895 . " code point for that\n * script; 0 if the script has multiple" 896 . " digit sequences. Scripts without a\n * digit sequence use" 897 . " ASCII [0-9], hence are marked '0' */\n"; 898 output_table_header($out_fh, "UV", "script_zeros"); 899 for my $i (0 .. @script_zeros - 1) { 900 my $code_point = $script_zeros[$i]; 901 if (defined $code_point) { 902 $code_point = " 0" if ref $code_point; 903 print $out_fh "\t$code_point"; 904 } 905 elsif (lc $enum_list[$i] eq 'inherited') { 906 print $out_fh "\t 0"; 907 } 908 else { # The only digits a script without its own set accepts 909 # is [0-9] 910 print $out_fh "\t'0'"; 911 } 912 print $out_fh "," if $i < @script_zeros - 1; 913 print $out_fh "\t/* $enum_list[$i] */"; 914 print $out_fh "\n"; 915 } 916 output_table_trailer(); 917 } # End of special handling of scx 918 } 919 else { 920 die "'$input_format' invmap() format for '$prop_name' unimplemented"; 921 } 922 923 die "No inversion map for $prop_name" unless defined $invmap 924 && ref $invmap eq 'ARRAY' 925 && $count; 926 927 # Now output the inversion map proper 928 $charset = "for $charset" if $charset; 929 output_table_header($out_fh, $invmap_declaration_type, 930 "${name}_invmap", 931 $charset); 932 933 # The main body are the scalars passed in to this routine. 934 for my $i (0 .. $count - 1) { 935 my $element = $invmap->[$i]; 936 my $full_element_name = prop_value_aliases($prop_name, $element); 937 if ($input_format =~ /a/ && $element !~ /\D/) { 938 $element = ($element == 0) 939 ? 0 940 : sprintf("0x%X", $element); 941 } 942 else { 943 $element = $full_element_name if defined $full_element_name; 944 $element = $name_prefix . $element; 945 } 946 print $out_fh "\t$element"; 947 print $out_fh "," if $i < $count - 1; 948 print $out_fh "\n"; 949 } 950 output_table_trailer(); 951} 952 953sub mk_invlist_from_sorted_cp_list { 954 955 # Returns an inversion list constructed from the sorted input array of 956 # code points 957 958 my $list_ref = shift; 959 960 return unless @$list_ref; 961 962 # Initialize to just the first element 963 my @invlist = ( $list_ref->[0], $list_ref->[0] + 1); 964 965 # For each succeeding element, if it extends the previous range, adjust 966 # up, otherwise add it. 967 for my $i (1 .. @$list_ref - 1) { 968 if ($invlist[-1] == $list_ref->[$i]) { 969 $invlist[-1]++; 970 } 971 else { 972 push @invlist, $list_ref->[$i], $list_ref->[$i] + 1; 973 } 974 } 975 return @invlist; 976} 977 978print "Reading Case Folding rules.\n" if DEBUG; 979# Read in the Case Folding rules, and construct arrays of code points for the 980# properties we need. 981my ($cp_ref, $folds_ref, $format, $default) = prop_invmap("Case_Folding"); 982die "Could not find inversion map for Case_Folding" unless defined $format; 983die "Incorrect format '$format' for Case_Folding inversion map" 984 unless $format eq 'al' 985 || $format eq 'a'; 986print "Finished reading Case Folding rules.\n" if DEBUG; 987 988 989sub _Perl_IVCF { 990 991 # This creates a map of the inversion of case folding. i.e., given a 992 # character, it gives all the other characters that fold to it. 993 # 994 # Inversion maps function kind of like a hash, with the inversion list 995 # specifying the buckets (keys) and the inversion maps specifying the 996 # contents of the corresponding bucket. Effectively this function just 997 # swaps the keys and values of the case fold hash. But there are 998 # complications. Most importantly, More than one character can each have 999 # the same fold. This is solved by having a list of characters that fold 1000 # to a given one. 1001 1002 my %new; 1003 1004 # Go through the inversion list. 1005 for (my $i = 0; $i < @$cp_ref; $i++) { 1006 1007 # Skip if nothing folds to this 1008 next if $folds_ref->[$i] == 0; 1009 1010 # This entry which is valid from here to up (but not including) the 1011 # next entry is for the next $count characters, so that, for example, 1012 # A-Z is represented by one entry. 1013 my $cur_list = $cp_ref->[$i]; 1014 my $count = $cp_ref->[$i+1] - $cur_list; 1015 1016 # The fold of [$i] can be not just a single character, but a sequence 1017 # of multiple ones. We deal with those here by just creating a string 1018 # consisting of them. Otherwise, we use the single code point [$i] 1019 # folds to. 1020 my $cur_map = (ref $folds_ref->[$i]) 1021 ? join "", map { chr } $folds_ref->[$i]->@* 1022 : $folds_ref->[$i]; 1023 1024 # Expand out this range 1025 while ($count > 0) { 1026 push @{$new{$cur_map}}, $cur_list; 1027 1028 # A multiple-character fold is a string, and shouldn't need 1029 # incrementing anyway 1030 if (ref $folds_ref->[$i]) { 1031 die sprintf("Case fold for %x is multiple chars; should have" 1032 . " a count of 1, but instead it was $count", $count) 1033 unless $count == 1; 1034 } 1035 else { 1036 $cur_map++; 1037 $cur_list++; 1038 } 1039 $count--; 1040 } 1041 } 1042 1043 # Now go through and make some adjustments. We add synthetic entries for 1044 # three cases. 1045 # 1) If the fold of a Latin1-range character is above that range, some 1046 # coding in regexec.c can be saved by creating a reverse map here. The 1047 # impetus for this is that U+B5 (MICRO SIGN) folds to the Greek small 1048 # mu (U+3BC). That fold isn't done at regex pattern compilation time 1049 # if it means that the pattern would have to be translated into UTF-8, 1050 # whose operation is slower. At run time, having this reverse 1051 # translation eliminates some special cases in the code. 1052 # 2) Two or more code points can fold to the same multiple character, 1053 # sequence, as U+FB05 and U+FB06 both fold to 'st'. This code is only 1054 # for single character folds, but FB05 and FB06 are single characters 1055 # that are equivalent folded, so we add entries so that they are 1056 # considered to fold to each other 1057 # 3) If two or more above-Latin1 code points fold to the same Latin1 range 1058 # one, we also add entries so that they are considered to fold to each 1059 # other. This is so that under /aa or /l matching, where folding to 1060 # their Latin1 range code point is illegal, they still can fold to each 1061 # other. This situation happens in Unicode 3.0.1, but probably no 1062 # other version. 1063 foreach my $fold (keys %new) { 1064 my $folds_to_string = $fold =~ /\D/; 1065 1066 # If the bucket contains only one element, convert from an array to a 1067 # scalar 1068 if (scalar $new{$fold}->@* == 1) { 1069 $new{$fold} = $new{$fold}[0]; 1070 1071 # Handle case 1) above: if there were a Latin1 range code point 1072 # whose fold is above that range, this creates an extra entry that 1073 # maps the other direction, and would save some special case code. 1074 # (The one current case of this is handled in the else clause 1075 # below.) 1076 $new{$new{$fold}} = $fold if $new{$fold} < 256 && $fold > 255; 1077 } 1078 else { 1079 1080 # Handle case 1) when there are multiple things that fold to an 1081 # above-Latin1 code point, at least one of which is in Latin1. 1082 if (! $folds_to_string && $fold > 255) { 1083 foreach my $cp ($new{$fold}->@*) { 1084 if ($cp < 256) { 1085 my @new_entry = grep { $_ != $cp } $new{$fold}->@*; 1086 push @new_entry, $fold; 1087 $new{$cp}->@* = @new_entry; 1088 } 1089 } 1090 } 1091 1092 # Otherwise, sort numerically. This places the highest code point 1093 # in the list at the tail end. This is because Unicode keeps the 1094 # lowercase code points as higher ordinals than the uppercase, at 1095 # least for the ones that matter so far. These are synthetic 1096 # entries, and we want to predictably have the lowercase (which is 1097 # more likely to be what gets folded to) in the same corresponding 1098 # position, so that other code can rely on that. If some new 1099 # version of Unicode came along that violated this, we might have 1100 # to change so that the sort is based on upper vs lower instead. 1101 # (The lower-comes-after isn't true of native EBCDIC, but here we 1102 # are dealing strictly with Unicode values). 1103 @{$new{$fold}} = sort { $a <=> $b } $new{$fold}->@* 1104 unless $folds_to_string; 1105 # We will be working with a copy of this sorted entry. 1106 my @source_list = $new{$fold}->@*; 1107 if (! $folds_to_string) { 1108 1109 # This handles situation 2) listed above, which only arises if 1110 # what is being folded-to (the fold) is in the Latin1 range. 1111 if ($fold > 255 ) { 1112 undef @source_list; 1113 } 1114 else { 1115 # And it only arises if there are two or more folders that 1116 # fold to it above Latin1. We look at just those. 1117 @source_list = grep { $_ > 255 } @source_list; 1118 undef @source_list if @source_list == 1; 1119 } 1120 } 1121 1122 # Here, we've found the items we want to set up synthetic folds 1123 # for. Add entries so that each folds to each other. 1124 foreach my $cp (@source_list) { 1125 my @rest = grep { $cp != $_ } @source_list; 1126 if (@rest == 1) { 1127 $new{$cp} = $rest[0]; 1128 } 1129 else { 1130 push @{$new{$cp}}, @rest; 1131 } 1132 } 1133 } 1134 1135 # We don't otherwise deal with multiple-character folds 1136 delete $new{$fold} if $folds_to_string; 1137 } 1138 1139 1140 # Now we have a hash that is the inversion of the case fold property. 1141 # First find the maximum number of code points that fold to the same one. 1142 foreach my $fold_to (keys %new) { 1143 if (ref $new{$fold_to}) { 1144 my $folders_count = scalar @{$new{$fold_to}}; 1145 $max_fold_froms = $folders_count if $folders_count > $max_fold_froms; 1146 } 1147 } 1148 1149 # Then convert the hash to an inversion map. 1150 my @sorted_folds = sort { $a <=> $b } keys %new; 1151 my (@invlist, @invmap); 1152 1153 # We know that nothing folds to the controls (whose ordinals start at 0). 1154 # And the first real entries are the lowest in the hash. 1155 push @invlist, 0, $sorted_folds[0]; 1156 push @invmap, 0, $new{$sorted_folds[0]}; 1157 1158 # Go through the remainder of the hash keys (which are the folded code 1159 # points) 1160 for (my $i = 1; $i < @sorted_folds; $i++) { 1161 1162 # Get the current one, and the one prior to it. 1163 my $fold = $sorted_folds[$i]; 1164 my $prev_fold = $sorted_folds[$i-1]; 1165 1166 # If the current one is not just 1 away from the prior one, we close 1167 # out the range containing the previous fold, and know that the gap 1168 # doesn't have anything that folds. 1169 if ($fold - 1 != $prev_fold) { 1170 push @invlist, $prev_fold + 1; 1171 push @invmap, 0; 1172 1173 # And start a new range 1174 push @invlist, $fold; 1175 push @invmap, $new{$fold}; 1176 } 1177 elsif ($new{$fold} - 1 != $new{$prev_fold}) { 1178 1179 # Here the current fold is just 1 greater than the previous, but 1180 # the new map isn't correspondingly 1 greater than the previous, 1181 # the old range is ended, but since there is no gap, we don't have 1182 # to insert anything else. 1183 push @invlist, $fold; 1184 push @invmap, $new{$fold}; 1185 1186 } # else { Otherwise, this new entry just extends the previous } 1187 1188 die "In IVCF: $invlist[-1] <= $invlist[-2]" 1189 if $invlist[-1] <= $invlist[-2]; 1190 } 1191 1192 # And add an entry that indicates that everything above this, to infinity, 1193 # does not have a case fold. 1194 push @invlist, $sorted_folds[-1] + 1; 1195 push @invmap, 0; 1196 1197 push @invlist, 0x110000; 1198 push @invmap, 0; 1199 1200 # All Unicode versions have some places where multiple code points map to 1201 # the same one, so the format always has an 'l' 1202 return \@invlist, \@invmap, 'al', $default; 1203} 1204 1205sub prop_name_for_cmp ($) { # Sort helper 1206 my $name = shift; 1207 1208 # Returns the input lowercased, with non-alphas removed, as well as 1209 # everything starting with a comma 1210 1211 $name =~ s/,.*//; 1212 $name =~ s/[[:^alpha:]]//g; 1213 return lc $name; 1214} 1215 1216sub UpperLatin1 { 1217 my @return = mk_invlist_from_sorted_cp_list([ 128 .. 255 ]); 1218 return \@return; 1219} 1220 1221sub _Perl_CCC_non0_non230 { 1222 1223 # Create an inversion list of code points with non-zero canonical 1224 # combining class that also don't have 230 as the class number. This is 1225 # part of a Unicode Standard rule 1226 1227 my @nonzeros = prop_invlist("ccc=0"); 1228 shift @nonzeros; # Invert so is "ccc != 0" 1229 1230 my @return; 1231 1232 # Expand into list of code points, while excluding those with ccc == 230 1233 for (my $i = 0; $i < @nonzeros; $i += 2) { 1234 my $upper = ($i + 1) < @nonzeros 1235 ? $nonzeros[$i+1] - 1 # In range 1236 : $Unicode::UCD::MAX_CP; # To infinity. 1237 for my $j ($nonzeros[$i] .. $upper) { 1238 my @ccc_names = prop_value_aliases("ccc", charprop($j, "ccc")); 1239 1240 # Final element in @ccc_names will be all numeric 1241 push @return, $j if $ccc_names[-1] != 230; 1242 } 1243 } 1244 1245 @return = sort { $a <=> $b } @return; 1246 @return = mk_invlist_from_sorted_cp_list(\@return); 1247 return \@return; 1248} 1249 1250sub output_table_common { 1251 1252 # Common subroutine to actually output the generated rules table. 1253 1254 my ($property, 1255 $table_value_defines_ref, 1256 $table_ref, 1257 $names_ref, 1258 $abbreviations_ref) = @_; 1259 my $size = @$table_ref; 1260 1261 # Output the #define list, sorted by numeric value 1262 if ($table_value_defines_ref) { 1263 my $max_name_length = 0; 1264 my @defines; 1265 1266 # Put in order, and at the same time find the longest name 1267 while (my ($enum, $value) = each %$table_value_defines_ref) { 1268 $defines[$value] = $enum; 1269 1270 my $length = length $enum; 1271 $max_name_length = $length if $length > $max_name_length; 1272 } 1273 1274 print $out_fh "\n"; 1275 1276 # Output, so that the values are vertically aligned in a column after 1277 # the longest name 1278 foreach my $i (0 .. @defines - 1) { 1279 next unless defined $defines[$i]; 1280 printf $out_fh "#define %-*s %2d\n", 1281 $max_name_length, 1282 $defines[$i], 1283 $i; 1284 } 1285 } 1286 1287 my $column_width = 2; # We currently allow 2 digits for the number 1288 1289 # Being above a U8 is not currently handled 1290 my $table_type = 'U8'; 1291 1292 # If a name is longer than the width set aside for a column, its column 1293 # needs to have increased spacing so that the name doesn't get truncated 1294 # nor run into an adjacent column 1295 my @spacers; 1296 1297 # Is there a row and column for unused values in this release? 1298 my $has_unused = $names_ref->[$size-1] eq $unused_table_hdr; 1299 1300 for my $i (0 .. $size - 1) { 1301 no warnings 'numeric'; 1302 $spacers[$i] = " " x (length($names_ref->[$i]) - $column_width); 1303 } 1304 1305 output_table_header($out_fh, $table_type, "${property}_table", undef, 1306 $size, $size); 1307 1308 # Calculate the column heading line 1309 my $header_line = "/* " 1310 . (" " x $max_hdr_len) # We let the row heading meld to 1311 # the '*/' for those that are at 1312 # the max 1313 . " " x 3; # Space for '*/ ' 1314 # Now each column 1315 for my $i (0 .. $size - 1) { 1316 $header_line .= sprintf "%s%*s", 1317 $spacers[$i], 1318 $column_width + 1, # 1 for the ',' 1319 $names_ref->[$i]; 1320 } 1321 $header_line .= " */\n"; 1322 1323 # If we have annotations, output it now. 1324 if ($has_unused || scalar %$abbreviations_ref) { 1325 my $text = ""; 1326 foreach my $abbr (sort caselessly keys %$abbreviations_ref) { 1327 $text .= "; " if $text; 1328 $text .= "'$abbr' stands for '$abbreviations_ref->{$abbr}'"; 1329 } 1330 if ($has_unused) { 1331 $text .= "; $unused_table_hdr stands for 'unused in this Unicode" 1332 . " release (and the data in its row and column are garbage)" 1333 } 1334 1335 my $indent = " " x 3; 1336 $text = $indent . "/* $text */"; 1337 1338 # Wrap the text so that it is no wider than the table, which the 1339 # header line gives. 1340 my $output_width = length $header_line; 1341 while (length $text > $output_width) { 1342 my $cur_line = substr($text, 0, $output_width); 1343 1344 # Find the first blank back from the right end to wrap at. 1345 for (my $i = $output_width -1; $i > 0; $i--) { 1346 if (substr($text, $i, 1) eq " ") { 1347 print $out_fh substr($text, 0, $i), "\n"; 1348 1349 # Set so will look at just the remaining tail (which will 1350 # be indented and have a '*' after the indent 1351 $text = $indent . " * " . substr($text, $i + 1); 1352 last; 1353 } 1354 } 1355 } 1356 1357 # And any remaining 1358 print $out_fh $text, "\n" if $text; 1359 } 1360 1361 # We calculated the header line earlier just to get its width so that we 1362 # could make sure the annotations fit into that. 1363 print $out_fh $header_line; 1364 1365 # Now output the bulk of the table. 1366 for my $i (0 .. $size - 1) { 1367 1368 # First the row heading. 1369 printf $out_fh "/* %-*s*/ ", $max_hdr_len, $names_ref->[$i]; 1370 print $out_fh "{"; # Then the brace for this row 1371 1372 # Then each column 1373 for my $j (0 .. $size -1) { 1374 print $out_fh $spacers[$j]; 1375 printf $out_fh "%*d", $column_width, $table_ref->[$i][$j]; 1376 print $out_fh "," if $j < $size - 1; 1377 } 1378 print $out_fh " }"; 1379 print $out_fh "," if $i < $size - 1; 1380 print $out_fh "\n"; 1381 } 1382 1383 output_table_trailer(); 1384} 1385 1386sub output_GCB_table() { 1387 1388 # Create and output the pair table for use in determining Grapheme Cluster 1389 # Breaks, given in http://www.unicode.org/reports/tr29/. 1390 my %gcb_actions = ( 1391 GCB_NOBREAK => 0, 1392 GCB_BREAKABLE => 1, 1393 GCB_RI_then_RI => 2, # Rules 12 and 13 1394 GCB_EX_then_EM => 3, # Rule 10 1395 GCB_Maybe_Emoji_NonBreak => 4, 1396 ); 1397 1398 # The table is constructed in reverse order of the rules, to make the 1399 # lower-numbered, higher priority ones override the later ones, as the 1400 # algorithm stops at the earliest matching rule 1401 1402 my @gcb_table; 1403 my $table_size = @gcb_short_enums; 1404 1405 # Otherwise, break everywhere. 1406 # GB99 Any ÷ Any 1407 for my $i (0 .. $table_size - 1) { 1408 for my $j (0 .. $table_size - 1) { 1409 $gcb_table[$i][$j] = 1; 1410 } 1411 } 1412 1413 # Do not break within emoji flag sequences. That is, do not break between 1414 # regional indicator (RI) symbols if there is an odd number of RI 1415 # characters before the break point. Must be resolved in runtime code. 1416 # 1417 # GB12 sot (RI RI)* RI × RI 1418 # GB13 [^RI] (RI RI)* RI × RI 1419 $gcb_table[$gcb_enums{'Regional_Indicator'}] 1420 [$gcb_enums{'Regional_Indicator'}] = $gcb_actions{GCB_RI_then_RI}; 1421 1422 # Post 11.0: GB11 \p{Extended_Pictographic} Extend* ZWJ 1423 # × \p{Extended_Pictographic} 1424 $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'ExtPict_XX'}] = 1425 $gcb_actions{GCB_Maybe_Emoji_NonBreak}; 1426 1427 # This and the rule GB10 obsolete starting with Unicode 11.0, can be left 1428 # in as there are no code points that match, so the code won't ever get 1429 # executed. 1430 # Do not break within emoji modifier sequences or emoji zwj sequences. 1431 # Pre 11.0: GB11 ZWJ × ( Glue_After_Zwj | E_Base_GAZ ) 1432 $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'Glue_After_Zwj'}] = 0; 1433 $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'E_Base_GAZ'}] = 0; 1434 1435 # GB10 ( E_Base | E_Base_GAZ ) Extend* × E_Modifier 1436 $gcb_table[$gcb_enums{'Extend'}][$gcb_enums{'E_Modifier'}] 1437 = $gcb_actions{GCB_EX_then_EM}; 1438 $gcb_table[$gcb_enums{'E_Base'}][$gcb_enums{'E_Modifier'}] = 0; 1439 $gcb_table[$gcb_enums{'E_Base_GAZ'}][$gcb_enums{'E_Modifier'}] = 0; 1440 1441 # Do not break before extending characters or ZWJ. 1442 # Do not break before SpacingMarks, or after Prepend characters. 1443 # GB9b Prepend × 1444 # GB9a × SpacingMark 1445 # GB9 × ( Extend | ZWJ ) 1446 for my $i (0 .. @gcb_table - 1) { 1447 $gcb_table[$gcb_enums{'Prepend'}][$i] = 0; 1448 $gcb_table[$i][$gcb_enums{'SpacingMark'}] = 0; 1449 $gcb_table[$i][$gcb_enums{'Extend'}] = 0; 1450 $gcb_table[$i][$gcb_enums{'ZWJ'}] = 0; 1451 } 1452 1453 # Do not break Hangul syllable sequences. 1454 # GB8 ( LVT | T) × T 1455 $gcb_table[$gcb_enums{'LVT'}][$gcb_enums{'T'}] = 0; 1456 $gcb_table[$gcb_enums{'T'}][$gcb_enums{'T'}] = 0; 1457 1458 # GB7 ( LV | V ) × ( V | T ) 1459 $gcb_table[$gcb_enums{'LV'}][$gcb_enums{'V'}] = 0; 1460 $gcb_table[$gcb_enums{'LV'}][$gcb_enums{'T'}] = 0; 1461 $gcb_table[$gcb_enums{'V'}][$gcb_enums{'V'}] = 0; 1462 $gcb_table[$gcb_enums{'V'}][$gcb_enums{'T'}] = 0; 1463 1464 # GB6 L × ( L | V | LV | LVT ) 1465 $gcb_table[$gcb_enums{'L'}][$gcb_enums{'L'}] = 0; 1466 $gcb_table[$gcb_enums{'L'}][$gcb_enums{'V'}] = 0; 1467 $gcb_table[$gcb_enums{'L'}][$gcb_enums{'LV'}] = 0; 1468 $gcb_table[$gcb_enums{'L'}][$gcb_enums{'LVT'}] = 0; 1469 1470 # Do not break between a CR and LF. Otherwise, break before and after 1471 # controls. 1472 # GB5 ÷ ( Control | CR | LF ) 1473 # GB4 ( Control | CR | LF ) ÷ 1474 for my $i (0 .. @gcb_table - 1) { 1475 $gcb_table[$i][$gcb_enums{'Control'}] = 1; 1476 $gcb_table[$i][$gcb_enums{'CR'}] = 1; 1477 $gcb_table[$i][$gcb_enums{'LF'}] = 1; 1478 $gcb_table[$gcb_enums{'Control'}][$i] = 1; 1479 $gcb_table[$gcb_enums{'CR'}][$i] = 1; 1480 $gcb_table[$gcb_enums{'LF'}][$i] = 1; 1481 } 1482 1483 # GB3 CR × LF 1484 $gcb_table[$gcb_enums{'CR'}][$gcb_enums{'LF'}] = 0; 1485 1486 # Break at the start and end of text, unless the text is empty 1487 # GB1 sot ÷ 1488 # GB2 ÷ eot 1489 for my $i (0 .. @gcb_table - 1) { 1490 $gcb_table[$i][$gcb_enums{'EDGE'}] = 1; 1491 $gcb_table[$gcb_enums{'EDGE'}][$i] = 1; 1492 } 1493 $gcb_table[$gcb_enums{'EDGE'}][$gcb_enums{'EDGE'}] = 0; 1494 1495 output_table_common('GCB', \%gcb_actions, 1496 \@gcb_table, \@gcb_short_enums, \%gcb_abbreviations); 1497} 1498 1499sub output_LB_table() { 1500 1501 # Create and output the enums, #defines, and pair table for use in 1502 # determining Line Breaks. This uses the default line break algorithm, 1503 # given in http://www.unicode.org/reports/tr14/, but tailored by example 7 1504 # in that page, as the Unicode-furnished tests assume that tailoring. 1505 1506 # The result is really just true or false. But we follow along with tr14, 1507 # creating a rule which is false for something like X SP* X. That gets 1508 # encoding 2. The rest of the actions are synthetic ones that indicate 1509 # some context handling is required. These each are added to the 1510 # underlying 0, 1, or 2, instead of replacing them, so that the underlying 1511 # value can be retrieved. Actually only rules from 7 through 18 (which 1512 # are the ones where space matter) are possible to have 2 added to them. 1513 # The others below add just 0 or 1. It might be possible for one 1514 # synthetic rule to be added to another, yielding a larger value. This 1515 # doesn't happen in the Unicode 8.0 rule set, and as you can see from the 1516 # names of the middle grouping below, it is impossible for that to occur 1517 # for them because they all start with mutually exclusive classes. That 1518 # the final rule can't be added to any of the others isn't obvious from 1519 # its name, so it is assigned a power of 2 higher than the others can get 1520 # to so any addition would preserve all data. (And the code will reach an 1521 # assert(0) on debugging builds should this happen.) 1522 my %lb_actions = ( 1523 LB_NOBREAK => 0, 1524 LB_BREAKABLE => 1, 1525 LB_NOBREAK_EVEN_WITH_SP_BETWEEN => 2, 1526 1527 LB_CM_ZWJ_foo => 3, # Rule 9 1528 LB_SP_foo => 6, # Rule 18 1529 LB_PR_or_PO_then_OP_or_HY => 9, # Rule 25 1530 LB_SY_or_IS_then_various => 11, # Rule 25 1531 LB_HY_or_BA_then_foo => 13, # Rule 21 1532 LB_RI_then_RI => 15, # Rule 30a 1533 1534 LB_various_then_PO_or_PR => (1<<5), # Rule 25 1535 ); 1536 1537 # Construct the LB pair table. This is based on the rules in 1538 # http://www.unicode.org/reports/tr14/, but modified as those rules are 1539 # designed for someone taking a string of text and sequentially going 1540 # through it to find the break opportunities, whereas, Perl requires 1541 # determining if a given random spot is a break opportunity, without 1542 # knowing all the entire string before it. 1543 # 1544 # The table is constructed in reverse order of the rules, to make the 1545 # lower-numbered, higher priority ones override the later ones, as the 1546 # algorithm stops at the earliest matching rule 1547 1548 my @lb_table; 1549 my $table_size = @lb_short_enums; 1550 1551 # LB31. Break everywhere else 1552 for my $i (0 .. $table_size - 1) { 1553 for my $j (0 .. $table_size - 1) { 1554 $lb_table[$i][$j] = $lb_actions{'LB_BREAKABLE'}; 1555 } 1556 } 1557 1558 # LB30b Do not break between an emoji base (or potential emoji) and an 1559 # emoji modifier. 1560 1561 # EB × EM 1562 # [\p{Extended_Pictographic}&\p{Cn}] × EM 1563 $lb_table[$lb_enums{'E_Base'}][$lb_enums{'E_Modifier'}] 1564 = $lb_actions{'LB_NOBREAK'}; 1565 $lb_table[$lb_enums{'Unassigned_Extended_Pictographic_Ideographic'}] 1566 [$lb_enums{'E_Modifier'}] = $lb_actions{'LB_NOBREAK'}; 1567 1568 # LB30a Break between two regional indicator symbols if and only if there 1569 # are an even number of regional indicators preceding the position of the 1570 # break. 1571 # sot (RI RI)* RI × RI 1572 # [^RI] (RI RI)* RI × RI 1573 $lb_table[$lb_enums{'Regional_Indicator'}] 1574 [$lb_enums{'Regional_Indicator'}] = $lb_actions{'LB_RI_then_RI'}; 1575 1576 # LB30 Do not break between letters, numbers, or ordinary symbols and 1577 # non-East-Asian opening punctuation nor non-East-Asian closing 1578 # parentheses. 1579 1580 # (AL | HL | NU) × [OP-[\p{ea=F}\p{ea=W}\p{ea=H}]] 1581 # (what we call CP and OP here have already been modified by mktables to 1582 # exclude the ea items 1583 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Open_Punctuation'}] 1584 = $lb_actions{'LB_NOBREAK'}; 1585 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Open_Punctuation'}] 1586 = $lb_actions{'LB_NOBREAK'}; 1587 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Open_Punctuation'}] 1588 = $lb_actions{'LB_NOBREAK'}; 1589 1590 # [CP-[\p{ea=F}\p{ea=W}\p{ea=H}]] × (AL | HL | NU) 1591 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Alphabetic'}] 1592 = $lb_actions{'LB_NOBREAK'}; 1593 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Hebrew_Letter'}] 1594 = $lb_actions{'LB_NOBREAK'}; 1595 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Numeric'}] 1596 = $lb_actions{'LB_NOBREAK'}; 1597 1598 # LB29 Do not break between numeric punctuation and alphabetics (“e.g.”). 1599 # IS × (AL | HL) 1600 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Alphabetic'}] 1601 = $lb_actions{'LB_NOBREAK'}; 1602 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Hebrew_Letter'}] 1603 = $lb_actions{'LB_NOBREAK'}; 1604 1605 # LB28 Do not break between alphabetics (“at”). 1606 # (AL | HL) × (AL | HL) 1607 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Alphabetic'}] 1608 = $lb_actions{'LB_NOBREAK'}; 1609 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Alphabetic'}] 1610 = $lb_actions{'LB_NOBREAK'}; 1611 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Hebrew_Letter'}] 1612 = $lb_actions{'LB_NOBREAK'}; 1613 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Hebrew_Letter'}] 1614 = $lb_actions{'LB_NOBREAK'}; 1615 1616 # LB27 Treat a Korean Syllable Block the same as ID. 1617 # (JL | JV | JT | H2 | H3) × PO 1618 $lb_table[$lb_enums{'JL'}][$lb_enums{'Postfix_Numeric'}] 1619 = $lb_actions{'LB_NOBREAK'}; 1620 $lb_table[$lb_enums{'JV'}][$lb_enums{'Postfix_Numeric'}] 1621 = $lb_actions{'LB_NOBREAK'}; 1622 $lb_table[$lb_enums{'JT'}][$lb_enums{'Postfix_Numeric'}] 1623 = $lb_actions{'LB_NOBREAK'}; 1624 $lb_table[$lb_enums{'H2'}][$lb_enums{'Postfix_Numeric'}] 1625 = $lb_actions{'LB_NOBREAK'}; 1626 $lb_table[$lb_enums{'H3'}][$lb_enums{'Postfix_Numeric'}] 1627 = $lb_actions{'LB_NOBREAK'}; 1628 1629 # PR × (JL | JV | JT | H2 | H3) 1630 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JL'}] 1631 = $lb_actions{'LB_NOBREAK'}; 1632 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JV'}] 1633 = $lb_actions{'LB_NOBREAK'}; 1634 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JT'}] 1635 = $lb_actions{'LB_NOBREAK'}; 1636 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'H2'}] 1637 = $lb_actions{'LB_NOBREAK'}; 1638 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'H3'}] 1639 = $lb_actions{'LB_NOBREAK'}; 1640 1641 # LB26 Do not break a Korean syllable. 1642 # JL × (JL | JV | H2 | H3) 1643 $lb_table[$lb_enums{'JL'}][$lb_enums{'JL'}] = $lb_actions{'LB_NOBREAK'}; 1644 $lb_table[$lb_enums{'JL'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'}; 1645 $lb_table[$lb_enums{'JL'}][$lb_enums{'H2'}] = $lb_actions{'LB_NOBREAK'}; 1646 $lb_table[$lb_enums{'JL'}][$lb_enums{'H3'}] = $lb_actions{'LB_NOBREAK'}; 1647 1648 # (JV | H2) × (JV | JT) 1649 $lb_table[$lb_enums{'JV'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'}; 1650 $lb_table[$lb_enums{'H2'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'}; 1651 $lb_table[$lb_enums{'JV'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'}; 1652 $lb_table[$lb_enums{'H2'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'}; 1653 1654 # (JT | H3) × JT 1655 $lb_table[$lb_enums{'JT'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'}; 1656 $lb_table[$lb_enums{'H3'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'}; 1657 1658 # LB25 Do not break between the following pairs of classes relevant to 1659 # numbers, as tailored by example 7 in 1660 # http://www.unicode.org/reports/tr14/#Examples 1661 # We follow that tailoring because Unicode's test cases expect it 1662 # (PR | PO) × ( OP | HY )? NU 1663 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Numeric'}] 1664 = $lb_actions{'LB_NOBREAK'}; 1665 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Numeric'}] 1666 = $lb_actions{'LB_NOBREAK'}; 1667 1668 # Given that (OP | HY )? is optional, we have to test for it in code. 1669 # We add in the action (instead of overriding) for this, so that in 1670 # the code we can recover the underlying break value. 1671 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Open_Punctuation'}] 1672 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; 1673 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'East_Asian_OP'}] 1674 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; 1675 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Open_Punctuation'}] 1676 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; 1677 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Hyphen'}] 1678 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; 1679 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Hyphen'}] 1680 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; 1681 1682 # ( OP | HY ) × NU 1683 $lb_table[$lb_enums{'Open_Punctuation'}][$lb_enums{'Numeric'}] 1684 = $lb_actions{'LB_NOBREAK'}; 1685 $lb_table[$lb_enums{'East_Asian_OP'}][$lb_enums{'Numeric'}] 1686 = $lb_actions{'LB_NOBREAK'}; 1687 $lb_table[$lb_enums{'Hyphen'}][$lb_enums{'Numeric'}] 1688 = $lb_actions{'LB_NOBREAK'}; 1689 1690 # NU (NU | SY | IS)* × (NU | SY | IS | CL | CP ) 1691 # which can be rewritten as: 1692 # NU (SY | IS)* × (NU | SY | IS | CL | CP ) 1693 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Numeric'}] 1694 = $lb_actions{'LB_NOBREAK'}; 1695 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Break_Symbols'}] 1696 = $lb_actions{'LB_NOBREAK'}; 1697 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Infix_Numeric'}] 1698 = $lb_actions{'LB_NOBREAK'}; 1699 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Close_Punctuation'}] 1700 = $lb_actions{'LB_NOBREAK'}; 1701 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Close_Parenthesis'}] 1702 = $lb_actions{'LB_NOBREAK'}; 1703 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'East_Asian_CP'}] 1704 = $lb_actions{'LB_NOBREAK'}; 1705 1706 # Like earlier where we have to test in code, we add in the action so 1707 # that we can recover the underlying values. This is done in rules 1708 # below, as well. The code assumes that we haven't added 2 actions. 1709 # Shoul a later Unicode release break that assumption, then tests 1710 # should start failing. 1711 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Numeric'}] 1712 += $lb_actions{'LB_SY_or_IS_then_various'}; 1713 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Break_Symbols'}] 1714 += $lb_actions{'LB_SY_or_IS_then_various'}; 1715 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Infix_Numeric'}] 1716 += $lb_actions{'LB_SY_or_IS_then_various'}; 1717 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Close_Punctuation'}] 1718 += $lb_actions{'LB_SY_or_IS_then_various'}; 1719 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Close_Parenthesis'}] 1720 += $lb_actions{'LB_SY_or_IS_then_various'}; 1721 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'East_Asian_CP'}] 1722 += $lb_actions{'LB_SY_or_IS_then_various'}; 1723 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Numeric'}] 1724 += $lb_actions{'LB_SY_or_IS_then_various'}; 1725 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Break_Symbols'}] 1726 += $lb_actions{'LB_SY_or_IS_then_various'}; 1727 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Infix_Numeric'}] 1728 += $lb_actions{'LB_SY_or_IS_then_various'}; 1729 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Close_Punctuation'}] 1730 += $lb_actions{'LB_SY_or_IS_then_various'}; 1731 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Close_Parenthesis'}] 1732 += $lb_actions{'LB_SY_or_IS_then_various'}; 1733 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'East_Asian_CP'}] 1734 += $lb_actions{'LB_SY_or_IS_then_various'}; 1735 1736 # NU (NU | SY | IS)* (CL | CP)? × (PO | PR) 1737 # which can be rewritten as: 1738 # NU (SY | IS)* (CL | CP)? × (PO | PR) 1739 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Postfix_Numeric'}] 1740 = $lb_actions{'LB_NOBREAK'}; 1741 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Prefix_Numeric'}] 1742 = $lb_actions{'LB_NOBREAK'}; 1743 1744 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Postfix_Numeric'}] 1745 += $lb_actions{'LB_various_then_PO_or_PR'}; 1746 $lb_table[$lb_enums{'East_Asian_CP'}][$lb_enums{'Postfix_Numeric'}] 1747 += $lb_actions{'LB_various_then_PO_or_PR'}; 1748 $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Postfix_Numeric'}] 1749 += $lb_actions{'LB_various_then_PO_or_PR'}; 1750 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Postfix_Numeric'}] 1751 += $lb_actions{'LB_various_then_PO_or_PR'}; 1752 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Postfix_Numeric'}] 1753 += $lb_actions{'LB_various_then_PO_or_PR'}; 1754 1755 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Prefix_Numeric'}] 1756 += $lb_actions{'LB_various_then_PO_or_PR'}; 1757 $lb_table[$lb_enums{'East_Asian_CP'}][$lb_enums{'Prefix_Numeric'}] 1758 += $lb_actions{'LB_various_then_PO_or_PR'}; 1759 $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Prefix_Numeric'}] 1760 += $lb_actions{'LB_various_then_PO_or_PR'}; 1761 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Prefix_Numeric'}] 1762 += $lb_actions{'LB_various_then_PO_or_PR'}; 1763 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Prefix_Numeric'}] 1764 += $lb_actions{'LB_various_then_PO_or_PR'}; 1765 1766 # LB24 Do not break between numeric prefix/postfix and letters, or between 1767 # letters and prefix/postfix. 1768 # (PR | PO) × (AL | HL) 1769 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Alphabetic'}] 1770 = $lb_actions{'LB_NOBREAK'}; 1771 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Hebrew_Letter'}] 1772 = $lb_actions{'LB_NOBREAK'}; 1773 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Alphabetic'}] 1774 = $lb_actions{'LB_NOBREAK'}; 1775 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Hebrew_Letter'}] 1776 = $lb_actions{'LB_NOBREAK'}; 1777 1778 # (AL | HL) × (PR | PO) 1779 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Prefix_Numeric'}] 1780 = $lb_actions{'LB_NOBREAK'}; 1781 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Prefix_Numeric'}] 1782 = $lb_actions{'LB_NOBREAK'}; 1783 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Postfix_Numeric'}] 1784 = $lb_actions{'LB_NOBREAK'}; 1785 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Postfix_Numeric'}] 1786 = $lb_actions{'LB_NOBREAK'}; 1787 1788 # LB23a Do not break between numeric prefixes and ideographs, or between 1789 # ideographs and numeric postfixes. 1790 # PR × (ID | EB | EM) 1791 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Ideographic'}] 1792 = $lb_actions{'LB_NOBREAK'}; 1793 $lb_table[$lb_enums{'Prefix_Numeric'}] 1794 [$lb_enums{'Unassigned_Extended_Pictographic_Ideographic'}] 1795 = $lb_actions{'LB_NOBREAK'}; 1796 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'E_Base'}] 1797 = $lb_actions{'LB_NOBREAK'}; 1798 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'E_Modifier'}] 1799 = $lb_actions{'LB_NOBREAK'}; 1800 1801 # (ID | EB | EM) × PO 1802 $lb_table[$lb_enums{'Ideographic'}][$lb_enums{'Postfix_Numeric'}] 1803 = $lb_actions{'LB_NOBREAK'}; 1804 $lb_table[$lb_enums{'Unassigned_Extended_Pictographic_Ideographic'}] 1805 [$lb_enums{'Postfix_Numeric'}] = $lb_actions{'LB_NOBREAK'}; 1806 $lb_table[$lb_enums{'E_Base'}][$lb_enums{'Postfix_Numeric'}] 1807 = $lb_actions{'LB_NOBREAK'}; 1808 $lb_table[$lb_enums{'E_Modifier'}][$lb_enums{'Postfix_Numeric'}] 1809 = $lb_actions{'LB_NOBREAK'}; 1810 1811 # LB23 Do not break between digits and letters 1812 # (AL | HL) × NU 1813 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Numeric'}] 1814 = $lb_actions{'LB_NOBREAK'}; 1815 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Numeric'}] 1816 = $lb_actions{'LB_NOBREAK'}; 1817 1818 # NU × (AL | HL) 1819 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Alphabetic'}] 1820 = $lb_actions{'LB_NOBREAK'}; 1821 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Hebrew_Letter'}] 1822 = $lb_actions{'LB_NOBREAK'}; 1823 1824 # LB22 Do not break before ellipses 1825 for my $i (0 .. @lb_table - 1) { 1826 $lb_table[$i][$lb_enums{'Inseparable'}] = $lb_actions{'LB_NOBREAK'}; 1827 } 1828 1829 # LB21b Don’t break between Solidus and Hebrew letters. 1830 # SY × HL 1831 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Hebrew_Letter'}] 1832 = $lb_actions{'LB_NOBREAK'}; 1833 1834 # LB21a Don't break after Hebrew + Hyphen. 1835 # HL (HY | BA) × 1836 for my $i (0 .. @lb_table - 1) { 1837 $lb_table[$lb_enums{'Hyphen'}][$i] 1838 += $lb_actions{'LB_HY_or_BA_then_foo'}; 1839 $lb_table[$lb_enums{'Break_After'}][$i] 1840 += $lb_actions{'LB_HY_or_BA_then_foo'}; 1841 } 1842 1843 # LB21 Do not break before hyphen-minus, other hyphens, fixed-width 1844 # spaces, small kana, and other non-starters, or after acute accents. 1845 # × BA 1846 # × HY 1847 # × NS 1848 # BB × 1849 for my $i (0 .. @lb_table - 1) { 1850 $lb_table[$i][$lb_enums{'Break_After'}] = $lb_actions{'LB_NOBREAK'}; 1851 $lb_table[$i][$lb_enums{'Hyphen'}] = $lb_actions{'LB_NOBREAK'}; 1852 $lb_table[$i][$lb_enums{'Nonstarter'}] = $lb_actions{'LB_NOBREAK'}; 1853 $lb_table[$lb_enums{'Break_Before'}][$i] = $lb_actions{'LB_NOBREAK'}; 1854 } 1855 1856 # LB20 Break before and after unresolved CB. 1857 # ÷ CB 1858 # CB ÷ 1859 # Conditional breaks should be resolved external to the line breaking 1860 # rules. However, the default action is to treat unresolved CB as breaking 1861 # before and after. 1862 for my $i (0 .. @lb_table - 1) { 1863 $lb_table[$i][$lb_enums{'Contingent_Break'}] 1864 = $lb_actions{'LB_BREAKABLE'}; 1865 $lb_table[$lb_enums{'Contingent_Break'}][$i] 1866 = $lb_actions{'LB_BREAKABLE'}; 1867 } 1868 1869 # LB19 Do not break before or after quotation marks, such as ‘ ” ’. 1870 # × QU 1871 # QU × 1872 for my $i (0 .. @lb_table - 1) { 1873 $lb_table[$i][$lb_enums{'Quotation'}] = $lb_actions{'LB_NOBREAK'}; 1874 $lb_table[$lb_enums{'Quotation'}][$i] = $lb_actions{'LB_NOBREAK'}; 1875 } 1876 1877 # LB18 Break after spaces 1878 # SP ÷ 1879 for my $i (0 .. @lb_table - 1) { 1880 $lb_table[$lb_enums{'Space'}][$i] = $lb_actions{'LB_BREAKABLE'}; 1881 } 1882 1883 # LB17 Do not break within ‘——’, even with intervening spaces. 1884 # B2 SP* × B2 1885 $lb_table[$lb_enums{'Break_Both'}][$lb_enums{'Break_Both'}] 1886 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1887 1888 # LB16 Do not break between closing punctuation and a nonstarter even with 1889 # intervening spaces. 1890 # (CL | CP) SP* × NS 1891 $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Nonstarter'}] 1892 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1893 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Nonstarter'}] 1894 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1895 $lb_table[$lb_enums{'East_Asian_CP'}][$lb_enums{'Nonstarter'}] 1896 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1897 1898 1899 # LB15 Do not break within ‘”[’, even with intervening spaces. 1900 # QU SP* × OP 1901 $lb_table[$lb_enums{'Quotation'}][$lb_enums{'Open_Punctuation'}] 1902 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1903 $lb_table[$lb_enums{'Quotation'}][$lb_enums{'East_Asian_OP'}] 1904 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1905 1906 # LB14 Do not break after ‘[’, even after spaces. 1907 # OP SP* × 1908 for my $i (0 .. @lb_table - 1) { 1909 $lb_table[$lb_enums{'Open_Punctuation'}][$i] 1910 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1911 $lb_table[$lb_enums{'East_Asian_OP'}][$i] 1912 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1913 } 1914 1915 # LB13 Do not break before ‘]’ or ‘!’ or ‘;’ or ‘/’, even after spaces, as 1916 # tailored by example 7 in http://www.unicode.org/reports/tr14/#Examples 1917 # [^NU] × CL 1918 # [^NU] × CP 1919 # × EX 1920 # [^NU] × IS 1921 # [^NU] × SY 1922 for my $i (0 .. @lb_table - 1) { 1923 $lb_table[$i][$lb_enums{'Exclamation'}] 1924 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1925 1926 next if $i == $lb_enums{'Numeric'}; 1927 1928 $lb_table[$i][$lb_enums{'Close_Punctuation'}] 1929 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1930 $lb_table[$i][$lb_enums{'Close_Parenthesis'}] 1931 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1932 $lb_table[$i][$lb_enums{'East_Asian_CP'}] 1933 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1934 $lb_table[$i][$lb_enums{'Infix_Numeric'}] 1935 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1936 $lb_table[$i][$lb_enums{'Break_Symbols'}] 1937 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1938 } 1939 1940 # LB12a Do not break before NBSP and related characters, except after 1941 # spaces and hyphens. 1942 # [^SP BA HY] × GL 1943 for my $i (0 .. @lb_table - 1) { 1944 next if $i == $lb_enums{'Space'} 1945 || $i == $lb_enums{'Break_After'} 1946 || $i == $lb_enums{'Hyphen'}; 1947 1948 # We don't break, but if a property above has said don't break even 1949 # with space between, don't override that (also in the next few rules) 1950 next if $lb_table[$i][$lb_enums{'Glue'}] 1951 == $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1952 $lb_table[$i][$lb_enums{'Glue'}] = $lb_actions{'LB_NOBREAK'}; 1953 } 1954 1955 # LB12 Do not break after NBSP and related characters. 1956 # GL × 1957 for my $i (0 .. @lb_table - 1) { 1958 next if $lb_table[$lb_enums{'Glue'}][$i] 1959 == $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1960 $lb_table[$lb_enums{'Glue'}][$i] = $lb_actions{'LB_NOBREAK'}; 1961 } 1962 1963 # LB11 Do not break before or after Word joiner and related characters. 1964 # × WJ 1965 # WJ × 1966 for my $i (0 .. @lb_table - 1) { 1967 if ($lb_table[$i][$lb_enums{'Word_Joiner'}] 1968 != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}) 1969 { 1970 $lb_table[$i][$lb_enums{'Word_Joiner'}] = $lb_actions{'LB_NOBREAK'}; 1971 } 1972 if ($lb_table[$lb_enums{'Word_Joiner'}][$i] 1973 != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}) 1974 { 1975 $lb_table[$lb_enums{'Word_Joiner'}][$i] = $lb_actions{'LB_NOBREAK'}; 1976 } 1977 } 1978 1979 # Special case this here to avoid having to do a special case in the code, 1980 # by making this the same as other things with a SP in front of them that 1981 # don't break, we avoid an extra test 1982 $lb_table[$lb_enums{'Space'}][$lb_enums{'Word_Joiner'}] 1983 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; 1984 1985 # LB9 and LB10 are done in the same loop 1986 # 1987 # LB9 Do not break a combining character sequence; treat it as if it has 1988 # the line breaking class of the base character in all of the 1989 # higher-numbered rules. Treat ZWJ as if it were CM 1990 # Treat X (CM|ZWJ)* as if it were X. 1991 # where X is any line break class except BK, CR, LF, NL, SP, or ZW. 1992 1993 # LB10 Treat any remaining combining mark or ZWJ as AL. This catches the 1994 # case where a CM or ZWJ is the first character on the line or follows SP, 1995 # BK, CR, LF, NL, or ZW. 1996 for my $i (0 .. @lb_table - 1) { 1997 1998 # When the CM or ZWJ is the first in the pair, we don't know without 1999 # looking behind whether the CM or ZWJ is going to attach to an 2000 # earlier character, or not. So have to figure this out at runtime in 2001 # the code 2002 $lb_table[$lb_enums{'Combining_Mark'}][$i] 2003 = $lb_actions{'LB_CM_ZWJ_foo'}; 2004 $lb_table[$lb_enums{'ZWJ'}][$i] = $lb_actions{'LB_CM_ZWJ_foo'}; 2005 2006 if ( $i == $lb_enums{'Mandatory_Break'} 2007 || $i == $lb_enums{'EDGE'} 2008 || $i == $lb_enums{'Carriage_Return'} 2009 || $i == $lb_enums{'Line_Feed'} 2010 || $i == $lb_enums{'Next_Line'} 2011 || $i == $lb_enums{'Space'} 2012 || $i == $lb_enums{'ZWSpace'}) 2013 { 2014 # For these classes, a following CM doesn't combine, and should do 2015 # whatever 'Alphabetic' would do. 2016 $lb_table[$i][$lb_enums{'Combining_Mark'}] 2017 = $lb_table[$i][$lb_enums{'Alphabetic'}]; 2018 $lb_table[$i][$lb_enums{'ZWJ'}] 2019 = $lb_table[$i][$lb_enums{'Alphabetic'}]; 2020 } 2021 else { 2022 # For these classes, the CM or ZWJ combines, so doesn't break, 2023 # inheriting the type of nobreak from the master character. 2024 if ($lb_table[$i][$lb_enums{'Combining_Mark'}] 2025 != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}) 2026 { 2027 $lb_table[$i][$lb_enums{'Combining_Mark'}] 2028 = $lb_actions{'LB_NOBREAK'}; 2029 } 2030 if ($lb_table[$i][$lb_enums{'ZWJ'}] 2031 != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}) 2032 { 2033 $lb_table[$i][$lb_enums{'ZWJ'}] 2034 = $lb_actions{'LB_NOBREAK'}; 2035 } 2036 } 2037 } 2038 2039 # LB8a Do not break after a zero width joiner 2040 # ZWJ × 2041 for my $i (0 .. @lb_table - 1) { 2042 $lb_table[$lb_enums{'ZWJ'}][$i] = $lb_actions{'LB_NOBREAK'}; 2043 } 2044 2045 # LB8 Break before any character following a zero-width space, even if one 2046 # or more spaces intervene. 2047 # ZW SP* ÷ 2048 for my $i (0 .. @lb_table - 1) { 2049 $lb_table[$lb_enums{'ZWSpace'}][$i] = $lb_actions{'LB_BREAKABLE'}; 2050 } 2051 2052 # Because of LB8-10, we need to look at context for "SP x", and this must 2053 # be done in the code. So override the existing rules for that, by adding 2054 # a constant to get new rules that tell the code it needs to look at 2055 # context. By adding this action instead of replacing the existing one, 2056 # we can get back to the original rule if necessary. 2057 for my $i (0 .. @lb_table - 1) { 2058 $lb_table[$lb_enums{'Space'}][$i] += $lb_actions{'LB_SP_foo'}; 2059 } 2060 2061 # LB7 Do not break before spaces or zero width space. 2062 # × SP 2063 # × ZW 2064 for my $i (0 .. @lb_table - 1) { 2065 $lb_table[$i][$lb_enums{'Space'}] = $lb_actions{'LB_NOBREAK'}; 2066 $lb_table[$i][$lb_enums{'ZWSpace'}] = $lb_actions{'LB_NOBREAK'}; 2067 } 2068 2069 # LB6 Do not break before hard line breaks. 2070 # × ( BK | CR | LF | NL ) 2071 for my $i (0 .. @lb_table - 1) { 2072 $lb_table[$i][$lb_enums{'Mandatory_Break'}] = $lb_actions{'LB_NOBREAK'}; 2073 $lb_table[$i][$lb_enums{'Carriage_Return'}] = $lb_actions{'LB_NOBREAK'}; 2074 $lb_table[$i][$lb_enums{'Line_Feed'}] = $lb_actions{'LB_NOBREAK'}; 2075 $lb_table[$i][$lb_enums{'Next_Line'}] = $lb_actions{'LB_NOBREAK'}; 2076 } 2077 2078 # LB5 Treat CR followed by LF, as well as CR, LF, and NL as hard line breaks. 2079 # CR × LF 2080 # CR ! 2081 # LF ! 2082 # NL ! 2083 for my $i (0 .. @lb_table - 1) { 2084 $lb_table[$lb_enums{'Carriage_Return'}][$i] 2085 = $lb_actions{'LB_BREAKABLE'}; 2086 $lb_table[$lb_enums{'Line_Feed'}][$i] = $lb_actions{'LB_BREAKABLE'}; 2087 $lb_table[$lb_enums{'Next_Line'}][$i] = $lb_actions{'LB_BREAKABLE'}; 2088 } 2089 $lb_table[$lb_enums{'Carriage_Return'}][$lb_enums{'Line_Feed'}] 2090 = $lb_actions{'LB_NOBREAK'}; 2091 2092 # LB4 Always break after hard line breaks. 2093 # BK ! 2094 for my $i (0 .. @lb_table - 1) { 2095 $lb_table[$lb_enums{'Mandatory_Break'}][$i] 2096 = $lb_actions{'LB_BREAKABLE'}; 2097 } 2098 2099 # LB3 Always break at the end of text. 2100 # ! eot 2101 # LB2 Never break at the start of text. 2102 # sot × 2103 for my $i (0 .. @lb_table - 1) { 2104 $lb_table[$i][$lb_enums{'EDGE'}] = $lb_actions{'LB_BREAKABLE'}; 2105 $lb_table[$lb_enums{'EDGE'}][$i] = $lb_actions{'LB_NOBREAK'}; 2106 } 2107 2108 # LB1 Assign a line breaking class to each code point of the input. 2109 # Resolve AI, CB, CJ, SA, SG, and XX into other line breaking classes 2110 # depending on criteria outside the scope of this algorithm. 2111 # 2112 # In the absence of such criteria all characters with a specific 2113 # combination of original class and General_Category property value are 2114 # resolved as follows: 2115 # Original Resolved General_Category 2116 # AI, SG, XX AL Any 2117 # SA CM Only Mn or Mc 2118 # SA AL Any except Mn and Mc 2119 # CJ NS Any 2120 # 2121 # This is done in mktables, so we never see any of the remapped-from 2122 # classes. 2123 2124 output_table_common('LB', \%lb_actions, 2125 \@lb_table, \@lb_short_enums, \%lb_abbreviations); 2126} 2127 2128sub output_WB_table() { 2129 2130 # Create and output the enums, #defines, and pair table for use in 2131 # determining Word Breaks, given in http://www.unicode.org/reports/tr29/. 2132 2133 # This uses the same mechanism in the other bounds tables generated by 2134 # this file. The actions that could override a 0 or 1 are added to those 2135 # numbers; the actions that clearly don't depend on the underlying rule 2136 # simply overwrite 2137 my %wb_actions = ( 2138 WB_NOBREAK => 0, 2139 WB_BREAKABLE => 1, 2140 WB_hs_then_hs => 2, 2141 WB_Ex_or_FO_or_ZWJ_then_foo => 3, 2142 WB_DQ_then_HL => 4, 2143 WB_HL_then_DQ => 6, 2144 WB_LE_or_HL_then_MB_or_ML_or_SQ => 8, 2145 WB_MB_or_ML_or_SQ_then_LE_or_HL => 10, 2146 WB_MB_or_MN_or_SQ_then_NU => 12, 2147 WB_NU_then_MB_or_MN_or_SQ => 14, 2148 WB_RI_then_RI => 16, 2149 ); 2150 2151 # Construct the WB pair table. 2152 # The table is constructed in reverse order of the rules, to make the 2153 # lower-numbered, higher priority ones override the later ones, as the 2154 # algorithm stops at the earliest matching rule 2155 2156 my @wb_table; 2157 my $table_size = @wb_short_enums; 2158 2159 # Otherwise, break everywhere (including around ideographs). 2160 # WB99 Any ÷ Any 2161 for my $i (0 .. $table_size - 1) { 2162 for my $j (0 .. $table_size - 1) { 2163 $wb_table[$i][$j] = $wb_actions{'WB_BREAKABLE'}; 2164 } 2165 } 2166 2167 # Do not break within emoji flag sequences. That is, do not break between 2168 # regional indicator (RI) symbols if there is an odd number of RI 2169 # characters before the break point. 2170 # WB16 [^RI] (RI RI)* RI × RI 2171 # WB15 sot (RI RI)* RI × RI 2172 $wb_table[$wb_enums{'Regional_Indicator'}] 2173 [$wb_enums{'Regional_Indicator'}] = $wb_actions{'WB_RI_then_RI'}; 2174 2175 # Do not break within emoji modifier sequences. 2176 # WB14 ( E_Base | EBG ) × E_Modifier 2177 $wb_table[$wb_enums{'E_Base'}][$wb_enums{'E_Modifier'}] 2178 = $wb_actions{'WB_NOBREAK'}; 2179 $wb_table[$wb_enums{'E_Base_GAZ'}][$wb_enums{'E_Modifier'}] 2180 = $wb_actions{'WB_NOBREAK'}; 2181 2182 # Do not break from extenders. 2183 # WB13b ExtendNumLet × (ALetter | Hebrew_Letter | Numeric | Katakana) 2184 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ALetter'}] 2185 = $wb_actions{'WB_NOBREAK'}; 2186 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ExtPict_LE'}] 2187 = $wb_actions{'WB_NOBREAK'}; 2188 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Hebrew_Letter'}] 2189 = $wb_actions{'WB_NOBREAK'}; 2190 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Numeric'}] 2191 = $wb_actions{'WB_NOBREAK'}; 2192 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Katakana'}] 2193 = $wb_actions{'WB_NOBREAK'}; 2194 2195 # WB13a (ALetter | Hebrew_Letter | Numeric | Katakana | ExtendNumLet) 2196 # × ExtendNumLet 2197 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'ExtendNumLet'}] 2198 = $wb_actions{'WB_NOBREAK'}; 2199 $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'ExtendNumLet'}] 2200 = $wb_actions{'WB_NOBREAK'}; 2201 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ExtendNumLet'}] 2202 = $wb_actions{'WB_NOBREAK'}; 2203 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ExtendNumLet'}] 2204 = $wb_actions{'WB_NOBREAK'}; 2205 $wb_table[$wb_enums{'Katakana'}][$wb_enums{'ExtendNumLet'}] 2206 = $wb_actions{'WB_NOBREAK'}; 2207 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ExtendNumLet'}] 2208 = $wb_actions{'WB_NOBREAK'}; 2209 2210 # Do not break between Katakana. 2211 # WB13 Katakana × Katakana 2212 $wb_table[$wb_enums{'Katakana'}][$wb_enums{'Katakana'}] 2213 = $wb_actions{'WB_NOBREAK'}; 2214 2215 # Do not break within sequences, such as “3.2” or “3,456.789”. 2216 # WB12 Numeric × (MidNum | MidNumLet | Single_Quote) Numeric 2217 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'MidNumLet'}] 2218 += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'}; 2219 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'MidNum'}] 2220 += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'}; 2221 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Single_Quote'}] 2222 += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'}; 2223 2224 # WB11 Numeric (MidNum | (MidNumLet | Single_Quote)) × Numeric 2225 $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'Numeric'}] 2226 += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'}; 2227 $wb_table[$wb_enums{'MidNum'}][$wb_enums{'Numeric'}] 2228 += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'}; 2229 $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'Numeric'}] 2230 += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'}; 2231 2232 # Do not break within sequences of digits, or digits adjacent to letters 2233 # (“3a”, or “A3”). 2234 # WB10 Numeric × (ALetter | Hebrew_Letter) 2235 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ALetter'}] 2236 = $wb_actions{'WB_NOBREAK'}; 2237 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ExtPict_LE'}] 2238 = $wb_actions{'WB_NOBREAK'}; 2239 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Hebrew_Letter'}] 2240 = $wb_actions{'WB_NOBREAK'}; 2241 2242 # WB9 (ALetter | Hebrew_Letter) × Numeric 2243 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Numeric'}] 2244 = $wb_actions{'WB_NOBREAK'}; 2245 $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'Numeric'}] 2246 = $wb_actions{'WB_NOBREAK'}; 2247 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Numeric'}] 2248 = $wb_actions{'WB_NOBREAK'}; 2249 2250 # WB8 Numeric × Numeric 2251 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Numeric'}] 2252 = $wb_actions{'WB_NOBREAK'}; 2253 2254 # Do not break letters across certain punctuation. 2255 # WB7c Hebrew_Letter Double_Quote × Hebrew_Letter 2256 $wb_table[$wb_enums{'Double_Quote'}][$wb_enums{'Hebrew_Letter'}] 2257 += $wb_actions{'WB_DQ_then_HL'}; 2258 2259 # WB7b Hebrew_Letter × Double_Quote Hebrew_Letter 2260 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Double_Quote'}] 2261 += $wb_actions{'WB_HL_then_DQ'}; 2262 2263 # WB7a Hebrew_Letter × Single_Quote 2264 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Single_Quote'}] 2265 = $wb_actions{'WB_NOBREAK'}; 2266 2267 # WB7 (ALetter | Hebrew_Letter) (MidLetter | MidNumLet | Single_Quote) 2268 # × (ALetter | Hebrew_Letter) 2269 $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'ALetter'}] 2270 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2271 $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'ExtPict_LE'}] 2272 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2273 $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'Hebrew_Letter'}] 2274 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2275 $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'ALetter'}] 2276 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2277 $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'ExtPict_LE'}] 2278 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2279 $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'Hebrew_Letter'}] 2280 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2281 $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'ALetter'}] 2282 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2283 $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'ExtPict_LE'}] 2284 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2285 $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'Hebrew_Letter'}] 2286 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; 2287 2288 # WB6 (ALetter | Hebrew_Letter) × (MidLetter | MidNumLet 2289 # | Single_Quote) (ALetter | Hebrew_Letter) 2290 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'MidNumLet'}] 2291 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2292 $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'MidNumLet'}] 2293 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2294 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'MidNumLet'}] 2295 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2296 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'MidLetter'}] 2297 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2298 $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'MidLetter'}] 2299 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2300 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'MidLetter'}] 2301 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2302 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Single_Quote'}] 2303 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2304 $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'Single_Quote'}] 2305 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2306 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Single_Quote'}] 2307 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; 2308 2309 # Do not break between most letters. 2310 # WB5 (ALetter | Hebrew_Letter) × (ALetter | Hebrew_Letter) 2311 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'ALetter'}] 2312 = $wb_actions{'WB_NOBREAK'}; 2313 $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'ALetter'}] 2314 = $wb_actions{'WB_NOBREAK'}; 2315 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Hebrew_Letter'}] 2316 = $wb_actions{'WB_NOBREAK'}; 2317 $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'Hebrew_Letter'}] 2318 = $wb_actions{'WB_NOBREAK'}; 2319 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ALetter'}] 2320 = $wb_actions{'WB_NOBREAK'}; 2321 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ExtPict_LE'}] 2322 = $wb_actions{'WB_NOBREAK'}; 2323 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Hebrew_Letter'}] 2324 = $wb_actions{'WB_NOBREAK'}; 2325 $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'ExtPict_LE'}] 2326 = $wb_actions{'WB_NOBREAK'}; 2327 2328 # Ignore Format and Extend characters, except after sot, CR, LF, and 2329 # Newline. This also has the effect of: Any × (Format | Extend | ZWJ) 2330 # WB4 X (Extend | Format | ZWJ)* → X 2331 for my $i (0 .. @wb_table - 1) { 2332 $wb_table[$wb_enums{'Extend'}][$i] 2333 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'}; 2334 $wb_table[$wb_enums{'Format'}][$i] 2335 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'}; 2336 $wb_table[$wb_enums{'ZWJ'}][$i] 2337 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'}; 2338 } 2339 for my $i (0 .. @wb_table - 1) { 2340 $wb_table[$i][$wb_enums{'Extend'}] = $wb_actions{'WB_NOBREAK'}; 2341 $wb_table[$i][$wb_enums{'Format'}] = $wb_actions{'WB_NOBREAK'}; 2342 $wb_table[$i][$wb_enums{'ZWJ'}] = $wb_actions{'WB_NOBREAK'}; 2343 } 2344 2345 # Implied is that these attach to the character before them, except for 2346 # the characters that mark the end of a region of text. The rules below 2347 # override the ones set up here, for all the characters that need 2348 # overriding. 2349 for my $i (0 .. @wb_table - 1) { 2350 $wb_table[$i][$wb_enums{'Extend'}] = $wb_actions{'WB_NOBREAK'}; 2351 $wb_table[$i][$wb_enums{'Format'}] = $wb_actions{'WB_NOBREAK'}; 2352 } 2353 2354 # Keep horizontal whitespace together 2355 # Use perl's tailoring instead 2356 # WB3d WSegSpace × WSegSpace 2357 #$wb_table[$wb_enums{'WSegSpace'}][$wb_enums{'WSegSpace'}] 2358 # = $wb_actions{'WB_NOBREAK'}; 2359 2360 # Do not break within emoji zwj sequences. 2361 # WB3c ZWJ × ( Glue_After_Zwj | EBG ) 2362 $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'Glue_After_Zwj'}] 2363 = $wb_actions{'WB_NOBREAK'}; 2364 $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'E_Base_GAZ'}] 2365 = $wb_actions{'WB_NOBREAK'}; 2366 $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'ExtPict_XX'}] 2367 = $wb_actions{'WB_NOBREAK'}; 2368 $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'ExtPict_LE'}] 2369 = $wb_actions{'WB_NOBREAK'}; 2370 2371 # Break before and after newlines 2372 # WB3b ÷ (Newline | CR | LF) 2373 # WB3a (Newline | CR | LF) ÷ 2374 # et. al. 2375 for my $i ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') { 2376 for my $j (0 .. @wb_table - 1) { 2377 $wb_table[$j][$wb_enums{$i}] = $wb_actions{'WB_BREAKABLE'}; 2378 $wb_table[$wb_enums{$i}][$j] = $wb_actions{'WB_BREAKABLE'}; 2379 } 2380 } 2381 2382 # But do not break within white space. 2383 # WB3 CR × LF 2384 # et.al. 2385 for my $i ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') { 2386 for my $j ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') { 2387 $wb_table[$wb_enums{$i}][$wb_enums{$j}] = $wb_actions{'WB_NOBREAK'}; 2388 } 2389 } 2390 2391 # And do not break horizontal space followed by Extend or Format or ZWJ 2392 $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'Extend'}] 2393 = $wb_actions{'WB_NOBREAK'}; 2394 $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'Format'}] 2395 = $wb_actions{'WB_NOBREAK'}; 2396 $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'ZWJ'}] 2397 = $wb_actions{'WB_NOBREAK'}; 2398 $wb_table[$wb_enums{'Perl_Tailored_HSpace'}] 2399 [$wb_enums{'Perl_Tailored_HSpace'}] 2400 = $wb_actions{'WB_hs_then_hs'}; 2401 2402 # Break at the start and end of text, unless the text is empty 2403 # WB2 Any ÷ eot 2404 # WB1 sot ÷ Any 2405 for my $i (0 .. @wb_table - 1) { 2406 $wb_table[$i][$wb_enums{'EDGE'}] = $wb_actions{'WB_BREAKABLE'}; 2407 $wb_table[$wb_enums{'EDGE'}][$i] = $wb_actions{'WB_BREAKABLE'}; 2408 } 2409 $wb_table[$wb_enums{'EDGE'}][$wb_enums{'EDGE'}] = 0; 2410 2411 output_table_common('WB', \%wb_actions, 2412 \@wb_table, \@wb_short_enums, \%wb_abbreviations); 2413} 2414 2415sub sanitize_name ($) { 2416 # Change the non-word characters in the input string to standardized word 2417 # equivalents 2418 # 2419 my $sanitized = shift; 2420 $sanitized =~ s/=/__/; 2421 $sanitized =~ s/&/_AMP_/; 2422 $sanitized =~ s/\./_DOT_/; 2423 $sanitized =~ s/-/_MINUS_/; 2424 $sanitized =~ s!/!_SLASH_!; 2425 2426 return $sanitized; 2427} 2428 2429sub token_name 2430{ 2431 my $name = sanitize_name(shift); 2432 warn "$name contains non-word" if $name =~ /\W/; 2433 2434 return "$table_name_prefix\U$name" 2435} 2436 2437switch_pound_if ('ALL', 'PERL_IN_REGCOMP_C'); 2438 2439output_invlist("Latin1", [ 0, 256 ]); 2440output_invlist("AboveLatin1", [ 256 ]); 2441 2442if ($num_anyof_code_points == 256) { # Same as Latin1 2443 print $out_fh 2444 "\nstatic const UV * const InBitmap_invlist = Latin1_invlist;\n"; 2445} 2446else { 2447 output_invlist("InBitmap", [ 0, $num_anyof_code_points ]); 2448} 2449 2450end_file_pound_if; 2451 2452# We construct lists for all the POSIX and backslash sequence character 2453# classes in two forms: 2454# 1) ones which match only in the ASCII range 2455# 2) ones which match either in the Latin1 range, or the entire Unicode range 2456# 2457# These get compiled in, and hence affect the memory footprint of every Perl 2458# program, even those not using Unicode. To minimize the size, currently 2459# the Latin1 version is generated for the beyond ASCII range except for those 2460# lists that are quite small for the entire range, such as for \s, which is 22 2461# UVs long plus 4 UVs (currently) for the header. 2462# 2463# To save even more memory, the ASCII versions could be derived from the 2464# larger ones at runtime, saving some memory (minus the expense of the machine 2465# instructions to do so), but these are all small anyway, so their total is 2466# about 100 UVs. 2467# 2468# In the list of properties below that get generated, the L1 prefix is a fake 2469# property that means just the Latin1 range of the full property (whose name 2470# has an X prefix instead of L1). 2471# 2472# An initial & means to use the subroutine from this file instead of an 2473# official inversion list. 2474# 2475print "Computing unicode properties\n" if DEBUG; 2476 2477# Below is the list of property names to generate. '&' means to use the 2478# subroutine to generate the inversion list instead of the generic code 2479# below. Some properties have a comma-separated list after the name, 2480# These are extra enums to add to those found in the Unicode tables. 2481no warnings 'qw'; 2482 # Ignore non-alpha in sort 2483my @props; 2484push @props, sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw( 2485 &UpperLatin1 2486 _Perl_GCB,EDGE,E_Base,E_Base_GAZ,E_Modifier,Glue_After_Zwj,LV,Prepend,Regional_Indicator,SpacingMark,ZWJ,ExtPict_XX 2487 _Perl_LB,EDGE,Close_Parenthesis,Hebrew_Letter,Next_Line,Regional_Indicator,ZWJ,Contingent_Break,E_Base,E_Modifier,H2,H3,JL,JT,JV,Word_Joiner,East_Asian_CP,East_Asian_OP,Unassigned_Extended_Pictographic_Ideographic 2488 _Perl_SB,EDGE,SContinue,CR,Extend,LF 2489 _Perl_WB,Perl_Tailored_HSpace,EDGE,UNKNOWN,CR,Double_Quote,E_Base,E_Base_GAZ,E_Modifier,Extend,Glue_After_Zwj,Hebrew_Letter,LF,MidNumLet,Newline,Regional_Indicator,Single_Quote,ZWJ,ExtPict_XX,ExtPict_LE 2490 _Perl_SCX,Latin,Inherited,Unknown,Kore,Jpan,Hanb,INVALID 2491 Lowercase_Mapping 2492 Titlecase_Mapping 2493 Uppercase_Mapping 2494 Simple_Case_Folding 2495 Case_Folding 2496 &_Perl_IVCF 2497 &_Perl_CCC_non0_non230 2498 ); 2499 # NOTE that the convention is that extra enum values come 2500 # after the property name, separated by commas, with the enums 2501 # that aren't ever defined by Unicode (with some exceptions) 2502 # containing at least 4 all-uppercase characters. 2503 2504 # Some of the enums are current official property values that 2505 # are needed for the rules in constructing certain tables in 2506 # this file, and perhaps in regexec.c as well. They are here 2507 # so that things don't crash when compiled on earlier Unicode 2508 # releases where they don't exist. Thus the rules that use 2509 # them still get compiled, but no code point actually uses 2510 # them, hence they won't get exercized on such Unicode 2511 # versions, but the code will still compile and run, though 2512 # may not give the precise results that those versions would 2513 # expect, but reasonable results nonetheless. 2514 # 2515 # Other enums are due to the fact that Unicode has in more 2516 # recent versions added criteria to the rules in these extra 2517 # tables that are based on factors outside the property 2518 # values. And those have to be accounted for, essentially by 2519 # here splitting certain enum equivalence classes based on 2520 # those extra rules. 2521 # 2522 # EDGE is supposed to be a boundary between some types of 2523 # enums, but khw thinks that isn't valid any more. 2524 2525my @bin_props; 2526my @perl_prop_synonyms; 2527my %enums; 2528my @deprecated_messages = ""; # Element [0] is a placeholder 2529my %deprecated_tags; 2530 2531my $float_e_format = qr/ ^ -? \d \. \d+ e [-+] \d+ $ /x; 2532 2533# Create another hash that maps floating point x.yyEzz representation to what 2534# %stricter_to_file_of does for the equivalent rational. A typical entry in 2535# the latter hash is 2536# 2537# 'nv=1/2' => 'Nv/1_2', 2538# 2539# From that, this loop creates an entry 2540# 2541# 'nv=5.00e-01' => 'Nv/1_2', 2542# 2543# %stricter_to_file_of contains far more than just the rationals. Instead we 2544# use %Unicode::UCD::nv_floating_to_rational which should have an entry for each 2545# nv in the former hash. 2546my %floating_to_file_of; 2547foreach my $key (keys %Unicode::UCD::nv_floating_to_rational) { 2548 my $value = $Unicode::UCD::nv_floating_to_rational{$key}; 2549 $floating_to_file_of{$key} = $Unicode::UCD::stricter_to_file_of{"nv=$value"}; 2550} 2551 2552# Properties that are specified with a prop=value syntax 2553my @equals_properties; 2554 2555# Collect all the binary properties from data in lib/unicore 2556# Sort so that complements come after the main table, and the shortest 2557# names first, finally alphabetically. Also, sort together the tables we want 2558# to be kept together, and prefer those with 'posix' in their names, which is 2559# what the C code is expecting their names to be. 2560foreach my $property (sort 2561 { exists $keep_together{lc $b} <=> exists $keep_together{lc $a} 2562 or $b =~ /posix/i <=> $a =~ /posix/i 2563 or $b =~ /perl/i <=> $a =~ /perl/i 2564 or $a =~ $float_e_format <=> $b =~ $float_e_format 2565 or $a =~ /!/ <=> $b =~ /!/ 2566 or length $a <=> length $b 2567 or $a cmp $b 2568 } keys %Unicode::UCD::loose_to_file_of, 2569 keys %Unicode::UCD::stricter_to_file_of, 2570 keys %floating_to_file_of 2571) { 2572 2573 # These two hashes map properties to values that can be considered to 2574 # be checksums. If two properties have the same checksum, they have 2575 # identical entries. Otherwise they differ in some way. 2576 my $tag = $Unicode::UCD::loose_to_file_of{$property}; 2577 $tag = $Unicode::UCD::stricter_to_file_of{$property} unless defined $tag; 2578 $tag = $floating_to_file_of{$property} unless defined $tag; 2579 2580 # The tag may contain an '!' meaning it is identical to the one formed 2581 # by removing the !, except that it is inverted. 2582 my $inverted = $tag =~ s/!//; 2583 2584 # This hash is lacking the property name 2585 $property = "nv=$property" if $property =~ $float_e_format; 2586 2587 # The list of 'prop=value' entries that this single entry expands to 2588 my @this_entries; 2589 2590 # Split 'property=value' on the equals sign, with $lhs being the whole 2591 # thing if there is no '=' 2592 my ($lhs, $rhs) = $property =~ / ( [^=]* ) ( =? .*) /x; 2593 2594 # $lhs then becomes the property name. 2595 my $prop_value = $rhs =~ s/ ^ = //rx; 2596 2597 push @equals_properties, $lhs if $prop_value ne ""; 2598 2599 # See if there are any synonyms for this property. 2600 if (exists $prop_name_aliases{$lhs}) { 2601 2602 # If so, do the combinatorics so that a new entry is added for 2603 # each legal property combined with the property value (which is 2604 # $rhs) 2605 foreach my $alias (@{$prop_name_aliases{$lhs}}) { 2606 2607 # But, there are some ambiguities, like 'script' is a synonym 2608 # for 'sc', and 'sc' can stand alone, meaning something 2609 # entirely different than 'script'. 'script' cannot stand 2610 # alone. Don't add if the potential new lhs is in the hash of 2611 # stand-alone properties. 2612 no warnings 'once'; 2613 next if $rhs eq "" && grep { $alias eq $_ } 2614 keys %Unicode::UCD::loose_property_to_file_of; 2615 2616 my $new_entry = $alias . $rhs; 2617 push @this_entries, $new_entry; 2618 } 2619 } 2620 2621 # Above, we added the synonyms for the base entry we're now 2622 # processing. But we haven't dealt with it yet. If we already have a 2623 # property with the identical characteristics, this becomes just a 2624 # synonym for it. 2625 2626 if (exists $enums{$tag}) { 2627 push @this_entries, $property; 2628 } 2629 else { # Otherwise, create a new entry. 2630 2631 # Add to the list of properties to generate inversion lists for. 2632 push @bin_props, uc $property; 2633 2634 # Create a rule for the parser 2635 if (! exists $keywords{$property}) { 2636 $keywords{$property} = token_name($property); 2637 } 2638 2639 # And create an enum for it. 2640 $enums{$tag} = $table_name_prefix . uc sanitize_name($property); 2641 2642 $perl_tags{$tag} = 1 if exists $keep_together{lc $property}; 2643 2644 # Some properties are deprecated. This hash tells us so, and the 2645 # warning message to raise if they are used. 2646 if (exists $Unicode::UCD::why_deprecated{$tag}) { 2647 $deprecated_tags{$enums{$tag}} = scalar @deprecated_messages; 2648 push @deprecated_messages, $Unicode::UCD::why_deprecated{$tag}; 2649 } 2650 2651 # Our sort above should have made sure that we see the 2652 # non-inverted version first, but this makes sure. 2653 warn "$property is inverted!!!" if $inverted; 2654 } 2655 2656 # Everything else is #defined to be the base enum, inversion is 2657 # indicated by negating the value. 2658 my $defined_to = ""; 2659 $defined_to .= "-" if $inverted; 2660 $defined_to .= $enums{$tag}; 2661 2662 # Go through the entries that evaluate to this. 2663 @this_entries = uniques @this_entries; 2664 foreach my $define (@this_entries) { 2665 2666 # There is a rule for the parser for each. 2667 $keywords{$define} = $defined_to; 2668 2669 # And a #define for all simple names equivalent to a perl property, 2670 # except those that begin with 'is' or 'in'; 2671 if (exists $perl_tags{$tag} && $property !~ / ^ i[ns] | = /x) { 2672 push @perl_prop_synonyms, "#define " 2673 . $table_name_prefix 2674 . uc(sanitize_name($define)) 2675 . " $defined_to"; 2676 } 2677 } 2678} 2679 2680@bin_props = sort { exists $keep_together{lc $b} <=> exists $keep_together{lc $a} 2681 or $a cmp $b 2682 } @bin_props; 2683@perl_prop_synonyms = sort(uniques(@perl_prop_synonyms)); 2684push @props, @bin_props; 2685 2686foreach my $prop (@props) { 2687 2688 # For the Latin1 properties, we change to use the eXtended version of the 2689 # base property, then go through the result and get rid of everything not 2690 # in Latin1 (above 255). Actually, we retain the element for the range 2691 # that crosses the 255/256 boundary if it is one that matches the 2692 # property. For example, in the Word property, there is a range of code 2693 # points that start at U+00F8 and goes through U+02C1. Instead of 2694 # artificially cutting that off at 256 because 256 is the first code point 2695 # above Latin1, we let the range go to its natural ending. That gives us 2696 # extra information with no added space taken. But if the range that 2697 # crosses the boundary is one that doesn't match the property, we don't 2698 # start a new range above 255, as that could be construed as going to 2699 # infinity. For example, the Upper property doesn't include the character 2700 # at 255, but does include the one at 256. We don't include the 256 one. 2701 my $prop_name = $prop; 2702 my $is_local_sub = $prop_name =~ s/^&//; 2703 my $extra_enums = ""; 2704 $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x; 2705 my $lookup_prop = $prop_name; 2706 $prop_name = sanitize_name($prop_name); 2707 $prop_name = $table_name_prefix . $prop_name 2708 if grep { lc $lookup_prop eq lc $_ } @bin_props; 2709 my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/ 2710 or $lookup_prop =~ s/^L1//); 2711 my $nonl1_only = 0; 2712 $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only; 2713 ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x; 2714 2715 for my $charset (get_supported_code_pages()) { 2716 @a2n = @{get_a2n($charset)}; 2717 2718 my @invlist; 2719 my @invmap; 2720 my $map_format = 0;; 2721 my $map_default; 2722 my $maps_to_code_point = 0; 2723 my $to_adjust = 0; 2724 my $same_in_all_code_pages; 2725 if ($is_local_sub) { 2726 my @return = eval $lookup_prop; 2727 die $@ if $@; 2728 my $invlist_ref = shift @return; 2729 @invlist = @$invlist_ref; 2730 if (@return) { # If has other values returned , must be an 2731 # inversion map 2732 my $invmap_ref = shift @return; 2733 @invmap = @$invmap_ref; 2734 $map_format = shift @return; 2735 $map_default = shift @return; 2736 } 2737 } 2738 else { 2739 @invlist = prop_invlist($lookup_prop, '_perl_core_internal_ok'); 2740 if (! @invlist) { 2741 2742 # If couldn't find a non-empty inversion list, see if it is 2743 # instead an inversion map 2744 my ($list_ref, $map_ref, $format, $default) 2745 = prop_invmap($lookup_prop, '_perl_core_internal_ok'); 2746 if (! $list_ref) { 2747 # An empty return here could mean an unknown property, or 2748 # merely that the original inversion list is empty. Call 2749 # in scalar context to differentiate 2750 my $count = prop_invlist($lookup_prop, 2751 '_perl_core_internal_ok'); 2752 if (defined $count) { 2753 # Short-circuit an empty inversion list. 2754 output_invlist($prop_name, \@invlist, $charset); 2755 last; 2756 } 2757 die "Could not find inversion list for '$lookup_prop'" 2758 } 2759 else { 2760 @invlist = @$list_ref; 2761 @invmap = @$map_ref; 2762 $map_format = $format; 2763 $map_default = $default; 2764 } 2765 } 2766 } 2767 2768 if ($map_format) { 2769 $maps_to_code_point = $map_format =~ / a ($ | [^r] ) /x; 2770 $to_adjust = $map_format =~ /a/; 2771 } 2772 2773 # Re-order the Unicode code points to native ones for this platform. 2774 # This is only needed for code points below 256, because native code 2775 # points are only in that range. For inversion maps of properties 2776 # where the mappings are adjusted (format =~ /a/), this reordering 2777 # could mess up the adjustment pattern that was in the input, so that 2778 # has to be dealt with. 2779 # 2780 # And inversion maps that map to code points need to eventually have 2781 # all those code points remapped to native, and it's better to do that 2782 # here, going through the whole list not just those below 256. This 2783 # is because some inversion maps have adjustments (format =~ /a/) 2784 # which may be affected by the reordering. This code needs to be done 2785 # both for when we are translating the inversion lists for < 256, and 2786 # for the inversion maps for everything. By doing both in this loop, 2787 # we can share that code. 2788 # 2789 # So, we go through everything for an inversion map to code points; 2790 # otherwise, we can skip any remapping at all if we are going to 2791 # output only the above-Latin1 values, or if the range spans the whole 2792 # of 0..256, as the remap will also include all of 0..256 (256 not 2793 # 255 because a re-ordering could cause 256 to need to be in the same 2794 # range as 255.) 2795 if ( (@invmap && $maps_to_code_point) 2796 || ( @invlist 2797 && $invlist[0] < 256 2798 && ( $invlist[0] != 0 2799 || (scalar @invlist != 1 && $invlist[1] < 256)))) 2800 { 2801 $same_in_all_code_pages = 0; 2802 if (! @invmap) { # Straight inversion list 2803 # Look at all the ranges that start before 257. 2804 my @latin1_list; 2805 while (@invlist) { 2806 last if $invlist[0] > 256; 2807 my $upper = @invlist > 1 2808 ? $invlist[1] - 1 # In range 2809 2810 # To infinity. You may want to stop much much 2811 # earlier; going this high may expose perl 2812 # deficiencies with very large numbers. 2813 : 256; 2814 for my $j ($invlist[0] .. $upper) { 2815 push @latin1_list, a2n($j); 2816 } 2817 2818 shift @invlist; # Shift off the range that's in the list 2819 shift @invlist; # Shift off the range not in the list 2820 } 2821 2822 # Here @invlist contains all the ranges in the original that 2823 # start at code points above 256, and @latin1_list contains 2824 # all the native code points for ranges that start with a 2825 # Unicode code point below 257. We sort the latter and 2826 # convert it to inversion list format. Then simply prepend it 2827 # to the list of the higher code points. 2828 @latin1_list = sort { $a <=> $b } @latin1_list; 2829 @latin1_list = mk_invlist_from_sorted_cp_list(\@latin1_list); 2830 unshift @invlist, @latin1_list; 2831 } 2832 else { # Is an inversion map 2833 2834 # This is a similar procedure as plain inversion list, but has 2835 # multiple buckets. A plain inversion list just has two 2836 # buckets, 1) 'in' the list; and 2) 'not' in the list, and we 2837 # pretty much can ignore the 2nd bucket, as it is completely 2838 # defined by the 1st. But here, what we do is create buckets 2839 # which contain the code points that map to each, translated 2840 # to native and turned into an inversion list. Thus each 2841 # bucket is an inversion list of native code points that map 2842 # to it or don't map to it. We use these to create an 2843 # inversion map for the whole property. 2844 2845 # As mentioned earlier, we use this procedure to not just 2846 # remap the inversion list to native values, but also the maps 2847 # of code points to native ones. In the latter case we have 2848 # to look at the whole of the inversion map (or at least to 2849 # above Unicode; as the maps of code points above that should 2850 # all be to the default). 2851 my $upper_limit = (! $maps_to_code_point) 2852 ? 256 2853 : (Unicode::UCD::UnicodeVersion() eq '1.1.5') 2854 ? 0xFFFF 2855 : 0x10FFFF; 2856 2857 my %mapped_lists; # A hash whose keys are the buckets. 2858 while (@invlist) { 2859 last if $invlist[0] > $upper_limit; 2860 2861 # This shouldn't actually happen, as prop_invmap() returns 2862 # an extra element at the end that is beyond $upper_limit 2863 die "inversion map (for $prop_name) that extends to" 2864 . " infinity is unimplemented" unless @invlist > 1; 2865 2866 my $bucket; 2867 2868 # A hash key can't be a ref (we are only expecting arrays 2869 # of scalars here), so convert any such to a string that 2870 # will be converted back later (using a vertical tab as 2871 # the separator). 2872 if (ref $invmap[0]) { 2873 $bucket = join "\cK", map { a2n($_) } @{$invmap[0]}; 2874 } 2875 elsif ( $maps_to_code_point 2876 && $invmap[0] =~ $integer_or_float_re) 2877 { 2878 2879 # Do convert to native for maps to single code points. 2880 # There are some properties that have a few outlier 2881 # maps that aren't code points, so the above test 2882 # skips those. 0 is never remapped. 2883 $bucket = $invmap[0] == 0 ? 0 : a2n($invmap[0]); 2884 } else { 2885 $bucket = $invmap[0]; 2886 } 2887 2888 # We now have the bucket that all code points in the range 2889 # map to, though possibly they need to be adjusted. Go 2890 # through the range and put each translated code point in 2891 # it into its bucket. 2892 my $base_map = $invmap[0]; 2893 for my $j ($invlist[0] .. $invlist[1] - 1) { 2894 if ($to_adjust 2895 # The 1st code point doesn't need adjusting 2896 && $j > $invlist[0] 2897 2898 # Skip any non-numeric maps: these are outliers 2899 # that aren't code points. 2900 && $base_map =~ $integer_or_float_re 2901 2902 # 'ne' because the default can be a string 2903 && $base_map ne $map_default) 2904 { 2905 # We adjust, by incrementing each the bucket and 2906 # the map. For code point maps, translate to 2907 # native 2908 $base_map++; 2909 $bucket = ($maps_to_code_point) 2910 ? a2n($base_map) 2911 : $base_map; 2912 } 2913 2914 # Add the native code point to the bucket for the 2915 # current map 2916 push @{$mapped_lists{$bucket}}, a2n($j); 2917 } # End of loop through all code points in the range 2918 2919 # Get ready for the next range 2920 shift @invlist; 2921 shift @invmap; 2922 } # End of loop through all ranges in the map. 2923 2924 # Here, @invlist and @invmap retain all the ranges from the 2925 # originals that start with code points above $upper_limit. 2926 # Each bucket in %mapped_lists contains all the code points 2927 # that map to that bucket. If the bucket is for a map to a 2928 # single code point, the bucket has been converted to native. 2929 # If something else (including multiple code points), no 2930 # conversion is done. 2931 # 2932 # Now we recreate the inversion map into %xlated, but this 2933 # time for the native character set. 2934 my %xlated; 2935 foreach my $bucket (keys %mapped_lists) { 2936 2937 # Sort and convert this bucket to an inversion list. The 2938 # result will be that ranges that start with even-numbered 2939 # indexes will be for code points that map to this bucket; 2940 # odd ones map to some other bucket, and are discarded 2941 # below. 2942 @{$mapped_lists{$bucket}} 2943 = sort{ $a <=> $b} @{$mapped_lists{$bucket}}; 2944 @{$mapped_lists{$bucket}} 2945 = mk_invlist_from_sorted_cp_list( 2946 \@{$mapped_lists{$bucket}}); 2947 2948 # Add each even-numbered range in the bucket to %xlated; 2949 # so that the keys of %xlated become the range start code 2950 # points, and the values are their corresponding maps. 2951 while (@{$mapped_lists{$bucket}}) { 2952 my $range_start = $mapped_lists{$bucket}->[0]; 2953 if ($bucket =~ /\cK/) { 2954 @{$xlated{$range_start}} = split /\cK/, $bucket; 2955 } 2956 else { 2957 # If adjusting, and there is more than one thing 2958 # that maps to the same thing, they must be split 2959 # so that later the adjusting doesn't think the 2960 # subsequent items can go away because of the 2961 # adjusting. 2962 my $range_end = ( $to_adjust 2963 && $bucket != $map_default) 2964 ? $mapped_lists{$bucket}->[1] - 1 2965 : $range_start; 2966 for my $i ($range_start .. $range_end) { 2967 $xlated{$i} = $bucket; 2968 } 2969 } 2970 shift @{$mapped_lists{$bucket}}; # Discard odd ranges 2971 shift @{$mapped_lists{$bucket}}; # Get ready for next 2972 # iteration 2973 } 2974 } # End of loop through all the buckets. 2975 2976 # Here %xlated's keys are the range starts of all the code 2977 # points in the inversion map. Construct an inversion list 2978 # from them. 2979 my @new_invlist = sort { $a <=> $b } keys %xlated; 2980 2981 # If the list is adjusted, we want to munge this list so that 2982 # we only have one entry for where consecutive code points map 2983 # to consecutive values. We just skip the subsequent entries 2984 # where this is the case. 2985 if ($to_adjust) { 2986 my @temp; 2987 for my $i (0 .. @new_invlist - 1) { 2988 next if $i > 0 2989 && $new_invlist[$i-1] + 1 == $new_invlist[$i] 2990 && $xlated{$new_invlist[$i-1]} 2991 =~ $integer_or_float_re 2992 && $xlated{$new_invlist[$i]} 2993 =~ $integer_or_float_re 2994 && $xlated{$new_invlist[$i-1]} + 1 2995 == $xlated{$new_invlist[$i]}; 2996 push @temp, $new_invlist[$i]; 2997 } 2998 @new_invlist = @temp; 2999 } 3000 3001 # The inversion map comes from %xlated's values. We can 3002 # unshift each onto the front of the untouched portion, in 3003 # reverse order of the portion we did process. 3004 foreach my $start (reverse @new_invlist) { 3005 unshift @invmap, $xlated{$start}; 3006 } 3007 3008 # Finally prepend the inversion list we have just constructed 3009 # to the one that contains anything we didn't process. 3010 unshift @invlist, @new_invlist; 3011 } 3012 } 3013 elsif (@invmap) { # inversion maps can't cope with this variable 3014 # being true, even if it could be true 3015 $same_in_all_code_pages = 0; 3016 } 3017 else { 3018 $same_in_all_code_pages = 1; 3019 } 3020 3021 # prop_invmap() returns an extra final entry, which we can now 3022 # discard. 3023 if (@invmap) { 3024 pop @invlist; 3025 pop @invmap; 3026 } 3027 3028 if ($l1_only) { 3029 die "Unimplemented to do a Latin-1 only inversion map" if @invmap; 3030 for my $i (0 .. @invlist - 1 - 1) { 3031 if ($invlist[$i] > 255) { 3032 3033 # In an inversion list, even-numbered elements give the code 3034 # points that begin ranges that match the property; 3035 # odd-numbered give ones that begin ranges that don't match. 3036 # If $i is odd, we are at the first code point above 255 that 3037 # doesn't match, which means the range it is ending does 3038 # match, and crosses the 255/256 boundary. We want to 3039 # include this ending point, so increment $i, so the 3040 # splice below includes it. Conversely, if $i is even, it 3041 # is the first code point above 255 that matches, which 3042 # means there was no matching range that crossed the 3043 # boundary, and we don't want to include this code point, 3044 # so splice before it. 3045 $i++ if $i % 2 != 0; 3046 3047 # Remove everything past this. 3048 splice @invlist, $i; 3049 splice @invmap, $i if @invmap; 3050 last; 3051 } 3052 } 3053 } 3054 elsif ($nonl1_only) { 3055 my $found_nonl1 = 0; 3056 for my $i (0 .. @invlist - 1 - 1) { 3057 next if $invlist[$i] < 256; 3058 3059 # Here, we have the first element in the array that indicates an 3060 # element above Latin1. Get rid of all previous ones. 3061 splice @invlist, 0, $i; 3062 splice @invmap, 0, $i if @invmap; 3063 3064 # If this one's index is not divisible by 2, it means that this 3065 # element is inverting away from being in the list, which means 3066 # all code points from 256 to this one are in this list (or 3067 # map to the default for inversion maps) 3068 if ($i % 2 != 0) { 3069 unshift @invlist, 256; 3070 unshift @invmap, $map_default if @invmap; 3071 } 3072 $found_nonl1 = 1; 3073 last; 3074 } 3075 if (! $found_nonl1) { 3076 warn "No non-Latin1 code points in $prop_name"; 3077 output_invlist($prop_name, []); 3078 last; 3079 } 3080 } 3081 3082 switch_pound_if ($prop_name, 'PERL_IN_REGCOMP_C'); 3083 start_charset_pound_if($charset, 1) unless $same_in_all_code_pages; 3084 3085 output_invlist($prop_name, \@invlist, ($same_in_all_code_pages) 3086 ? $applies_to_all_charsets_text 3087 : $charset); 3088 3089 if (@invmap) { 3090 output_invmap($prop_name, \@invmap, $lookup_prop, $map_format, 3091 $map_default, $extra_enums, $charset); 3092 } 3093 3094 last if $same_in_all_code_pages; 3095 end_charset_pound_if; 3096 } 3097} 3098 3099print "Finished computing unicode properties\n" if DEBUG; 3100 3101print $out_fh "\nconst char * const deprecated_property_msgs[] = {\n\t"; 3102print $out_fh join ",\n\t", map { "\"$_\"" } @deprecated_messages; 3103print $out_fh "\n};\n"; 3104 3105switch_pound_if ('binary_invlist_enum', 'PERL_IN_REGCOMP_C'); 3106 3107my @enums = sort values %enums; 3108 3109# Save a copy of these before modification 3110my @invlist_names = map { "${_}_invlist" } @enums; 3111 3112# Post-process the enums for deprecated properties. 3113if (scalar keys %deprecated_tags) { 3114 my $seen_deprecated = 0; 3115 foreach my $enum (@enums) { 3116 if (grep { $_ eq $enum } keys %deprecated_tags) { 3117 3118 # Change the enum name for this deprecated property to a 3119 # munged one to act as a placeholder in the typedef. Then 3120 # make the real name be a #define whose value is such that 3121 # its modulus with the number of enums yields the index into 3122 # the table occupied by the placeholder. And so that dividing 3123 # the #define value by the table length gives an index into 3124 # the table of deprecation messages for the corresponding 3125 # warning. 3126 my $revised_enum = "${enum}_perl_aux"; 3127 if (! $seen_deprecated) { 3128 $seen_deprecated = 1; 3129 print $out_fh "\n"; 3130 } 3131 print $out_fh "#define $enum ($revised_enum + (MAX_UNI_KEYWORD_INDEX * $deprecated_tags{$enum}))\n"; 3132 $enum = $revised_enum; 3133 } 3134 } 3135} 3136 3137print $out_fh "\ntypedef enum {\n\tPERL_BIN_PLACEHOLDER = 0,", 3138 " /* So no real value is zero */\n\t"; 3139print $out_fh join ",\n\t", @enums; 3140print $out_fh "\n"; 3141print $out_fh "} binary_invlist_enum;\n"; 3142print $out_fh "\n#define MAX_UNI_KEYWORD_INDEX $enums[-1]\n"; 3143 3144switch_pound_if ('binary_property_tables', 'PERL_IN_REGCOMP_C'); 3145 3146output_table_header($out_fh, "UV *", "uni_prop_ptrs"); 3147print $out_fh "\tNULL,\t/* Placeholder */\n"; 3148print $out_fh "\t"; 3149print $out_fh join ",\n\t", @invlist_names; 3150print $out_fh "\n"; 3151 3152output_table_trailer(); 3153 3154switch_pound_if ('synonym defines', 'PERL_IN_REGCOMP_C'); 3155 3156print $out_fh join "\n", "\n", 3157 #'# ifdef DOINIT', 3158 #"\n", 3159 "/* Synonyms for perl properties */", 3160 @perl_prop_synonyms, 3161 #"\n", 3162 #"# endif /* DOINIT */", 3163 "\n"; 3164 3165switch_pound_if ('Valid property_values', 'PERL_IN_REGCOMP_C'); 3166 3167# Each entry is a pointer to a table of property values for some property. 3168# (Other properties may share this table. The next two data structures allow 3169# this sharing to be implemented.) 3170my @values_tables = "NULL /* Placeholder so zero index is an error */"; 3171 3172# Keys are all the values of a property, strung together. The value of each 3173# key is its index in @values_tables. This is because many properties have 3174# the same values, and this allows the data to appear just once. 3175my %joined_values; 3176 3177# #defines for indices into @values_tables, so can have synonyms resolved by 3178# the C compiler. 3179my @values_indices; 3180 3181print "Computing short unicode properties\n" if DEBUG; 3182# Go through each property which is specifiable by \p{prop=value}, and create 3183# a hash with the keys being the canonicalized short property names, and the 3184# values for each property being all possible values that it can take on. 3185# Both the full value and its short, canonicalized into lc, sans punctuation 3186# version are included. 3187my %all_values; 3188for my $property (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } 3189 uniques @equals_properties) 3190{ 3191 # Get and canonicalize the short name for this property. 3192 my ($short_name) = prop_aliases($property); 3193 $short_name = lc $short_name; 3194 $short_name =~ s/[ _-]//g; 3195 3196 # Now look at each value this property can take on 3197 foreach my $value (prop_values($short_name)) { 3198 3199 # And for each value, look at each synonym for it 3200 foreach my $alias (prop_value_aliases($short_name, $value)) { 3201 3202 # Add each synonym 3203 push @{$all_values{$short_name}}, $alias; 3204 3205 # As well as its canonicalized name. khw made the decision to not 3206 # support the grandfathered L_ Gc property value 3207 $alias = lc $alias; 3208 $alias =~ s/[ _-]//g unless $alias =~ $numeric_re; 3209 push @{$all_values{$short_name}}, $alias; 3210 } 3211 } 3212} 3213print "Finished computing short unicode properties\n" if DEBUG; 3214 3215# Also include the old style block names, using the recipe given in 3216# Unicode::UCD 3217foreach my $block (prop_values('block')) { 3218 push @{$all_values{'blk'}}, charblock((prop_invlist("block=$block"))[0]); 3219} 3220 3221print "Creating property tables\n" if DEBUG; 3222# Now create output tables for each property in @equals_properties (the keys 3223# in %all_values) each containing that property's possible values as computed 3224# just above. 3225PROPERTY: 3226for my $property (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) 3227 or $a cmp $b } keys %all_values) 3228{ 3229 @{$all_values{$property}} = uniques(@{$all_values{$property}}); 3230 3231 # String together the values for this property, sorted. This string forms 3232 # a list definition, with each value as an entry in it, indented on a new 3233 # line. The sorting is used to find properties that take on the exact 3234 # same values to share this string. 3235 my $joined = "\t\""; 3236 $joined .= join "\",\n\t\"", 3237 sort { ($a =~ $numeric_re && $b =~ $numeric_re) 3238 ? eval $a <=> eval $b 3239 : prop_name_for_cmp($a) cmp prop_name_for_cmp($b) 3240 or $a cmp $b 3241 } @{$all_values{$property}}; 3242 # And add a trailing marker 3243 $joined .= "\",\n\tNULL\n"; 3244 3245 my $table_name = $table_name_prefix . $property . "_values"; 3246 my $index_name = "${table_name}_index"; 3247 3248 # Add a rule for the parser that is just an empty value. It will need to 3249 # know to look up empty things in the prop_value_ptrs[] table. 3250 3251 $keywords{"$property="} = $index_name; 3252 if (exists $prop_name_aliases{$property}) { 3253 foreach my $alias (@{$prop_name_aliases{$property}}) { 3254 $keywords{"$alias="} = $index_name; 3255 } 3256 } 3257 3258 # Also create rules for the synonyms of this property to point to the same 3259 # thing 3260 3261 # If this property's values are the same as one we've already computed, 3262 # use that instead of creating a duplicate. But we add a #define to point 3263 # to the proper one. 3264 if (exists $joined_values{$joined}) { 3265 push @values_indices, "#define $index_name $joined_values{$joined}\n"; 3266 next PROPERTY; 3267 } 3268 3269 # And this property, now known to have unique values from any other seen 3270 # so far is about to be pushed onto @values_tables. Its index is the 3271 # current count. 3272 push @values_indices, "#define $index_name " 3273 . scalar @values_tables . "\n"; 3274 $joined_values{$joined} = $index_name; 3275 push @values_tables, $table_name; 3276 3277 # Create the table for this set of values. 3278 output_table_header($out_fh, "char *", $table_name); 3279 print $out_fh $joined; 3280 output_table_trailer(); 3281} # End of loop through the properties, and their values 3282 3283# We have completely determined the table of the unique property values 3284output_table_header($out_fh, "char * const *", 3285 "${table_name_prefix}prop_value_ptrs"); 3286print $out_fh join ",\n", @values_tables; 3287print $out_fh "\n"; 3288output_table_trailer(); 3289 3290# And the #defines for the indices in it 3291print $out_fh "\n\n", join "", @values_indices; 3292 3293switch_pound_if('Boundary_pair_tables', 'PERL_IN_REGEXEC_C'); 3294 3295output_GCB_table(); 3296output_LB_table(); 3297output_WB_table(); 3298 3299end_file_pound_if; 3300 3301print "Computing fold data\n" if DEBUG; 3302 3303print $out_fh <<"EOF"; 3304 3305/* More than one code point may have the same code point as their fold. This 3306 * gives the maximum number in the current Unicode release. (The folded-to 3307 * code point is not included in this count.) For example, both 'S' and 3308 * \\x{17F} fold to 's', so the number for that fold is 2. Another way to 3309 * look at it is the maximum length of all the IVCF_AUX_TABLE's */ 3310#define MAX_FOLD_FROMS $max_fold_froms 3311EOF 3312 3313my $sources_list = "lib/unicore/mktables.lst"; 3314my @sources = qw(regen/mk_invlists.pl 3315 lib/unicore/mktables 3316 lib/Unicode/UCD.pm 3317 regen/charset_translations.pl 3318 regen/mk_PL_charclass.pl 3319 ); 3320{ 3321 # Depend on mktables’ own sources. It’s a shorter list of files than 3322 # those that Unicode::UCD uses. Some may not actually have an effect on 3323 # the output of this program, but easier to just include all of them, and 3324 # no real harm in doing so, as it is rare for one such to change without 3325 # the others doing so as well. 3326 if (! open my $mktables_list, '<', $sources_list) { 3327 3328 # This should force a rebuild once $sources_list exists 3329 push @sources, $sources_list; 3330 } 3331 else { 3332 while(<$mktables_list>) { 3333 last if /===/; 3334 chomp; 3335 push @sources, "lib/unicore/$_" if /^[^#]/; 3336 } 3337 } 3338} 3339 3340read_only_bottom_close_and_rename($out_fh, \@sources); 3341 3342my %name_to_index; 3343for my $i (0 .. @enums - 1) { 3344 my $loose_name = $enums[$i] =~ s/^$table_name_prefix//r; 3345 $loose_name = lc $loose_name; 3346 $loose_name =~ s/__/=/; 3347 $loose_name =~ s/_dot_/./; 3348 $loose_name =~ s/_slash_/\//g; 3349 $name_to_index{$loose_name} = $i + 1; 3350} 3351# unsanitize, exclude &, maybe add these before sanitize 3352for my $i (0 .. @perl_prop_synonyms - 1) { 3353 my $loose_name_pair = $perl_prop_synonyms[$i] =~ s/#\s*define\s*//r; 3354 $loose_name_pair =~ s/\b$table_name_prefix//g; 3355 $loose_name_pair = lc $loose_name_pair; 3356 $loose_name_pair =~ s/__/=/g; 3357 $loose_name_pair =~ s/_dot_/./g; 3358 $loose_name_pair =~ s/_slash_/\//g; 3359 my ($synonym, $primary) = split / +/, $loose_name_pair; 3360 $name_to_index{$synonym} = $name_to_index{$primary}; 3361} 3362 3363my $uni_pl = open_new('lib/unicore/uni_keywords.pl', '>', 3364 {style => '*', by => 'regen/mk_invlists.pl', 3365 from => "Unicode::UCD"}); 3366{ 3367 print $uni_pl "\%Unicode::UCD::uni_prop_ptrs_indices = (\n"; 3368 for my $name (sort keys %name_to_index) { 3369 print $uni_pl " '$name' => $name_to_index{$name},\n"; 3370 } 3371 print $uni_pl ");\n\n1;\n"; 3372} 3373 3374read_only_bottom_close_and_rename($uni_pl, \@sources); 3375 3376print "Computing minimal perfect hash for unicode properties.\n" if DEBUG; 3377 3378if (my $file= $ENV{DUMP_KEYWORDS_FILE}) { 3379 require Data::Dumper; 3380 3381 open my $ofh, ">", $file 3382 or die "Failed to open DUMP_KEYWORDS_FILE '$file' for write: $!"; 3383 print $ofh Data::Dumper->new([\%keywords],['*keywords']) 3384 ->Sortkeys(1)->Useqq(1)->Dump(); 3385 close $ofh; 3386 print "Wrote keywords to '$file'.\n"; 3387} 3388 3389my $keywords_fh = open_new('uni_keywords.h', '>', 3390 {style => '*', by => 'regen/mk_invlists.pl', 3391 from => "mph.pl"}); 3392 3393print $keywords_fh "\n#if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD)\n\n"; 3394 3395my $mph= MinimalPerfectHash->new( 3396 source_hash => \%keywords, 3397 match_name => "match_uniprop", 3398 simple_split => $ENV{SIMPLE_SPLIT} // 0, 3399 randomize_squeeze => $ENV{RANDOMIZE_SQUEEZE} // 1, 3400 max_same_in_squeeze => $ENV{MAX_SAME} // 5, 3401 srand_seed => (lc($ENV{SRAND_SEED}//"") eq "auto") 3402 ? undef 3403 : $ENV{SRAND_SEED} // 1785235451, # I let perl pick a number 3404); 3405$mph->make_mph_with_split_keys(); 3406print $keywords_fh $mph->make_algo(); 3407 3408print $keywords_fh "\n#endif /* #if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD) */\n"; 3409 3410push @sources, 'regen/mph.pl'; 3411read_only_bottom_close_and_rename($keywords_fh, \@sources); 3412