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