- Timestamp:
- 07/22/08 16:49:57 (4 months ago)
- Location:
- perl5/Pugs-Compiler-Rule
- Files:
-
- 5 modified
-
Changes (modified) (1 diff)
-
examples/Grammar.grammar (modified) (1 diff)
-
lib/Pugs/Emitter/Rule/Perl5/CharClass.pm (modified) (3 diffs)
-
lib/Pugs/Grammar/Base.pm (modified) (1 diff)
-
lib/Pugs/Grammar/Rule.pmc (modified) (998 diffs)
Legend:
- Unmodified
- Added
- Removed
-
perl5/Pugs-Compiler-Rule/Changes
r21435 r21437 1 1 - added unicode property 'isLr' 2 - fixed character-class name rule 2 3 3 4 0.32 2008-07-21 -
perl5/Pugs-Compiler-Rule/examples/Grammar.grammar
r18715 r21437 129 129 130 130 token char_class { 131 | <.alpha> +131 | <.alpha> [ <.alpha> | _ ] * 132 132 | \[ <.char_range> \] 133 133 } -
perl5/Pugs-Compiler-Rule/lib/Pugs/Emitter/Rule/Perl5/CharClass.pm
r21436 r21437 5 5 use Data::Dumper; 6 6 7 use vars qw( %char_class );7 use vars qw( %char_class %extra_unicode ); 8 8 BEGIN { 9 9 %char_class = map { $_ => 1 } qw( … … 12 12 print punct space upper 13 13 word xdigit 14 ); 15 # XXX this list is broken!!! 16 %extra_unicode = ( 17 'isLr' => '(?:\p{isLl}|\p{isLu}|\p{isLt})', 18 'isBidiL' => '(?:\p{isLatin})', 19 'isBidiR' => '(?:\p{isHebrew}|\p{isArabic})', 20 'isBidiEN' => '(?:\p{isHebrew}|\p{isArabic})', 21 'isBidiES' => '(?:\p{isHebrew}|\p{isArabic})', 22 'isBidiET' => '(?:\p{isHebrew}|\p{isArabic})', 23 'isBidiWS' => '(?:\p{isHebrew}|\p{isArabic})', 24 'isID_Start' => '(?:\p{isHebrew}|\p{isArabic})', 14 25 ); 15 26 } … … 81 92 my $name = $1; 82 93 $cmd = ( exists $char_class{$name} ) 83 ? "[[:$name:]]" 84 : "\\p{$name}"; 94 ? "[[:$name:]]" 95 : exists $extra_unicode{$name} 96 ? $extra_unicode{$name} 97 : "\\p{$name}"; 85 98 } 86 99 -
perl5/Pugs-Compiler-Rule/lib/Pugs/Grammar/Base.pm
r21435 r21437 169 169 # is it a Unicode property? "isL" 170 170 { 171 local $@; 172 my $p5 = '\p{' . $meth . '}'; 173 $p5 = '(?:\p{isLl}|\p{isLu}|\p{isLt})' if $meth eq 'isLr'; 174 eval ' my $s="a"; $s =~ /$p5/ '; 175 unless ( $@ ) { 176 *{$meth} = Pugs::Compiler::RegexPerl5->compile($p5)->code; 177 return $meth->( @_ ); 178 } 171 local $@; 172 my $p5; 173 if ( exists $Pugs::Emitter::Rule::Perl5::CharClass::extra_unicode{$meth} ) { 174 $p5 = $Pugs::Emitter::Rule::Perl5::CharClass::extra_unicode{$meth}; 175 } 176 else { 177 $p5 = '\p{' . $meth . '}'; 178 eval ' my $s="a"; $s =~ /' . $p5 . '/ '; 179 } 180 unless ( $@ ) { 181 *{$meth} = Pugs::Compiler::RegexPerl5->compile($p5)->code; 182 return $meth->( @_ ); 183 } 179 184 } 180 185 -
perl5/Pugs-Compiler-Rule/lib/Pugs/Grammar/Rule.pmc
r18715 r21437 1 1 # !!! DO NOT EDIT !!! 2 2 # This file was generated by Pugs::Compiler::Rule's compile_p6grammar.pl 3 # script from examples/Grammar.grammar at Tue Oct 30 11:29:45 20073 # script from examples/Grammar.grammar at Tue Jul 22 16:47:05 2008 4 4 5 5 use strict; … … 68 68 ## pos: 632 675 69 69 ( 70 ( $pad{I1 170} = $pos or 1 )70 ( $pad{I1686} = $pos or 1 ) 71 71 && ( 72 72 ## <concat> … … 76 76 ## <group> 77 77 ## pos: 633 639 78 ( ( $pad{I1 171} = $pos or 1 ) &&78 ( ( $pad{I1687} = $pos or 1 ) && 79 79 ## <perl5> 80 80 ( ( substr( $s, $pos ) =~ m/^((?:\n\r?|\r\n?))/ ) … … 83 83 ) 84 84 ## </perl5> 85 || ( ( $pos = $pad{I1 171} ) && 0 ) )85 || ( ( $pos = $pad{I1687} ) && 0 ) ) 86 86 ## </group> 87 87 … … 120 120 ## <group> 121 121 ## pos: 642 644 122 ( ( $pad{I1 172} = $pos or 1 ) &&122 ( ( $pad{I1688} = $pos or 1 ) && 123 123 124 124 ## <constant> … … 129 129 ) 130 130 ## </constant> 131 || ( ( $pos = $pad{I1 172} ) && 0 ) )131 || ( ( $pos = $pad{I1688} ) && 0 ) ) 132 132 ## </group> 133 133 … … 136 136 ## pos: 644 652 137 137 do { while ( 138 ( ( $pad{I1 173} = $pos or 1 ) &&138 ( ( $pad{I1689} = $pos or 1 ) && 139 139 ## <perl5> 140 140 ( ( substr( $s, $pos ) =~ m/^((?!\n\r?|\r\n?).)/ ) … … 143 143 ) 144 144 ## </perl5> 145 || ( ( $pos = $pad{I1 173} ) && 0 ) )) {}; $bool = 1 }145 || ( ( $pos = $pad{I1689} ) && 0 ) )) {}; $bool = 1 } 146 146 ## </quant> 147 147 … … 151 151 ) 152 152 || ( 153 ( ( $bool = 1 ) && ( $pos = $pad{I1 170} ) or 1 )153 ( ( $bool = 1 ) && ( $pos = $pad{I1686} ) or 1 ) 154 154 && ## <concat> 155 155 ## pos: 653 675 … … 158 158 ## <group> 159 159 ## pos: 653 658 160 ( ( $pad{I1 174} = $pos or 1 ) &&160 ( ( $pad{I1690} = $pos or 1 ) && 161 161 162 162 ## <dot> … … 164 164 ( substr( $s, $pos++, 1 ) ne '' ) 165 165 ## </dot> 166 || ( ( $pos = $pad{I1 174} ) && 0 ) )166 || ( ( $pos = $pad{I1690} ) && 0 ) ) 167 167 ## </group> 168 168 … … 171 171 ## pos: 658 662 172 172 do { while ( 173 ( ( $pad{I1 175} = $pos or 1 ) &&173 ( ( $pad{I1691} = $pos or 1 ) && 174 174 ## <perl5> 175 175 ( ( substr( $s, $pos ) =~ m/^((?!\n\r?|\r\n?).)/ ) … … 178 178 ) 179 179 ## </perl5> 180 || ( ( $pos = $pad{I1 175} ) && 0 ) )) {}; $bool = 1 }180 || ( ( $pos = $pad{I1691} ) && 0 ) )) {}; $bool = 1 } 181 181 ## </quant> 182 182 … … 185 185 ## <group> 186 186 ## pos: 662 675 187 ( ( $pad{I1 176} = $pos or 1 ) &&187 ( ( $pad{I1692} = $pos or 1 ) && 188 188 ## <metasyntax> 189 189 ## pos: 662 674 … … 198 198 } 199 199 ## </metasyntax> 200 || ( ( $pos = $pad{I1 176} ) && 0 ) )200 || ( ( $pos = $pad{I1692} ) && 0 ) ) 201 201 ## </group> 202 202 … … 265 265 ## pos: 700 743 266 266 ( 267 ( $pad{I1 177} = $pos or 1 )267 ( $pad{I1693} = $pos or 1 ) 268 268 && ( 269 269 ## <concat> … … 273 273 ## <group> 274 274 ## pos: 701 707 275 ( ( $pad{I1 178} = $pos or 1 ) &&275 ( ( $pad{I1694} = $pos or 1 ) && 276 276 ## <perl5> 277 277 ( ( substr( $s, $pos ) =~ m/^((?:\n\r?|\r\n?))/ ) … … 280 280 ) 281 281 ## </perl5> 282 || ( ( $pos = $pad{I1 178} ) && 0 ) )282 || ( ( $pos = $pad{I1694} ) && 0 ) ) 283 283 ## </group> 284 284 … … 317 317 ## <group> 318 318 ## pos: 710 712 319 ( ( $pad{I1 179} = $pos or 1 ) &&319 ( ( $pad{I1695} = $pos or 1 ) && 320 320 321 321 ## <constant> … … 326 326 ) 327 327 ## </constant> 328 || ( ( $pos = $pad{I1 179} ) && 0 ) )328 || ( ( $pos = $pad{I1695} ) && 0 ) ) 329 329 ## </group> 330 330 … … 333 333 ## pos: 712 720 334 334 do { while ( 335 ( ( $pad{I1 180} = $pos or 1 ) &&335 ( ( $pad{I1696} = $pos or 1 ) && 336 336 ## <perl5> 337 337 ( ( substr( $s, $pos ) =~ m/^((?!\n\r?|\r\n?).)/ ) … … 340 340 ) 341 341 ## </perl5> 342 || ( ( $pos = $pad{I1 180} ) && 0 ) )) {}; $bool = 1 }342 || ( ( $pos = $pad{I1696} ) && 0 ) )) {}; $bool = 1 } 343 343 ## </quant> 344 344 … … 348 348 ) 349 349 || ( 350 ( ( $bool = 1 ) && ( $pos = $pad{I1 177} ) or 1 )350 ( ( $bool = 1 ) && ( $pos = $pad{I1693} ) or 1 ) 351 351 && ## <concat> 352 352 ## pos: 721 743 … … 355 355 ## <group> 356 356 ## pos: 721 726 357 ( ( $pad{I1 181} = $pos or 1 ) &&357 ( ( $pad{I1697} = $pos or 1 ) && 358 358 359 359 ## <dot> … … 361 361 ( substr( $s, $pos++, 1 ) ne '' ) 362 362 ## </dot> 363 || ( ( $pos = $pad{I1 181} ) && 0 ) )363 || ( ( $pos = $pad{I1697} ) && 0 ) ) 364 364 ## </group> 365 365 … … 368 368 ## pos: 726 730 369 369 do { while ( 370 ( ( $pad{I1 182} = $pos or 1 ) &&370 ( ( $pad{I1698} = $pos or 1 ) && 371 371 ## <perl5> 372 372 ( ( substr( $s, $pos ) =~ m/^((?!\n\r?|\r\n?).)/ ) … … 375 375 ) 376 376 ## </perl5> 377 || ( ( $pos = $pad{I1 182} ) && 0 ) )) {}; $bool = 1 }377 || ( ( $pos = $pad{I1698} ) && 0 ) )) {}; $bool = 1 } 378 378 ## </quant> 379 379 … … 382 382 ## <group> 383 383 ## pos: 730 743 384 ( ( $pad{I1 183} = $pos or 1 ) &&384 ( ( $pad{I1699} = $pos or 1 ) && 385 385 ## <metasyntax> 386 386 ## pos: 730 742 … … 395 395 } 396 396 ## </metasyntax> 397 || ( ( $pos = $pad{I1 183} ) && 0 ) )397 || ( ( $pos = $pad{I1699} ) && 0 ) ) 398 398 ## </group> 399 399 … … 462 462 ## pos: 761 1059 463 463 ( 464 ( ( $pad{I1 184} = $pos or 1 ) &&464 ( ( $pad{I1700} = $pos or 1 ) && 465 465 ## <alt> 466 466 ## pos: 762 1056 467 467 ( 468 ( $pad{I1 185} = $pos or 1 )468 ( $pad{I1701} = $pos or 1 ) 469 469 && ( 470 470 ## <concat> … … 474 474 ## <group> 475 475 ## pos: 768 775 476 ( ( $pad{I1 186} = $pos or 1 ) &&476 ( ( $pad{I1702} = $pos or 1 ) && 477 477 478 478 ## <constant> … … 483 483 ) 484 484 ## </constant> 485 || ( ( $pos = $pad{I1 186} ) && 0 ) )485 || ( ( $pos = $pad{I1702} ) && 0 ) ) 486 486 ## </group> 487 487 … … 490 490 ## pos: 775 783 491 491 do { while ( 492 ( ( $pad{I1 187} = $pos or 1 ) &&492 ( ( $pad{I1703} = $pos or 1 ) && 493 493 ## <perl5> 494 494 ( ( substr( $s, $pos ) =~ m/^((?!\n\r?|\r\n?).)/ ) … … 497 497 ) 498 498 ## </perl5> 499 || ( ( $pos = $pad{I1 187} ) && 0 ) )) {}; $bool = 1 }499 || ( ( $pos = $pad{I1703} ) && 0 ) )) {}; $bool = 1 } 500 500 ## </quant> 501 501 … … 505 505 ) 506 506 || ( 507 ( ( $bool = 1 ) && ( $pos = $pad{I1 185} ) or 1 )507 ( ( $bool = 1 ) && ( $pos = $pad{I1701} ) or 1 ) 508 508 && ## <concat> 509 509 ## pos: 784 1044 … … 512 512 ## <group> 513 513 ## pos: 784 791 514 ( ( $pad{I1 188} = $pos or 1 ) &&514 ( ( $pad{I1704} = $pos or 1 ) && 515 515 ## <perl5> 516 516 ( ( substr( $s, $pos ) =~ m/^((?:\n\r?|\r\n?))/ ) … … 519 519 ) 520 520 ## </perl5> 521 || ( ( $pos = $pad{I1 188} ) && 0 ) )521 || ( ( $pos = $pad{I1704} ) && 0 ) ) 522 522 ## </group> 523 523 … … 526 526 ## pos: 791 1044 527 527 ( 528 ( ( $pad{I1 189} = $pos or 1 ) &&528 ( ( $pad{I1705} = $pos or 1 ) && 529 529 ## <concat> 530 530 ## pos: 792 1037 … … 533 533 ## <group> 534 534 ## pos: 792 795 535 ( ( $pad{I1 190} = $pos or 1 ) &&535 ( ( $pad{I1706} = $pos or 1 ) && 536 536 537 537 ## <constant> … … 542 542 ) 543 543 ## </constant> 544 || ( ( $pos = $pad{I1 190} ) && 0 ) )544 || ( ( $pos = $pad{I1706} ) && 0 ) ) 545 545 ## </group> 546 546 … … 549 549 ## pos: 795 1037 550 550 ( 551 ( ( $pad{I1 191} = $pos or 1 ) &&551 ( ( $pad{I1707} = $pos or 1 ) && 552 552 ## <alt> 553 553 ## pos: 796 1022 554 554 ( 555 ( $pad{I1 192} = $pos or 1 )555 ( $pad{I1708} = $pos or 1 ) 556 556 && ( 557 557 ## <concat> … … 561 561 ## <group> 562 562 ## pos: 810 813 563 ( ( $pad{I1 193} = $pos or 1 ) &&563 ( ( $pad{I1709} = $pos or 1 ) && 564 564 565 565 ## <constant> … … 570 570 ) 571 571 ## </constant> 572 || ( ( $pos = $pad{I1 193} ) && 0 ) )572 || ( ( $pos = $pad{I1709} ) && 0 ) ) 573 573 ## </group> 574 574 … … 607 607 ## <group> 608 608 ## pos: 816 818 609 ( ( $pad{I1 194} = $pos or 1 ) &&609 ( ( $pad{I1710} = $pos or 1 ) && 610 610 611 611 ## <constant> … … 616 616 ) 617 617 ## </constant> 618 || ( ( $pos = $pad{I1 194} ) && 0 ) )618 || ( ( $pos = $pad{I1710} ) && 0 ) ) 619 619 ## </group> 620 620 … … 623 623 ## <group> 624 624 ## pos: 818 824 625 ( ( $pad{I1 195} = $pos or 1 ) &&625 ( ( $pad{I1711} = $pos or 1 ) && 626 626 ## <metasyntax> 627 627 ## pos: 818 823 … … 636 636 } 637 637 ## </metasyntax> 638 || ( ( $pos = $pad{I1 195} ) && 0 ) )638 || ( ( $pos = $pad{I1711} ) && 0 ) ) 639 639 ## </group> 640 640 … … 663 663 ## <group> 664 664 ## pos: 826 828 665 ( ( $pad{I1 196} = $pos or 1 ) &&665 ( ( $pad{I1712} = $pos or 1 ) && 666 666 667 667 ## <constant> … … 672 672 ) 673 673 ## </constant> 674 || ( ( $pos = $pad{I1 196} ) && 0 ) )674 || ( ( $pos = $pad{I1712} ) && 0 ) ) 675 675 ## </group> 676 676 … … 679 679 ## pos: 828 832 680 680 do { while ( 681 ( ( $pad{I1 197} = $pos or 1 ) &&681 ( ( $pad{I1713} = $pos or 1 ) && 682 682 ## <perl5> 683 683 ( ( substr( $s, $pos ) =~ m/^((?!\n\r?|\r\n?).)/ ) … … 686 686 ) 687 687 ## </perl5> 688 || ( ( $pos = $pad{I1 197} ) && 0 ) )) {}; $bool = 1 }688 || ( ( $pos = $pad{I1713} ) && 0 ) )) {}; $bool = 1 } 689 689 ## </quant> 690 690 … … 693 693 ## pos: 832 847 694 694 do { while ( 695 ( ( $pad{I1 198} = $pos or 1 ) &&695 ( ( $pad{I1714} = $pos or 1 ) && 696 696 697 697 ## <dot> … … 699 699 ( substr( $s, $pos++, 1 ) ne '' ) 700 700 ## </dot> 701 || ( ( $pos = $pad{I1 198} ) && 0 ) )) {}; $bool = 1 }701 || ( ( $pos = $pad{I1714} ) && 0 ) )) {}; $bool = 1 } 702 702 ## </quant> 703 703 … … 707 707 ) 708 708 || ( 709 ( ( $bool = 1 ) && ( $pos = $pad{I1 192} ) or 1 )709 ( ( $bool = 1 ) && ( $p