1# 2 3=head1 NAME 4 5Regex - Regex library 6 7=head1 DESCRIPTION 8 9This file brings together the various Regex modules needed for Regex.pbc . 10 11=cut 12 13### .include 'src/Regex/Cursor.pir' 14# Copyright (C) 2009, The Perl Foundation. 15# 16 17=head1 NAME 18 19Regex::Cursor - Regex Cursor nodes 20 21=head1 DESCRIPTION 22 23This file implements the Regex::Cursor class, used for managing regular 24expression control flow. Regex::Cursor is also a base class for 25grammars. 26 27=cut 28 29.include 'cclass.pasm' 30### .include 'src/Regex/constants.pir' 31.const int CURSOR_FAIL = -1 32.const int CURSOR_FAIL_GROUP = -2 33.const int CURSOR_FAIL_RULE = -3 34.const int CURSOR_FAIL_MATCH = -4 35 36.const int CURSOR_TYPE_SCAN = 1 37.const int CURSOR_TYPE_PEEK = 2 38 39.namespace ['Regex';'Cursor'] 40 41.sub '' :anon :load :init 42 load_bytecode 'P6object.pbc' 43 .local pmc p6meta 44 p6meta = new 'P6metaclass' 45 $P0 = p6meta.'new_class'('Regex::Cursor', 'attr'=>'$!target $!from $!pos $!match $!names $!debug @!bstack @!cstack @!caparray &!regex') 46 $P0 = box 0 47 set_global '$!generation', $P0 48 $P0 = new ['Boolean'] 49 assign $P0, 0 50 set_global '$!FALSE', $P0 51 $P0 = new ['Boolean'] 52 assign $P0, 1 53 set_global '$!TRUE', $P0 54 .return () 55.end 56 57=head2 Methods 58 59=over 4 60 61=item new_match() 62 63A method that creates an empty Match object, by default of type 64C<Regex::Match>. This method can be overridden for generating HLL-specific 65Match objects. 66 67=cut 68 69.sub 'new_match' :method 70 .local pmc match 71 match = new ['Regex';'Match'] 72 .return (match) 73.end 74 75=item new_array() 76 77A method that creates an empty array object, by default of type 78C<ResizablePMCArray>. This method can be overridden for generating HLL-specific 79arrays for usage within Match objects. 80 81=cut 82 83.sub 'new_array' :method 84 .local pmc arr 85 arr = new ['ResizablePMCArray'] 86 .return (arr) 87.end 88 89=item MATCH() 90 91Return this cursor's current Match object, generating a new one 92for the Cursor if one hasn't been created yet. 93 94=cut 95 96.sub 'MATCH' :method 97 .local pmc match 98 match = getattribute self, '$!match' 99 if null match goto match_make 100 $P0 = get_global '$!TRUE' 101 $I0 = issame match, $P0 102 unless $I0 goto match_done 103 104 # First, create a Match object and bind it 105 match_make: 106 match = self.'new_match'() 107 setattribute self, '$!match', match 108 setattribute match, '$!cursor', self 109 .local pmc target, from, to 110 target = getattribute self, '$!target' 111 setattribute match, '$!target', target 112 from = getattribute self, '$!from' 113 setattribute match, '$!from', from 114 to = getattribute self, '$!pos' 115 setattribute match, '$!to', to 116 117 # Create any arrayed subcaptures. 118 .local pmc caparray, caparray_it, caphash 119 caparray = getattribute self, '@!caparray' 120 if null caparray goto caparray_done 121 caparray_it = iter caparray 122 caphash = new ['Hash'] 123 caparray_loop: 124 unless caparray_it goto caparray_done 125 .local string subname 126 .local pmc arr 127 .local int keyint 128 subname = shift caparray_it 129 arr = self.'new_array'() 130 caphash[subname] = arr 131 keyint = is_cclass .CCLASS_NUMERIC, subname, 0 132 if keyint goto caparray_int 133 match[subname] = arr 134 goto caparray_loop 135 caparray_int: 136 $I0 = subname 137 match[$I0] = arr 138 goto caparray_loop 139 caparray_done: 140 141 # If it's not a successful match, or if there are 142 # no saved subcursors, we're done. 143 if to < from goto match_done 144 .local pmc cstack, cstack_it 145 cstack = getattribute self, '@!cstack' 146 if null cstack goto cstack_done 147 unless cstack goto cstack_done 148 cstack_it = iter cstack 149 cstack_loop: 150 unless cstack_it goto cstack_done 151 .local pmc subcur, submatch, names 152 subcur = shift cstack_it 153 $I0 = isa subcur, ['Regex';'Cursor'] 154 unless $I0 goto cstack_loop 155 # If the subcursor isn't bound with a name, skip it 156 names = getattribute subcur, '$!names' 157 if null names goto cstack_loop 158 submatch = subcur.'MATCH'() 159 # See if we have multiple binds 160 .local pmc names_it 161 subname = names 162 names_it = get_global '$!FALSE' 163 $I0 = index subname, '=' 164 if $I0 < 0 goto cstack_subname 165 names_it = split '=', subname 166 cstack_subname_loop: 167 subname = shift names_it 168 cstack_subname: 169 keyint = is_cclass .CCLASS_NUMERIC, subname, 0 170 if null caparray goto cstack_bind 171 $I0 = exists caphash[subname] 172 unless $I0 goto cstack_bind 173 if keyint goto cstack_array_int 174 $P0 = match[subname] 175 push $P0, submatch 176 goto cstack_bind_done 177 cstack_array_int: 178 $I0 = subname 179 $P0 = match[$I0] 180 push $P0, submatch 181 goto cstack_bind_done 182 cstack_bind: 183 if keyint goto cstack_bind_int 184 match[subname] = submatch 185 goto cstack_bind_done 186 cstack_bind_int: 187 $I0 = subname 188 match[$I0] = submatch 189 cstack_bind_done: 190 if names_it goto cstack_subname_loop 191 goto cstack_loop 192 cstack_done: 193 194 match_done: 195 .return (match) 196.end 197 198 199=item parse(target [, 'rule'=>regex]) 200 201Parse C<target> in the current grammar starting with C<regex>. 202If C<regex> is omitted, then use the C<TOP> rule for the grammar. 203 204=cut 205 206.sub 'parse' :method 207 .param pmc target 208 .param pmc regex :named('rule') :optional 209 .param int has_regex :opt_flag 210 .param pmc actions :named('actions') :optional 211 .param int rxtrace :named('rxtrace') :optional 212 .param pmc options :slurpy :named 213 214 if has_regex goto have_regex 215 regex = box 'TOP' 216 have_regex: 217 $I0 = isa regex, ['String'] 218 unless $I0 goto regex_done 219 $S0 = regex 220 regex = find_method self, $S0 221 regex_done: 222 223 .lex '$*ACTIONS', actions 224 225 .local pmc cur, match 226 cur = self.'!cursor_init'(target, options :flat :named) 227 unless rxtrace goto rxtrace_done 228 cur.'DEBUG'() 229 rxtrace_done: 230 cur = cur.regex() 231 match = cur.'MATCH'() 232 .return (match) 233.end 234 235 236=item next() 237 238Return the next match from a successful Cursor. 239 240=cut 241 242.sub 'next' :method 243 .local pmc cur, match 244 cur = self.'!cursor_next'() 245 match = cur.'MATCH'() 246 .return (match) 247.end 248 249 250=item pos() 251 252Return the cursor's current position. 253 254=cut 255 256.sub 'pos' :method 257 $P0 = getattribute self, '$!pos' 258 .return ($P0) 259.end 260 261 262=item from() 263 264Return the cursor's from position. 265 266=cut 267 268.sub 'from' :method 269 $P0 = getattribute self, '$!from' 270 .return ($P0) 271.end 272 273=back 274 275=head2 Private methods 276 277=over 4 278 279=item !cursor_init(target) 280 281Create a new cursor for matching C<target>. 282 283=cut 284 285.sub '!cursor_init' :method 286 .param string target 287 .param int pos :named('p') :optional 288 .param int has_pos :opt_flag 289 .param int cont :named('c') :optional 290 .param int has_cont :opt_flag 291 292 .local pmc parrotclass, cur 293 $P0 = self.'HOW'() 294 parrotclass = getattribute $P0, 'parrotclass' 295 cur = new parrotclass 296 297 $P0 = box target 298 setattribute cur, '$!target', $P0 299 300 if has_cont goto cursor_cont 301 $P0 = box pos 302 setattribute cur, '$!from', $P0 303 $P0 = box pos 304 setattribute cur, '$!pos', $P0 305 goto cursor_done 306 cursor_cont: 307 $P0 = box CURSOR_FAIL 308 setattribute cur, '$!from', $P0 309 $P0 = box cont 310 setattribute cur, '$!pos', $P0 311 cursor_done: 312 313 .return (cur) 314.end 315 316=item !cursor_start([lang]) 317 318Create and initialize a new cursor from C<self>. If C<lang> is 319provided, then the new cursor has the same type as lang. 320 321=cut 322 323.sub '!cursor_start' :method 324 .param pmc lang :optional 325 .param int has_lang :opt_flag 326 327 if has_lang goto have_lang 328 lang = self 329 have_lang: 330 331 .local pmc parrotclass, cur 332 $P0 = lang.'HOW'() 333 parrotclass = getattribute $P0, 'parrotclass' 334 cur = new parrotclass 335 336 .local pmc regex 337 regex = getattribute self, '&!regex' 338 unless null regex goto cursor_restart 339 340 .local pmc from, target, debug 341 342 from = getattribute self, '$!pos' 343 setattribute cur, '$!from', from 344 setattribute cur, '$!pos', from 345 346 target = getattribute self, '$!target' 347 setattribute cur, '$!target', target 348 debug = getattribute self, '$!debug' 349 setattribute cur, '$!debug', debug 350 351 .return (cur, from, target, 0) 352 353 cursor_restart: 354 .local pmc pos, cstack, bstack 355 from = getattribute self, '$!from' 356 target = getattribute self, '$!target' 357 debug = getattribute self, '$!debug' 358 cstack = getattribute self, '@!cstack' 359 bstack = getattribute self, '@!bstack' 360 pos = box CURSOR_FAIL 361 362 setattribute cur, '$!from', from 363 setattribute cur, '$!pos', pos 364 setattribute cur, '$!target', target 365 setattribute cur, '$!debug', debug 366 if null cstack goto cstack_done 367 cstack = clone cstack 368 setattribute cur, '@!cstack', cstack 369 cstack_done: 370 if null bstack goto bstack_done 371 bstack = clone bstack 372 setattribute cur, '@!bstack', bstack 373 bstack_done: 374 .return (cur, from, target, 1) 375.end 376 377 378=item !cursor_fail(pos) 379 380Permanently fail this cursor. 381 382=cut 383 384.sub '!cursor_fail' :method 385 .local pmc pos 386 pos = box CURSOR_FAIL_RULE 387 setattribute self, '$!pos', pos 388 null $P0 389 setattribute self, '$!match', $P0 390 setattribute self, '@!bstack', $P0 391 setattribute self, '@!cstack', $P0 392.end 393 394 395=item !cursor_pass(pos, name) 396 397Set the Cursor as passing at C<pos>; calling any reduction action 398C<name> associated with the cursor. This method simply sets 399C<$!match> to a boolean true value to indicate the regex was 400successful; the C<MATCH> method above replaces this boolean true 401with a "real" Match object when requested. 402 403=cut 404 405.sub '!cursor_pass' :method 406 .param pmc pos 407 .param string name 408 409 setattribute self, '$!pos', pos 410 .local pmc match 411 match = get_global '$!TRUE' 412 setattribute self, '$!match', match 413 unless name goto done 414 self.'!reduce'(name) 415 done: 416 .return (self) 417.end 418 419 420=item !cursor_backtrack() 421 422Configure this cursor for backtracking via C<!cursor_next>. 423 424=cut 425 426.sub '!cursor_backtrack' :method 427 $P0 = getinterp 428 $P1 = $P0['sub';1] 429 setattribute self, '&!regex', $P1 430.end 431 432 433=item !cursor_next() 434 435Continue a regex match from where the current cursor left off. 436 437=cut 438 439.sub '!cursor_next' :method 440 .local pmc regex, cur 441 regex = getattribute self, '&!regex' 442 if null regex goto fail 443 cur = self.regex() 444 .return (cur) 445 fail: 446 cur = self.'!cursor_start'() 447 cur.'!cursor_fail'() 448 .return (cur) 449.end 450 451 452=item !cursor_caparray(caparray :slurpy) 453 454Set the list of subcaptures that produce arrays to C<caparray>. 455 456=cut 457 458.sub '!cursor_caparray' :method 459 .param pmc caparray :slurpy 460 setattribute self, '@!caparray', caparray 461.end 462 463 464=item !cursor_names(names) 465 466Set the Cursor's name (for binding) to C<names>. 467 468=cut 469 470.sub '!cursor_names' :method 471 .param pmc names 472 setattribute self, '$!names', names 473.end 474 475 476=item !cursor_pos(pos) 477 478Set the cursor's position to C<pos>. 479 480=cut 481 482.sub '!cursor_pos' :method 483 .param pmc pos 484 setattribute self, '$!pos', pos 485.end 486 487 488=item !cursor_debug(args :slurpy) 489 490Log a debug message. 491 492=cut 493 494.sub '!cursor_debug' :method 495 .param string tag 496 .param pmc args :slurpy 497 $P0 = getattribute self, '$!debug' 498 if null $P0 goto done 499 unless $P0 goto done 500 .local pmc fmt, from, pos, orig, line 501 fmt = new ['ResizablePMCArray'] 502 from = getattribute self, '$!from' 503 orig = getattribute self, '$!target' 504 $P0 = get_hll_global ['HLL'], 'Compiler' 505 line = $P0.'lineof'(orig, from, 'cache'=>1) 506 507 $P0 = getinterp 508 $P1 = $P0.'stderr_handle'() 509 510 $N0 = time 511 push fmt, $N0 512 push fmt, from 513 push fmt, line 514 push fmt, tag 515 $S0 = sprintf "%.6f %d/%d %-8s ", fmt 516 print $P1, $S0 517 $S0 = join '', args 518 print $P1, $S0 519 print $P1, "\n" 520 done: 521 .return (self) 522.end 523 524 525=item !mark_push(rep, pos, mark) 526 527Push a new backtracking point onto the cursor with the given 528C<rep>, C<pos>, and backtracking C<mark>. (The C<mark> is typically 529the address of a label to branch to when backtracking occurs.) 530 531=cut 532 533.sub '!mark_push' :method 534 .param int rep 535 .param int pos 536 .param int mark 537 .param pmc subcur :optional 538 .param int has_subcur :opt_flag 539 540 # cptr contains the desired number of elements in the cstack 541 .local int cptr 542 cptr = 0 543 544 # Initialize bstack if needed, and set cptr to be the cstack 545 # size requested by the top frame. 546 .local pmc bstack 547 bstack = getattribute self, '@!bstack' 548 if null bstack goto bstack_new 549 unless bstack goto bstack_done 550 $I0 = elements bstack 551 dec $I0 552 cptr = bstack[$I0] 553 goto bstack_done 554 bstack_new: 555 bstack = new ['ResizableIntegerArray'] 556 setattribute self, '@!bstack', bstack 557 bstack_done: 558 559 # If a new subcursor is being pushed, then save it in cstack 560 # and change cptr to include the new subcursor. Also clear 561 # any existing match object, as we may have just changed the 562 # match state. 563 unless has_subcur goto subcur_done 564 null $P0 565 setattribute self, '$!match', $P0 566 .local pmc cstack 567 cstack = getattribute self, '@!cstack' 568 unless null cstack goto have_cstack 569 cstack = new ['ResizablePMCArray'] 570 setattribute self, '@!cstack', cstack 571 have_cstack: 572 cstack[cptr] = subcur 573 inc cptr 574 subcur_done: 575 576 # Save our mark frame information. 577 push bstack, mark 578 push bstack, pos 579 push bstack, rep 580 push bstack, cptr 581.end 582 583 584=item !mark_peek(mark) 585 586Return information about the latest frame for C<mark>. 587If C<mark> is zero, return information about the latest frame. 588 589=cut 590 591.sub '!mark_peek' :method 592 .param int tomark 593 594 .local pmc bstack 595 bstack = getattribute self, '@!bstack' 596 if null bstack goto no_mark 597 unless bstack goto no_mark 598 599 .local int bptr 600 bptr = elements bstack 601 602 bptr_loop: 603 bptr = bptr - 4 604 if bptr < 0 goto no_mark 605 .local int rep, pos, mark, cptr 606 mark = bstack[bptr] 607 unless tomark goto bptr_done 608 unless mark == tomark goto bptr_loop 609 bptr_done: 610 $I0 = bptr + 1 611 pos = bstack[$I0] 612 inc $I0 613 rep = bstack[$I0] 614 inc $I0 615 cptr = bstack[$I0] 616 .return (rep, pos, mark, bptr, bstack, cptr) 617 618 no_mark: 619 .return (0, CURSOR_FAIL_GROUP, 0, 0, bstack, 0) 620.end 621 622 623=item !mark_fail(tomark) 624 625Remove the most recent C<mark> and backtrack the cursor to the 626point given by that mark. If C<mark> is zero, then 627backtracks the most recent mark. Returns the backtracked 628values of repetition count, cursor position, and mark (address). 629 630=cut 631 632.sub '!mark_fail' :method 633 .param int mark 634 635 # Get the frame information for C<mark>. 636 .local int rep, pos, mark, bptr, cptr 637 .local pmc bstack 638 (rep, pos, mark, bptr, bstack, cptr) = self.'!mark_peek'(mark) 639 640 # clear any existing Match object 641 null $P0 642 setattribute self, '$!match', $P0 643 644 .local pmc subcur 645 null subcur 646 647 # If there's no bstack, there's nothing else to do. 648 if null bstack goto done 649 650 # If there's a subcursor associated with this mark, return it. 651 unless cptr > 0 goto cstack_done 652 .local pmc cstack 653 cstack = getattribute self, '@!cstack' 654 dec cptr 655 subcur = cstack[cptr] 656 # Set the cstack to the size requested by the soon-to-be-top mark frame. 657 unless bptr > 0 goto cstack_zero 658 $I0 = bptr - 1 659 $I0 = bstack[$I0] 660 assign cstack, $I0 661 goto cstack_done 662 cstack_zero: 663 assign cstack, 0 664 cstack_done: 665 666 # Pop the current mark frame and all above it. 667 assign bstack, bptr 668 669 done: 670 .return (rep, pos, mark, subcur) 671.end 672 673 674=item !mark_commit(mark) 675 676Like C<!mark_fail> above this backtracks the cursor to C<mark> 677(releasing any intermediate marks), but preserves the current 678capture states. 679 680=cut 681 682.sub '!mark_commit' :method 683 .param int mark 684 685 # find mark 686 .local int rep, pos, mark, bptr, cptr 687 .local pmc bstack 688 (rep, pos, mark, bptr, bstack) = self.'!mark_peek'(mark) 689 690 # get current cstack size into cptr 691 if null bstack goto done 692 unless bstack goto done 693 $I0 = elements bstack 694 dec $I0 695 cptr = bstack[$I0] 696 697 # Pop the mark frame and everything above it. 698 assign bstack, bptr 699 700 # If we don't need to hold any cstack information, we're done. 701 unless cptr > 0 goto done 702 703 # If the top frame is an auto-fail frame, (re)use it to hold 704 # our needed cptr, otherwise create a new auto-fail frame to do it. 705 unless bptr > 0 goto cstack_push 706 $I0 = bptr - 3 # pos is at top-3 707 $I1 = bstack[$I0] 708 unless $I1 < 0 goto cstack_push 709 $I0 = bptr - 1 # cptr is at top-1 710 bstack[$I0] = cptr 711 goto done 712 cstack_push: 713 push bstack, 0 # mark 714 push bstack, CURSOR_FAIL # pos 715 push bstack, 0 # rep 716 push bstack, cptr # cptr 717 718 done: 719 .return (rep, pos, mark) 720.end 721 722 723=item !reduce(name [, key] [, match]) 724 725Perform any action associated with the current regex match. 726 727=cut 728 729.sub '!reduce' :method 730 .param string name 731 .param string key :optional 732 .param int has_key :opt_flag 733 .param pmc match :optional 734 .param int has_match :opt_flag 735 .local pmc actions 736 actions = find_dynamic_lex '$*ACTIONS' 737 if null actions goto actions_done 738 $I0 = can actions, name 739 unless $I0 goto actions_done 740 if has_match goto match_done 741 match = self.'MATCH'() 742 match_done: 743 if has_key goto actions_key 744 actions.name(match) 745 goto actions_done 746 actions_key: 747 .tailcall actions.name(match, key) 748 actions_done: 749 .return () 750.end 751 752 753=item !BACKREF(name) 754 755Match the backreference given by C<name>. 756 757=cut 758 759.sub '!BACKREF' :method 760 .param string name 761 .local pmc cur 762 .local int pos, eos 763 .local string tgt 764 (cur, pos, tgt) = self.'!cursor_start'() 765 766 # search the cursor cstack for the latest occurrence of C<name> 767 .local pmc cstack 768 cstack = getattribute self, '@!cstack' 769 if null cstack goto pass 770 .local int cstack_it 771 cstack_it = elements cstack 772 cstack_loop: 773 dec cstack_it 774 unless cstack_it >= 0 goto pass 775 .local pmc subcur 776 subcur = cstack[cstack_it] 777 $P0 = getattribute subcur, '$!names' 778 if null $P0 goto cstack_loop 779 $S0 = $P0 780 if name != $S0 goto cstack_loop 781 # we found a matching subcursor, get the literal it matched 782 cstack_done: 783 .local int litlen 784 .local string litstr 785 $I1 = subcur.'pos'() 786 $I0 = subcur.'from'() 787 litlen = $I1 - $I0 788 litstr = substr tgt, $I0, litlen 789 # now test the literal against our target 790 $S0 = substr tgt, pos, litlen 791 unless $S0 == litstr goto fail 792 pos += litlen 793 pass: 794 cur.'!cursor_pass'(pos, '') 795 fail: 796 .return (cur) 797.end 798 799 800=item !INTERPOLATE(var [, convert]) 801 802Perform regex interpolation on C<var>. If C<var> is a 803regex (sub), it is used directly, otherwise it is used 804for a string literal match. If C<var> is an array, 805then all of the elements of C<var> are considered, 806and the longest match is returned. 807 808=cut 809 810.sub '!INTERPOLATE' :method 811 .param pmc var 812 813 .local pmc cur 814 .local int pos, eos 815 .local string tgt 816 817 $I0 = does var, 'array' 818 if $I0 goto var_array 819 820 var_scalar: 821 $I0 = does var, 'invokable' 822 if $I0 goto var_sub 823 824 var_string: 825 (cur, pos, tgt) = self.'!cursor_start'() 826 eos = length tgt 827 $S0 = var 828 $I0 = length $S0 829 $I1 = pos + $I0 830 if $I1 > eos goto string_fail 831 $S1 = substr tgt, pos, $I0 832 if $S0 != $S1 goto string_fail 833 pos += $I0 834 string_pass: 835 cur.'!cursor_pass'(pos, '') 836 string_fail: 837 .return (cur) 838 839 var_sub: 840 cur = var(self) 841 .return (cur) 842 843 var_array: 844 (cur, pos, tgt) = self.'!cursor_start'() 845 eos = length tgt 846 .local pmc var_it, elem 847 .local int maxlen 848 var_it = iter var 849 maxlen = -1 850 array_loop: 851 unless var_it goto array_done 852 elem = shift var_it 853 $I0 = does elem, 'invokable' 854 if $I0 goto array_sub 855 array_string: 856 $S0 = elem 857 $I0 = length $S0 858 if $I0 <= maxlen goto array_loop 859 $I1 = pos + $I0 860 if $I1 > eos goto array_loop 861 $S1 = substr tgt, pos, $I0 862 if $S0 != $S1 goto array_loop 863 maxlen = $I0 864 goto array_loop 865 array_sub: 866 $P0 = elem(self) 867 unless $P0 goto array_loop 868 $I0 = $P0.'pos'() 869 $I0 -= pos 870 if $I0 <= maxlen goto array_loop 871 maxlen = $I0 872 goto array_loop 873 array_done: 874 if maxlen < 0 goto array_fail 875 $I0 = pos + maxlen 876 cur.'!cursor_pass'($I0, '') 877 array_fail: 878 .return (cur) 879.end 880 881 882=item !INTERPOLATE_REGEX(var) 883 884Same as C<!INTERPOLATE> above, except that any non-regex values 885are first compiled to regexes prior to being matched. 886 887=cut 888 889.sub '!INTERPOLATE_REGEX' :method 890 .param pmc var 891 892 $I0 = does var, 'invokable' 893 if $I0 goto done 894 895 .local pmc p6regex 896 p6regex = compreg 'Regex::P6Regex' 897 898 $I0 = does var, 'array' 899 if $I0 goto var_array 900 var = p6regex.'compile'(var) 901 goto done 902 903 var_array: 904 .local pmc var_it, elem 905 var_it = iter var 906 var = new ['ResizablePMCArray'] 907 var_loop: 908 unless var_it goto done 909 elem = shift var_it 910 $I0 = does elem, 'invokable' 911 if $I0 goto var_next 912 elem = p6regex.'compile'(elem) 913 var_next: 914 push var, elem 915 goto var_loop 916 917 done: 918 .tailcall self.'!INTERPOLATE'(var) 919.end 920 921 922=back 923 924=head2 Vtable functions 925 926=over 4 927 928=item get_bool 929 930=cut 931 932.sub '' :vtable('get_bool') :method 933 .local pmc match 934 match = getattribute self, '$!match' 935 if null match goto false 936 $I0 = istrue match 937 .return ($I0) 938 false: 939 .return (0) 940.end 941 942=back 943 944=head1 AUTHORS 945 946Patrick Michaud <pmichaud@pobox.com> is the author and maintainer. 947 948=cut 949 950# Local Variables: 951# mode: pir 952# fill-column: 100 953# End: 954# vim: expandtab shiftwidth=4 ft=pir: 955### .include 'src/Regex/Cursor-builtins.pir' 956# Copyright (C) 2009, The Perl Foundation. 957# 958 959=head1 NAME 960 961Regex::Cursor-builtins - builtin regexes for Cursor objects 962 963=cut 964 965.include 'cclass.pasm' 966 967.namespace ['Regex';'Cursor'] 968 969.sub 'before' :method 970 .param pmc regex :optional 971 .local pmc cur 972 .local int pos 973 (cur, pos) = self.'!cursor_start'() 974 if null regex goto fail 975 $P0 = cur.regex() 976 unless $P0 goto fail 977 cur.'!cursor_pass'(pos, 'before') 978 fail: 979 .return (cur) 980.end 981 982 983.sub 'ident' :method 984 .local pmc cur 985 .local int pos, eos 986 .local string tgt 987 (cur, pos, tgt) = self.'!cursor_start'() 988 eos = length tgt 989 $S0 = substr tgt, pos, 1 990 if $S0 == '_' goto ident_1 991 $I0 = is_cclass .CCLASS_ALPHABETIC, tgt, pos 992 unless $I0 goto fail 993 ident_1: 994 pos = find_not_cclass .CCLASS_WORD, tgt, pos, eos 995 cur.'!cursor_pass'(pos, 'ident') 996 fail: 997 .return (cur) 998.end 999 1000.sub 'wb' :method 1001 .local pmc cur 1002 .local int pos, eos 1003 .local string tgt 1004 (cur, pos, tgt) = self.'!cursor_start'() 1005 if pos == 0 goto pass 1006 eos = length tgt 1007 if pos == eos goto pass 1008 $I0 = pos - 1 1009 $I1 = is_cclass .CCLASS_WORD, tgt, $I0 1010 $I2 = is_cclass .CCLASS_WORD, tgt, pos 1011 if $I1 == $I2 goto fail 1012 pass: 1013 cur.'!cursor_pass'(pos, 'wb') 1014 fail: 1015 .return (cur) 1016.end 1017 1018.sub 'ww' :method 1019 .local pmc cur 1020 .local int pos, eos 1021 .local string tgt 1022 (cur, pos, tgt) = self.'!cursor_start'() 1023 .local pmc debug 1024 debug = getattribute cur, '$!debug' 1025 if null debug goto debug_1 1026 cur.'!cursor_debug'('START', 'ww') 1027 debug_1: 1028 if pos == 0 goto fail 1029 eos = length tgt 1030 if pos == eos goto fail 1031 $I0 = is_cclass .CCLASS_WORD, tgt, pos 1032 unless $I0 goto fail 1033 $I1 = pos - 1 1034 $I0 = is_cclass .CCLASS_WORD, tgt, $I1 1035 unless $I0 goto fail 1036 pass: 1037 cur.'!cursor_pass'(pos, 'ww') 1038 if null debug goto done 1039 cur.'!cursor_debug'('PASS', 'ww') 1040 goto done 1041 fail: 1042 if null debug goto done 1043 cur.'!cursor_debug'('FAIL', 'ww') 1044 done: 1045 .return (cur) 1046.end 1047 1048.sub 'ws' :method 1049 .local pmc cur 1050 .local int pos, eos 1051 .local string tgt 1052 (cur, pos, tgt) = self.'!cursor_start'() 1053 eos = length tgt 1054 if pos >= eos goto pass 1055 if pos == 0 goto ws_scan 1056 $I0 = is_cclass .CCLASS_WORD, tgt, pos 1057 unless $I0 goto ws_scan 1058 $I1 = pos - 1 1059 $I0 = is_cclass .CCLASS_WORD, tgt, $I1 1060 if $I0 goto fail 1061 ws_scan: 1062 pos = find_not_cclass .CCLASS_WHITESPACE, tgt, pos, eos 1063 pass: 1064 cur.'!cursor_pass'(pos, 'ws') 1065 fail: 1066 .return (cur) 1067.end 1068 1069.sub '!cclass' :anon 1070 .param pmc self 1071 .param string name 1072 .param int cclass 1073 .local pmc cur 1074 .local int pos 1075 .local string tgt 1076 (cur, pos, tgt) = self.'!cursor_start'() 1077 .local pmc debug 1078 debug = getattribute cur, '$!debug' 1079 if null debug goto debug_1 1080 cur.'!cursor_debug'('START', name) 1081 debug_1: 1082 $I0 = is_cclass cclass, tgt, pos 1083 unless $I0 goto fail 1084 inc pos 1085 pass: 1086 cur.'!cursor_pass'(pos, name) 1087 if null debug goto done 1088 cur.'!cursor_debug'('PASS', name) 1089 goto done 1090 fail: 1091 if null debug goto done 1092 cur.'!cursor_debug'('FAIL', name) 1093 done: 1094 .return (cur) 1095.end 1096 1097.sub 'alpha' :method 1098 .local pmc cur 1099 .local int pos 1100 .local string tgt 1101 (cur, pos, tgt) = self.'!cursor_start'() 1102 .local pmc debug 1103 debug = getattribute cur, '$!debug' 1104 if null debug goto debug_1 1105 cur.'!cursor_debug'('START', 'alpha') 1106 debug_1: 1107 $I0 = is_cclass .CCLASS_ALPHABETIC, tgt, pos 1108 if $I0 goto pass 1109 1110 $I0 = length tgt 1111 if pos >= $I0 goto fail 1112 1113 $S0 = substr tgt, pos, 1 1114 if $S0 != '_' goto fail 1115 pass: 1116 inc pos 1117 cur.'!cursor_pass'(pos, 'alpha') 1118 if null debug goto done 1119 cur.'!cursor_debug'('PASS', 'alpha') 1120 goto done 1121 fail: 1122 if null debug goto done 1123 cur.'!cursor_debug'('FAIL', 'alpha') 1124 done: 1125 .return (cur) 1126.end 1127 1128.sub 'upper' :method 1129 .tailcall '!cclass'(self, 'upper', .CCLASS_UPPERCASE) 1130.end 1131 1132.sub 'lower' :method 1133 .tailcall '!cclass'(self, 'lower', .CCLASS_LOWERCASE) 1134.end 1135 1136.sub 'digit' :method 1137 .tailcall '!cclass'(self, 'digit', .CCLASS_NUMERIC) 1138.end 1139 1140.sub 'xdigit' :method 1141 .tailcall '!cclass'(self, 'xdigit', .CCLASS_HEXADECIMAL) 1142.end 1143 1144.sub 'print' :method 1145 .tailcall '!cclass'(self, 'print', .CCLASS_PRINTING) 1146.end 1147 1148.sub 'graph' :method 1149 .tailcall '!cclass'(self, 'graph', .CCLASS_GRAPHICAL) 1150.end 1151 1152.sub 'cntrl' :method 1153 .tailcall '!cclass'(self, 'cntrl', .CCLASS_CONTROL) 1154.end 1155 1156.sub 'punct' :method 1157 .tailcall '!cclass'(self, 'punct', .CCLASS_PUNCTUATION) 1158.end 1159 1160.sub 'alnum' :method 1161 .tailcall '!cclass'(self, 'alnum', .CCLASS_ALPHANUMERIC) 1162.end 1163 1164.sub 'space' :method 1165 .tailcall '!cclass'(self, 'space', .CCLASS_WHITESPACE) 1166.end 1167 1168.sub 'blank' :method 1169 .tailcall '!cclass'(self, 'blank', .CCLASS_BLANK) 1170.end 1171 1172.sub 'FAILGOAL' :method 1173 .param string goal 1174 .local string dba 1175 $P0 = getinterp 1176 $P0 = $P0['sub';1] 1177 dba = $P0 1178 have_dba: 1179 .local string message 1180 message = concat "Unable to parse ", dba 1181 message .= ", couldn't find final " 1182 message .= goal 1183 message .= ' at line ' 1184 $P0 = getattribute self, '$!target' 1185 $P1 = get_hll_global ['HLL'], 'Compiler' 1186 $I0 = self.'pos'() 1187 $I0 = $P1.'lineof'($P0, $I0) 1188 inc $I0 1189 $S0 = $I0 1190 message .= $S0 1191 have_line: 1192 die message 1193.end 1194 1195.sub 'DEBUG' :method 1196 .param pmc arg :optional 1197 .param int has_arg :opt_flag 1198 1199 if has_arg goto have_arg 1200 arg = get_global '$!TRUE' 1201 have_arg: 1202 1203 setattribute self, '$!debug', arg 1204 .return (1) 1205.end 1206 1207=head1 AUTHORS 1208 1209Patrick Michaud <pmichaud@pobox.com> is the author and maintainer. 1210 1211=cut 1212 1213# Local Variables: 1214# mode: pir 1215# fill-column: 100 1216# End: 1217# vim: expandtab shiftwidth=4 ft=pir: 1218### .include 'src/Regex/Cursor-protoregex-peek.pir' 1219# Copyright (C) 2009, The Perl Foundation. 1220 1221=head1 NAME 1222 1223Regex::Cursor-protoregex-peek - simple protoregex implementation 1224 1225=head1 DESCRIPTION 1226 1227=over 4 1228 1229=item !protoregex(name) 1230 1231Perform a match for protoregex C<name>. 1232 1233=cut 1234 1235.sub '!protoregex' :method 1236 .param string name 1237 1238 .local pmc debug 1239 debug = getattribute self, '$!debug' 1240 if null debug goto have_debug 1241 if debug goto have_debug 1242 null debug 1243 have_debug: 1244 1245 .local pmc tokrx, toklen 1246 (tokrx, toklen) = self.'!protoregex_tokrx'(name) 1247 have_tokrx: 1248 1249 if null debug goto debug_skip_1 1250 self.'!cursor_debug'('PROTO', name) 1251 debug_skip_1: 1252 1253 # If there are no entries at all for this protoregex, we fail outright. 1254 unless tokrx goto fail 1255 1256 # Figure out where we are in the current match. 1257 .local pmc target 1258 .local int pos 1259 target = getattribute self, '$!target' 1260 $P1 = getattribute self, '$!pos' 1261 pos = $P1 1262 1263 # Use the character at the current match position to determine 1264 # the longest possible token we could encounter at this point. 1265 .local string token1, token 1266 token1 = substr target, pos, 1 1267 $I0 = toklen[token1] 1268 token = substr target, pos, $I0 1269 1270 if null debug goto debug_skip_2 1271 $S0 = escape token 1272 $S1 = escape token1 1273 self.'!cursor_debug'('NOTE', 'token1="', $S1, '", token="', $S0, '"') 1274 debug_skip_2: 1275 1276 # Create a hash to keep track of the methods we've already called, 1277 # so that we don't end up calling it twice. 1278 .local pmc mcalled 1279 mcalled = new ['Hash'] 1280 1281 # Look in the tokrx hash for any rules that are keyed with the 1282 # current token. If there aren't any, or the rules we have don't 1283 # match, then shorten the token by one character and try again 1284 # until we either have a match or we've run out of candidates. 1285 token_loop: 1286 .local pmc rx, result 1287 rx = tokrx[token] 1288 if null rx goto token_next 1289 $I0 = isa rx, ['ResizablePMCArray'] 1290 if $I0 goto rx_array 1291 .local int rxaddr 1292 rxaddr = get_addr rx 1293 $P0 = mcalled[rxaddr] 1294 unless null $P0 goto token_next 1295 result = self.rx() 1296 mcalled[rxaddr] = mcalled 1297 if result goto done 1298 goto token_next 1299 rx_array: 1300 .local pmc rx_it 1301 rx_it = iter rx 1302 cand_loop: 1303 unless rx_it goto cand_done 1304 rx = shift rx_it 1305 rxaddr = get_addr rx 1306 $P0 = mcalled[rxaddr] 1307 unless null $P0 goto cand_loop 1308 result = self.rx() 1309 mcalled[rxaddr] = mcalled 1310 if result goto done 1311 goto cand_loop 1312 cand_done: 1313 token_next: 1314 unless token > '' goto fail 1315 token = chopn token, 1 1316 goto token_loop 1317 1318 done: 1319 pos = result.'pos'() 1320 1321 if null debug goto debug_skip_3 1322 self.'!cursor_debug'('PASS', name, ' at pos=', pos) 1323 debug_skip_3: 1324 1325 .return (result) 1326 1327 fail: 1328 if null debug goto debug_skip_4 1329 self.'!cursor_debug'('FAIL', name) 1330 debug_skip_4: 1331 unless null result goto fail_1 1332 result = self.'!cursor_start'() 1333 result.'!cursor_fail'() 1334 fail_1: 1335 .return (result) 1336.end 1337 1338 1339=item !protoregex_generation() 1340 1341Reset the C<$!generation> flag to indicate that protoregexes 1342need to be recalculated (because new protoregexes have been 1343added). 1344 1345=cut 1346 1347.sub '!protoregex_generation' :method 1348 $P0 = get_global '$!generation' 1349 # don't change this to 'inc' -- we want to ensure new PMC 1350 $P1 = add $P0, 1 1351 set_global '$!generation', $P1 1352 .return ($P1) 1353.end 1354 1355=item !protoregex_tokrx(name) 1356 1357Return the token list for protoregex C<name>. If the list 1358doesn't already exist, or if the existing list is stale, 1359create a new one and return it. 1360 1361=cut 1362 1363.sub '!protoregex_tokrx' :method 1364 .param string name 1365 1366 .local pmc generation 1367 generation = get_global '$!generation' 1368 1369 # Get the protoregex table for the current grammar. If 1370 # a table doesn't exist or it's out of date, generate a 1371 # new one. 1372 .local pmc parrotclass, prototable 1373 parrotclass = typeof self 1374 prototable = getprop parrotclass, '%!prototable' 1375 if null prototable goto make_prototable 1376 $P0 = getprop prototable, '$!generation' 1377 $I0 = issame $P0, generation 1378 if $I0 goto have_prototable 1379 make_prototable: 1380 prototable = self.'!protoregex_gen_table'(parrotclass) 1381 have_prototable: 1382 1383 # Obtain the toxrk and toklen hashes for the current grammar 1384 # from the protoregex table. If they already exist, we're 1385 # done, otherwise we create new ones below. 1386 # yet for this table, then do that now. 1387 .local pmc tokrx, toklen 1388 $S0 = concat name, '.tokrx' 1389 tokrx = prototable[$S0] 1390 $S0 = concat name, '.toklen' 1391 toklen = prototable[$S0] 1392 unless null tokrx goto tokrx_done 1393 1394 self.'!cursor_debug'('NOTE','Generating protoregex table for ', name) 1395 1396 .local pmc toklen, tokrx 1397 toklen = new ['Hash'] 1398 tokrx = new ['Hash'] 1399 1400 # The prototable has already collected all of the names of 1401 # protoregex methods as keys in C<prototable>. First 1402 # get a list of all of the methods that begin with "name:sym<". 1403 .local string mprefix 1404 .local int mlen 1405 mprefix = concat name, ':sym<' 1406 mlen = length mprefix 1407 .local pmc methodlist, proto_it 1408 methodlist = new ['ResizableStringArray'] 1409 proto_it = iter prototable 1410 proto_loop: 1411 unless proto_it goto proto_done 1412 .local string methodname 1413 methodname = shift proto_it 1414 $S0 = substr methodname, 0, mlen 1415 if $S0 != mprefix goto proto_loop 1416 push methodlist, methodname 1417 goto proto_loop 1418 proto_done: 1419 1420 # Now, walk through all of the methods, building the 1421 # tokrx and toklen tables as we go. 1422 .local pmc sorttok 1423 sorttok = new ['ResizablePMCArray'] 1424 method_loop: 1425 unless methodlist goto method_done 1426 methodname = shift methodlist 1427 1428 # Look up the method itself. 1429 .local pmc rx 1430 rx = find_method self, methodname 1431 1432 # Now find the prefix tokens for the method; calling the 1433 # method name with a !PREFIX__ prefix should return us a list 1434 # of valid token prefixes. If no such method exists, then 1435 # our token prefix is a null string. 1436 .local pmc tokens, tokens_it 1437 $S0 = concat '!PREFIX__', methodname 1438 $I0 = can self, $S0 1439 unless $I0 goto method_peek_none 1440 tokens = self.$S0() 1441 goto method_peek_done 1442 method_peek_none: 1443 tokens = new ['ResizablePMCArray'] 1444 push tokens, '' 1445 method_peek_done: 1446 1447 # Now loop through all of the tokens for the method, updating 1448 # the longest length per initial token character and adding 1449 # the token to the tokrx hash. Entries in the tokrx hash 1450 # are automatically promoted to arrays when there's more 1451 # than one candidate, and any arrays created are placed into 1452 # sorttok so they can have a secondary sort below. 1453 .local pmc seentok 1454 seentok = new ['Hash'] 1455 tokens_loop: 1456 unless tokens goto tokens_done 1457 .local string tkey, tfirst 1458 $P0 = shift tokens 1459 $I0 = isa $P0, ['ResizablePMCArray'] 1460 unless $I0 goto token_item 1461 splice tokens, $P0, 0, 0 1462 goto tokens_loop 1463 token_item: 1464 tkey = $P0 1465 1466 # If we've already processed this token for this rule, 1467 # don't enter it twice into tokrx. 1468 $I0 = exists seentok[tkey] 1469 if $I0 goto tokens_loop 1470 seentok[tkey] = seentok 1471 1472 # Keep track of longest token lengths by initial character 1473 tfirst = substr tkey, 0, 1 1474 $I0 = length tkey 1475 $I1 = toklen[tfirst] 1476 if $I0 <= $I1 goto toklen_done 1477 toklen[tfirst] = $I0 1478 toklen_done: 1479 1480 # Add the regex to the list under the token key, promoting 1481 # entries to lists as appropriate. 1482 .local pmc rxlist 1483 rxlist = tokrx[tkey] 1484 if null rxlist goto rxlist_0 1485 $I0 = isa rxlist, ['ResizablePMCArray'] 1486 if $I0 goto rxlist_n 1487 rxlist_1: 1488 $I0 = issame rx, rxlist 1489 if $I0 goto tokens_loop 1490 $P0 = rxlist 1491 rxlist = new ['ResizablePMCArray'] 1492 push sorttok, rxlist 1493 push rxlist, $P0 1494 push rxlist, rx 1495 tokrx[tkey] = rxlist 1496 goto tokens_loop 1497 rxlist_n: 1498 push rxlist, rx 1499 goto tokens_loop 1500 rxlist_0: 1501 tokrx[tkey] = rx 1502 goto tokens_loop 1503 tokens_done: 1504 goto method_loop 1505 method_done: 1506 1507 # in-place sort the keys that ended up with multiple entries 1508 .const 'Sub' $P99 = '!protoregex_cmp' 1509 sorttok_loop: 1510 unless sorttok goto sorttok_done 1511 rxlist = shift sorttok 1512 rxlist.'sort'($P99) 1513 goto sorttok_loop 1514 sorttok_done: 1515 1516 # It's built! Now store the tokrx and toklen hashes in the 1517 # prototable and return them to the caller. 1518 $S0 = concat name, '.tokrx' 1519 prototable[$S0] = tokrx 1520 $S0 = concat name, '.toklen' 1521 prototable[$S0] = toklen 1522 1523 tokrx_done: 1524 .return (tokrx, toklen) 1525.end 1526 1527.sub '!protoregex_cmp' :anon 1528 .param pmc a 1529 .param pmc b 1530 $S0 = a 1531 $I0 = length $S0 1532 $S1 = b 1533 $I1 = length $S1 1534 $I2 = cmp $I1, $I0 1535 .return ($I2) 1536.end 1537 1538=item !protoregex_gen_table(parrotclass) 1539 1540Generate a new protoregex table for C<parrotclass>. This involves 1541creating a hash keyed with method names containing ':sym<' from 1542C<parrotclass> and all of its superclasses. This new hash is 1543then given the current C<$!generate> property so we can avoid 1544recreating it on future calls. 1545 1546=cut 1547 1548.sub '!protoregex_gen_table' :method 1549 .param pmc parrotclass 1550 1551 .local pmc prototable 1552 prototable = new ['Hash'] 1553 .local pmc class_it, method_it 1554 $P0 = parrotclass.'inspect'('all_parents') 1555 class_it = iter $P0 1556 class_loop: 1557 unless class_it goto class_done 1558 $P0 = shift class_it 1559 $P0 = $P0.'methods'() 1560 method_it = iter $P0 1561 method_loop: 1562 unless method_it goto class_loop 1563 $S0 = shift method_it 1564 $I0 = index $S0, ':sym<' 1565 if $I0 < 0 goto method_loop 1566 prototable[$S0] = prototable 1567 goto method_loop 1568 class_done: 1569 $P0 = get_global '$!generation' 1570 setprop prototable, '$!generation', $P0 1571 setprop parrotclass, '%!prototable', prototable 1572 .return (prototable) 1573.end 1574 1575 1576=item !PREFIX__!protoregex(name) 1577 1578Return the set of initial tokens for protoregex C<name>. 1579These are conveniently available as the keys of the 1580tokrx hash. 1581 1582=cut 1583 1584.sub '!PREFIX__!protoregex' :method 1585 .param string name 1586 1587 .local pmc tokrx 1588 tokrx = self.'!protoregex_tokrx'(name) 1589 unless tokrx goto peek_none 1590 1591 .local pmc results, tokrx_it 1592 results = new ['ResizablePMCArray'] 1593 tokrx_it = iter tokrx 1594 tokrx_loop: 1595 unless tokrx_it goto tokrx_done 1596 $S0 = shift tokrx_it 1597 push results, $S0 1598 goto tokrx_loop 1599 tokrx_done: 1600 .return (results) 1601 1602 peek_none: 1603 .return ('') 1604.end 1605 1606 1607.sub '!PREFIX__!subrule' :method 1608 .param string name 1609 .param string prefix 1610 1611 .local string peekname 1612 peekname = concat '!PREFIX__', name 1613 $I0 = can self, peekname 1614 unless $I0 goto subrule_none 1615 1616 # make sure we aren't recursing 1617 .local pmc context 1618 $P0 = getinterp 1619 context = $P0['context';1] 1620 caller_loop: 1621 if null context goto caller_done 1622 $P0 = getattribute context, 'current_sub' 1623 $S0 = $P0 1624 # stop if we find a name that doesn't begin with ! (33) 1625 $I0 = ord $S0 1626 if $I0 != 33 goto caller_done 1627 if $S0 == peekname goto subrule_none 1628 context = getattribute context, 'caller_ctx' 1629 goto caller_loop 1630 caller_done: 1631 1632 .local pmc subtokens, tokens 1633 subtokens = self.peekname() 1634 unless subtokens goto subrule_none 1635 unless prefix goto prefix_none 1636 tokens = new ['ResizablePMCArray'] 1637 subtokens_loop: 1638 unless subtokens goto subtokens_done 1639 $P0 = shift subtokens 1640 $I0 = isa $P0, ['ResizablePMCArray'] 1641 unless $I0 goto subtokens_item 1642 splice subtokens, $P0, 0, 0 1643 goto subtokens_loop 1644 subtokens_item: 1645 $S0 = $P0 1646 $S0 = concat prefix, $S0 1647 push tokens, $S0 1648 goto subtokens_loop 1649 subtokens_done: 1650 .return (tokens) 1651 1652 prefix_none: 1653 .return (subtokens) 1654 1655 subrule_none: 1656 .return (prefix) 1657.end 1658 1659 1660.sub 'DUMP_TOKRX' :method 1661 .param string name 1662 1663 .local pmc tokrx 1664 tokrx = self.'!protoregex_tokrx'(name) 1665 _dumper(tokrx, name) 1666 .return (1) 1667.end 1668 1669=back 1670 1671=cut 1672 1673# Local Variables: 1674# mode: pir 1675# fill-column: 100 1676# End: 1677# vim: expandtab shiftwidth=4 ft=pir: 1678 1679### .include 'src/Regex/Match.pir' 1680# Copyright (C) 2009, The Perl Foundation. 1681# 1682 1683=head1 NAME 1684 1685Regex::Match - Regex Match objects 1686 1687=head1 DESCRIPTION 1688 1689This file implements Match objects for the regex engine. 1690 1691=cut 1692 1693.namespace ['Regex';'Match'] 1694 1695.sub '' :anon :load :init 1696 load_bytecode 'P6object.pbc' 1697 .local pmc p6meta 1698 p6meta = new 'P6metaclass' 1699 $P0 = p6meta.'new_class'('Regex::Match', 'parent'=>'Capture', 'attr'=>'$!cursor $!target $!from $!to $!ast') 1700 .return () 1701.end 1702 1703=head2 Methods 1704 1705=over 4 1706 1707=item CURSOR() 1708 1709Returns the Cursor associated with this match object. 1710 1711=cut 1712 1713.sub 'CURSOR' :method 1714 $P0 = getattribute self, '$!cursor' 1715 .return ($P0) 1716.end 1717 1718=item from() 1719 1720Returns the offset in the target string of the beginning of the match. 1721 1722=cut 1723 1724.sub 'from' :method 1725 $P0 = getattribute self, '$!from' 1726 .return ($P0) 1727.end 1728 1729 1730=item to() 1731 1732Returns the offset in the target string of the end of the match. 1733 1734=cut 1735 1736.sub 'to' :method 1737 $P0 = getattribute self, '$!to' 1738 .return ($P0) 1739.end 1740 1741 1742=item chars() 1743 1744Returns C<.to() - .from()> 1745 1746=cut 1747 1748.sub 'chars' :method 1749 $I0 = self.'to'() 1750 $I1 = self.'from'() 1751 $I2 = $I0 - $I1 1752 if $I2 >= 0 goto done 1753 .return (0) 1754 done: 1755 .return ($I2) 1756.end 1757 1758 1759=item orig() 1760 1761Return the original item that was matched against. 1762 1763=cut 1764 1765.sub 'orig' :method 1766 $P0 = getattribute self, '$!target' 1767 .return ($P0) 1768.end 1769 1770 1771=item Str() 1772 1773Returns the portion of the target corresponding to this match. 1774 1775=cut 1776 1777.sub 'Str' :method 1778 $S0 = self.'orig'() 1779 $I0 = self.'from'() 1780 $I1 = self.'to'() 1781 $I1 -= $I0 1782 $S1 = substr $S0, $I0, $I1 1783 .return ($S1) 1784.end 1785 1786 1787=item ast() 1788 1789Returns the "abstract object" for the Match; if no abstract object 1790has been set then returns C<Str> above. 1791 1792=cut 1793 1794.sub 'ast' :method 1795 .local pmc ast 1796 ast = getattribute self, '$!ast' 1797 unless null ast goto have_ast 1798 ast = new ['Undef'] 1799 setattribute self, '$!ast', ast 1800 have_ast: 1801 .return (ast) 1802.end 1803 1804=back 1805 1806=head2 Vtable functions 1807 1808=over 4 1809 1810=item get_bool() 1811 1812Returns 1 (true) if this is the result of a successful match, 1813otherwise returns 0 (false). 1814 1815=cut 1816 1817.sub '' :vtable('get_bool') :method 1818 $P0 = getattribute self, '$!from' 1819 $P1 = getattribute self, '$!to' 1820 $I0 = isge $P1, $P0 1821 .return ($I0) 1822.end 1823 1824 1825=item get_integer() 1826 1827Returns the integer value of the matched text. 1828 1829=cut 1830 1831.sub '' :vtable('get_integer') :method 1832 $I0 = self.'Str'() 1833 .return ($I0) 1834.end 1835 1836 1837=item get_number() 1838 1839Returns the numeric value of this match 1840 1841=cut 1842 1843.sub '' :vtable('get_number') :method 1844 $N0 = self.'Str'() 1845 .return ($N0) 1846.end 1847 1848 1849=item get_string() 1850 1851Returns the string value of the match 1852 1853=cut 1854 1855.sub '' :vtable('get_string') :method 1856 $S0 = self.'Str'() 1857 .return ($S0) 1858.end 1859 1860 1861=item !make(obj) 1862 1863Set the "ast object" for the invocant. 1864 1865=cut 1866 1867.sub '!make' :method 1868 .param pmc obj 1869 setattribute self, '$!ast', obj 1870 .return (obj) 1871.end 1872 1873 1874=back 1875 1876=head1 AUTHORS 1877 1878Patrick Michaud <pmichaud@pobox.com> is the author and maintainer. 1879 1880=cut 1881 1882# Local Variables: 1883# mode: pir 1884# fill-column: 100 1885# End: 1886# vim: expandtab shiftwidth=4 ft=pir: 1887### .include 'src/Regex/Method.pir' 1888# Copyright (C) 2009, The Perl Foundation. 1889# 1890 1891=head1 NAME 1892 1893Regex::Regex, Regex::Method - Regex subs 1894 1895=head1 DESCRIPTION 1896 1897This file implements the Regex::Method and Regex::Regex types, used as 1898containers for Regex subs that need .ACCEPTS and other regex attributes. 1899 1900=cut 1901 1902.namespace ['Regex';'Method'] 1903 1904.sub '' :anon :load :init 1905 load_bytecode 'P6object.pbc' 1906 .local pmc p6meta, mproto, rproto 1907 p6meta = new 'P6metaclass' 1908 mproto = p6meta.'new_class'('Regex::Method', 'parent'=>'parrot;Sub') 1909 rproto = p6meta.'new_class'('Regex::Regex', 'parent'=>mproto) 1910.end 1911 1912=head2 Methods 1913 1914=over 4 1915 1916=item new(sub) 1917 1918Create a new Regex::Regex object from C<sub>. 1919 1920=cut 1921 1922.sub 'new' :method 1923 .param pmc parrotsub 1924 $P0 = self.'WHO'() 1925 $P0 = new $P0 1926 assign $P0, parrotsub 1927 .return ($P0) 1928.end 1929 1930 1931=item ACCEPTS(target) 1932 1933Perform a match against target, return the result. 1934 1935=cut 1936 1937.sub 'ACCEPTS' :method 1938 .param pmc target 1939 1940 .local pmc curproto, match 1941 curproto = get_hll_global ['Regex'], 'Cursor' 1942 match = curproto.'parse'(target, 'rule'=>self) 1943 .return (match) 1944.end 1945 1946.namespace ['Regex';'Regex'] 1947 1948.sub 'ACCEPTS' :method 1949 .param pmc target 1950 1951 .local pmc curproto, match 1952 curproto = get_hll_global ['Regex'], 'Cursor' 1953 match = curproto.'parse'(target, 'rule'=>self, 'c'=>0) 1954 .return (match) 1955.end 1956 1957 1958=back 1959 1960=head1 AUTHORS 1961 1962Patrick Michaud <pmichaud@pobox.com> is the author and maintainer. 1963 1964=cut 1965 1966# Local Variables: 1967# mode: pir 1968# fill-column: 100 1969# End: 1970# vim: expandtab shiftwidth=4 ft=pir: 1971### .include 'src/Regex/Dumper.pir' 1972# Copyright (C) 2005-2009, Parrot Foundation. 1973# Copyright (C) 2009, The Perl Foundation. 1974# 1975 1976=head1 TITLE 1977 1978Regex::Dumper - various methods for displaying Match structures 1979 1980=head2 C<Regex::Match> Methods 1981 1982=over 4 1983 1984=item C<__dump(PMC dumper, STR label)> 1985 1986This method enables Data::Dumper to work on Regex::Match objects. 1987 1988=cut 1989 1990.namespace ['Regex';'Match'] 1991 1992.sub "__dump" :method 1993 .param pmc dumper 1994 .param string label 1995 .local string indent, subindent 1996 .local pmc it, val 1997 .local string key 1998 .local pmc hash, array 1999 .local int hascapts 2000 2001 (subindent, indent) = dumper."newIndent"() 2002 print "=> " 2003 $S0 = self 2004 dumper."genericString"("", $S0) 2005 print " @ " 2006 $I0 = self.'from'() 2007 print $I0 2008 hascapts = 0 2009 hash = self.'hash'() 2010 if_null hash, dump_array 2011 it = iter hash 2012 dump_hash_1: 2013 unless it goto dump_array 2014 if hascapts goto dump_hash_2 2015 print " {" 2016 hascapts = 1 2017 dump_hash_2: 2018 print "\n" 2019 print subindent 2020 key = shift it 2021 val = hash[key] 2022 print "<" 2023 print key 2024 print "> => " 2025 dumper."dump"(label, val) 2026 goto dump_hash_1 2027 dump_array: 2028 array = self.'list'() 2029 if_null array, dump_end 2030 $I1 = elements array 2031 $I0 = 0 2032 dump_array_1: 2033 if $I0 >= $I1 goto dump_end 2034 if hascapts goto dump_array_2 2035 print " {" 2036 hascapts = 1 2037 dump_array_2: 2038 print "\n" 2039 print subindent 2040 val = array[$I0] 2041 print "[" 2042 print $I0 2043 print "] => " 2044 dumper."dump"(label, val) 2045 inc $I0 2046 goto dump_array_1 2047 dump_end: 2048 unless hascapts goto end 2049 print "\n" 2050 print indent 2051 print "}" 2052 end: 2053 dumper."deleteIndent"() 2054.end 2055 2056 2057=item C<dump_str()> 2058 2059An alternate dump output for a Match object and all of its subcaptures. 2060 2061=cut 2062 2063.sub "dump_str" :method 2064 .param string prefix :optional # name of match variable 2065 .param int has_prefix :opt_flag 2066 .param string b1 :optional # bracket open 2067 .param int has_b1 :opt_flag 2068 .param string b2 :optional # bracket close 2069 .param int has_b2 :opt_flag 2070 2071 .local pmc capt 2072 .local int spi, spc 2073 .local pmc it 2074 .local string prefix1, prefix2 2075 .local pmc jmpstack 2076 jmpstack = new 'ResizableIntegerArray' 2077 2078 if has_b2 goto start 2079 b2 = "]" 2080 if has_b1 goto start 2081 b1 = "[" 2082 start: 2083 .local string out 2084 out = concat prefix, ':' 2085 unless self goto subpats 2086 out .= ' <' 2087 $S0 = self 2088 out .= $S0 2089 out .= ' @ ' 2090 $S0 = self.'from'() 2091 out .= $S0 2092 out .= '> ' 2093 2094 subpats: 2095 $I0 = self 2096 $S0 = $I0 2097 out .= $S0 2098 out .= "\n" 2099 capt = self.'list'() 2100 if_null capt, subrules 2101 spi = 0 2102 spc = elements capt 2103 subpats_1: 2104 unless spi < spc goto subrules 2105 prefix1 = concat prefix, b1 2106 $S0 = spi 2107 prefix1 = concat prefix1, $S0 2108 prefix1 = concat prefix1, b2 2109 $I0 = defined capt[spi] 2110 unless $I0 goto subpats_2 2111 $P0 = capt[spi] 2112 local_branch jmpstack, dumper 2113 subpats_2: 2114 inc spi 2115 goto subpats_1 2116 2117 subrules: 2118 capt = self.'hash'() 2119 if_null capt, end 2120 it = iter capt 2121 subrules_1: 2122 unless it goto end 2123 $S0 = shift it 2124 prefix1 = concat prefix, '<' 2125 prefix1 = concat prefix1, $S0 2126 prefix1 = concat prefix1, ">" 2127 $I0 = defined capt[$S0] 2128 unless $I0 goto subrules_1 2129 $P0 = capt[$S0] 2130 local_branch jmpstack, dumper 2131 goto subrules_1 2132 2133 dumper: 2134 $I0 = isa $P0, ['Regex';'Match'] 2135 unless $I0 goto dumper_0 2136 $S0 = $P0.'dump_str'(prefix1, b1, b2) 2137 out .= $S0 2138 local_return jmpstack 2139 dumper_0: 2140 $I0 = does $P0, 'array' 2141 unless $I0 goto dumper_3 2142 $I0 = 0 2143 $I1 = elements $P0 2144 dumper_1: 2145 if $I0 >= $I1 goto dumper_2 2146 $P1 = $P0[$I0] 2147 prefix2 = concat prefix1, b1 2148 $S0 = $I0 2149 prefix2 = concat prefix2, $S0 2150 prefix2 = concat prefix2, b2 2151 $S0 = $P1.'dump_str'(prefix2, b1, b2) 2152 out .= $S0 2153 inc $I0 2154 goto dumper_1 2155 dumper_2: 2156 local_return jmpstack 2157 dumper_3: 2158 out .= prefix1 2159 out .= ': ' 2160 $S0 = $P0 2161 out .= $S0 2162 out .= "\n" 2163 local_return jmpstack 2164 2165 end: 2166 .return (out) 2167.end 2168 2169 2170=back 2171 2172=cut 2173 2174# Local Variables: 2175# mode: pir 2176# fill-column: 100 2177# End: 2178# vim: expandtab shiftwidth=4 ft=pir: 2179 2180### .include 'src/PAST/Regex.pir' 2181# $Id$ 2182 2183=head1 NAME 2184 2185PAST::Regex - Regex nodes for PAST 2186 2187=head1 DESCRIPTION 2188 2189This file implements the various abstract syntax tree nodes 2190for regular expressions. 2191 2192=over 4 2193 2194=cut 2195 2196.namespace ['PAST';'Regex'] 2197 2198.sub '' :init :load 2199 load_bytecode 'PCT/PAST.pbc' 2200 .local pmc p6meta 2201 p6meta = get_hll_global 'P6metaclass' 2202 p6meta.'new_class'('PAST::Regex', 'parent'=>'PAST::Node') 2203.end 2204 2205 2206.sub 'backtrack' :method 2207 .param pmc value :optional 2208 .param int has_value :opt_flag 2209 .tailcall self.'attr'('backtrack', value, has_value) 2210.end 2211 2212 2213.sub 'capnames' :method 2214 .param pmc value :optional 2215 .param int has_value :opt_flag 2216 .tailcall self.'attr'('capnames', value, has_value) 2217.end 2218 2219 2220.sub 'negate' :method 2221 .param pmc value :optional 2222 .param int has_value :opt_flag 2223 .tailcall self.'attr'('negate', value, has_value) 2224.end 2225 2226 2227.sub 'min' :method 2228 .param pmc value :optional 2229 .param int has_value :opt_flag 2230 .tailcall self.'attr'('min', value, has_value) 2231.end 2232 2233 2234.sub 'max' :method 2235 .param pmc value :optional 2236 .param int has_value :opt_flag 2237 .tailcall self.'attr'('max', value, has_value) 2238.end 2239 2240 2241.sub 'pasttype' :method 2242 .param pmc value :optional 2243 .param int has_value :opt_flag 2244 .tailcall self.'attr'('pasttype', value, has_value) 2245.end 2246 2247 2248.sub 'sep' :method 2249 .param pmc value :optional 2250 .param int has_value :opt_flag 2251 .tailcall self.'attr'('sep', value, has_value) 2252.end 2253 2254 2255.sub 'subtype' :method 2256 .param pmc value :optional 2257 .param int has_value :opt_flag 2258 .tailcall self.'attr'('subtype', value, has_value) 2259.end 2260 2261 2262.sub 'zerowidth' :method 2263 .param pmc value :optional 2264 .param int has_value :opt_flag 2265 .tailcall self.'attr'('zerowidth', value, has_value) 2266.end 2267 2268 2269=item prefix() 2270 2271Returns the prefixes associated with the regex tree rooted 2272at this node. 2273 2274=cut 2275 2276.sub 'prefix' :method 2277 .param string prefix 2278 .param pmc tail :slurpy 2279 2280 .local string pasttype 2281 pasttype = self.'pasttype'() 2282 if pasttype goto have_pasttype 2283 pasttype = 'concat' 2284 have_pasttype: 2285 2286 if pasttype == 'scan' goto prefix_skip 2287 2288 $S0 = concat 'prefix_', pasttype 2289 $I0 = can self, $S0 2290 unless $I0 goto prefix_done 2291 .tailcall self.$S0(prefix, tail) 2292 2293 prefix_skip: 2294 unless tail goto prefix_done 2295 .local pmc head 2296 head = shift tail 2297 .tailcall head.'prefix'(prefix, tail :flat) 2298 2299 prefix_done: 2300 .return (prefix) 2301.end 2302 2303 2304.sub 'prefix_alt' :method 2305 .param string prefix 2306 .param pmc tail 2307 2308 .local pmc child_it, results 2309 child_it = self.'iterator'() 2310 results = new ['ResizablePMCArray'] 2311 child_loop: 2312 unless child_it goto child_done 2313 $P0 = shift child_it 2314 ($P1 :slurpy) = $P0.'prefix'(prefix, tail :flat) 2315 splice results, $P1, 0, 0 2316 goto child_loop 2317 child_done: 2318 .return (results :flat) 2319.end 2320 2321 2322.sub 'prefix_alt_longest' :method 2323 .param string prefix 2324 .param pmc tail 2325 .tailcall self.'prefix_alt'(prefix, tail :flat) 2326.end 2327 2328 2329.sub 'prefix_anchor' :method 2330 .param string prefix 2331 .param pmc tail 2332 2333 unless tail goto anchor_done 2334 .local pmc head 2335 head = shift tail 2336 .tailcall head.'prefix'(prefix, tail :flat) 2337 anchor_done: 2338 .return (prefix) 2339.end 2340 2341 2342.sub 'prefix_concat' :method 2343 .param string prefix 2344 .param pmc tail 2345 2346 $P0 = self.'list'() 2347 splice tail, $P0, 0, 0 2348 unless tail goto done 2349 $P1 = shift tail 2350 .tailcall $P1.'prefix'(prefix, tail :flat) 2351 done: 2352 .return (prefix) 2353.end 2354 2355 2356.sub 'prefix_literal' :method 2357 .param string prefix 2358 .param pmc tail 2359 2360 .local pmc lpast 2361 lpast = self[0] 2362 $I0 = isa lpast, ['String'] 2363 unless $I0 goto done 2364 2365 .local string subtype 2366 subtype = self.'subtype'() 2367 if subtype == 'ignorecase' goto done 2368 2369 $S0 = lpast 2370 prefix = concat prefix, $S0 2371 unless tail goto done 2372 $P0 = shift tail 2373 .tailcall $P0.'prefix'(prefix, tail :flat) 2374 2375 done: 2376 .return (prefix) 2377.end 2378 2379 2380.sub 'prefix_enumcharlist' :method 2381 .param string prefix 2382 .param pmc tail 2383 2384 .local pmc negate 2385 negate = self.'negate'() 2386 .local string subtype, charlist 2387 subtype = self.'subtype'() 2388 charlist = self[0] 2389 2390 if negate goto charlist_negate 2391 2392 unless tail goto charlist_notail 2393 if subtype == 'zerowidth' goto charlist_notail 2394 2395 .local pmc result, head 2396 result = new ['ResizablePMCArray'] 2397 head = shift tail 2398 2399 .local int pos, eos 2400 eos = length charlist 2401 pos = 0 2402 charlist_loop: 2403 unless pos < eos goto charlist_done 2404 .local string char 2405 char = substr charlist, pos, 1 2406 $S0 = concat prefix, char 2407 ($P0 :slurpy) = head.'prefix'($S0, tail :flat) 2408 splice result, $P0, 0, 0 2409 inc pos 2410 goto charlist_loop 2411 charlist_done: 2412 .return (result :flat) 2413 2414 charlist_notail: 2415 $P0 = split '', charlist 2416 .return ($P0 :flat) 2417 2418 charlist_negate: 2419 if subtype == 'zerowidth' goto charlist_negate_0 2420 unless tail goto charlist_negate_0 2421 .return (prefix) 2422 charlist_negate_0: 2423 head = shift tail 2424 .tailcall head.'prefix'(prefix, tail :flat) 2425.end 2426 2427.sub 'prefix_pastnode' :method 2428 .param string prefix 2429 .param pmc tail 2430 2431 unless tail goto pastnode_none 2432 .local string subtype 2433 subtype = self.'subtype'() 2434 if subtype != 'declarative' goto pastnode_none 2435 2436 .local pmc head 2437 head = shift tail 2438 .tailcall head.'prefix'(prefix, tail :flat) 2439 2440 pastnode_none: 2441 .return (prefix) 2442.end 2443 2444.sub 'prefix_subcapture' :method 2445 .param string prefix 2446 .param pmc tail 2447 2448 .tailcall self.'prefix_concat'(prefix, tail) 2449.end 2450 2451.sub 'prefix_subrule' :method 2452 .param string prefix 2453 .param pmc tail 2454 2455 .local pmc name, negate, subtype 2456 name = self[0] 2457 negate = self.'negate'() 2458 subtype = self.'subtype'() 2459 $I0 = does name, 'string' 2460 unless $I0 goto subrule_none 2461 if negate goto subrule_none 2462 if subtype == 'zerowidth' goto subrule_none 2463 2464 .local pmc selfpast, spast 2465 $P99 = get_hll_global ['PAST'], 'Var' 2466 selfpast = $P99.'new'( 'name'=>'self', 'scope'=>'register') 2467 $P99 = get_hll_global ['PAST'], 'Op' 2468 spast = $P99.'new'( selfpast, name, prefix, 'name'=>'!PREFIX__!subrule', 'pasttype'=>'callmethod') 2469 .return (spast) 2470 2471 subrule_none: 2472 .return (prefix) 2473.end 2474 2475=back 2476 2477=head1 AUTHOR 2478 2479Patrick Michaud <pmichaud@pobox.com> is the author and maintainer. 2480Please send patches and suggestions to the Parrot porters or 2481Perl 6 compilers mailing lists. 2482 2483=head1 COPYRIGHT 2484 2485Copyright (C) 2009, The Perl Foundation. 2486 2487=cut 2488 2489# Local Variables: 2490# mode: pir 2491# fill-column: 100 2492# End: 2493# vim: expandtab shiftwidth=4 ft=pir: 2494### .include 'src/PAST/Compiler-Regex.pir' 2495# 2496 2497=head1 NAME 2498 2499PAST::Compiler-Regex - Compiler for PAST::Regex nodes 2500 2501=head1 DESCRIPTION 2502 2503PAST::Compiler-Regex implements the transformations to convert 2504PAST::Regex nodes into POST. It's still a part of PAST::Compiler; 2505we've separated out the regex-specific transformations here for 2506better code management and debugging. 2507 2508=head2 Compiler methods 2509 2510=head3 C<PAST::Regex> 2511 2512=over 4 2513 2514=item as_post(PAST::Regex node) 2515 2516Return the POST representation of the regex AST rooted by C<node>. 2517 2518=cut 2519 2520.include 'cclass.pasm' 2521### .include 'src/Regex/constants.pir' 2522.const int CURSOR_FAIL = -1 2523.const int CURSOR_FAIL_GROUP = -2 2524.const int CURSOR_FAIL_RULE = -3 2525.const int CURSOR_FAIL_MATCH = -4 2526 2527.const int CURSOR_TYPE_SCAN = 1 2528.const int CURSOR_TYPE_PEEK = 2 2529 2530.namespace ['PAST';'Compiler'] 2531 2532.sub 'as_post' :method :multi(_, ['PAST';'Regex']) 2533 .param pmc node 2534 .param pmc options :slurpy :named 2535 2536 .local pmc ops 2537 ops = self.'post_new'('Ops', 'node'=>node) 2538 2539 .local pmc reghash 2540 reghash = new ['Hash'] 2541 .lex '$*REG', reghash 2542 2543 .local pmc regexname, regexname_esc 2544 $P0 = find_dynamic_lex '@*BLOCKPAST' 2545 $P1 = $P0[0] 2546 $S0 = $P1.'name'() 2547 regexname = box $S0 2548 regexname_esc = self.'escape'($S0) 2549 .lex '$*REGEXNAME', regexname 2550 2551 .local string prefix, rname, rtype 2552 prefix = self.'unique'('rx') 2553 prefix = concat prefix, '_' 2554 $P0 = split ' ', 'tgt string pos int off int eos int rep int cur pmc debug pmc' 2555 $P1 = iter $P0 2556 iter_loop: 2557 unless $P1 goto iter_done 2558 rname = shift $P1 2559 rtype = shift $P1 2560 $S1 = concat prefix, rname 2561 reghash[rname] = $S1 2562 $S2 = concat '.local ', rtype 2563 ops.'push_pirop'($S2, $S1) 2564 goto iter_loop 2565 iter_done: 2566 2567 .local pmc startlabel, donelabel, faillabel, restartlabel 2568 $S0 = concat prefix, 'start' 2569 startlabel = self.'post_new'('Label', 'result'=>$S0) 2570 $S0 = concat prefix, 'done' 2571 donelabel = self.'post_new'('Label', 'result'=>$S0) 2572 $S0 = concat prefix, 'fail' 2573 faillabel = self.'post_new'('Label', 'result'=>$S0) 2574 $S0 = concat prefix, 'restart' 2575 restartlabel = self.'post_new'('Label', 'result'=>$S0) 2576 reghash['fail'] = faillabel 2577 2578 # If capnames is available, it's a hash where each key is the 2579 # name of a potential subcapture and the value is greater than 1 2580 # if it's to be an array. This builds a list of arrayed subcaptures 2581 # for use by "!cursor_caparray" below. 2582 .local pmc capnames, capnames_it, caparray 2583 capnames = node.'capnames'() 2584 caparray = box 0 2585 unless capnames goto capnames_done 2586 capnames_it = iter capnames 2587 caparray = new ['ResizablePMCArray'] 2588 capnames_loop: 2589 unless capnames_it goto capnames_done 2590 $S0 = shift capnames_it 2591 $I0 = capnames[$S0] 2592 unless $I0 > 1 goto capnames_loop 2593 $S0 = self.'escape'($S0) 2594 push caparray, $S0 2595 goto capnames_loop 2596 capnames_done: 2597 2598 .local string cur, rep, pos, tgt, off, eos, debug 2599 (cur, rep, pos, tgt, off, eos, debug) = self.'!rxregs'('cur rep pos tgt off eos debug') 2600 2601 unless regexname goto peek_done 2602 .local pmc tpast, token, tpost 2603 $P99 = get_hll_global ['PAST'], 'Op' 2604 tpast = $P99.'new'( 'pasttype'=>'list', 'node'=>node ) 2605 (token :slurpy) = node.'prefix'('') 2606 token_loop: 2607 unless token goto token_done 2608 $P0 = shift token 2609 push tpast, $P0 2610 goto token_loop 2611 token_done: 2612 $S0 = regexname 2613 $S0 = concat '!PREFIX__', $S0 2614 $P99 = get_hll_global ['PAST'], 'Block' 2615 tpast = $P99.'new'(tpast, 'name'=>$S0, 'lexical'=>0, 'blocktype'=>'method') 2616 tpost = self.'as_post'(tpast, 'rtype'=>'v') 2617 ops.'push'(tpost) 2618 peek_done: 2619 2620 $S0 = concat '(', cur 2621 $S0 = concat $S0, ', ' 2622 $S0 = concat $S0, pos 2623 $S0 = concat $S0, ', ' 2624 $S0 = concat $S0, tgt 2625 $S0 = concat $S0, ', $I10)' 2626 ops.'push_pirop'('callmethod', '"!cursor_start"', 'self', 'result'=>$S0) 2627 unless caparray goto caparray_skip 2628 self.'!cursorop'(ops, '!cursor_caparray', 0, caparray :flat) 2629 caparray_skip: 2630 2631 ops.'push_pirop'('getattribute', debug, cur, '"$!debug"') 2632 ops.'push_pirop'('.lex', 'unicode:"$\x{a2}"', cur) 2633 ops.'push_pirop'('.local pmc', 'match') 2634 ops.'push_pirop'('.lex', '"$/"', 'match') 2635 ops.'push_pirop'('length', eos, tgt, 'result'=>eos) 2636 ops.'push_pirop'('gt', pos, eos, donelabel) 2637 2638 # On Parrot, indexing into variable-width encoded strings 2639 # (such as utf8) becomes much more expensive as we move 2640 # farther away from the beginning of the string (via calls 2641 # to utf8_skip_forward). For regexes that are starting a match 2642 # at a position other than the beginning of the string (e.g., 2643 # a subrule call), we can save a lot of useless scanning work 2644 # in utf8_skip_forward by removing the first C<off = from-1> 2645 # characters from the target and then performing all indexed 2646 # operations on the resulting target relative to C<off>. 2647 2648 ops.'push_pirop'('set', off, 0) 2649 ops.'push_pirop'('lt', pos, 2, startlabel) 2650 ops.'push_pirop'('sub', off, pos, 1, 'result'=>off) 2651 ops.'push_pirop'('substr', tgt, tgt, off, 'result'=>tgt) 2652 ops.'push'(startlabel) 2653 ops.'push_pirop'('eq', '$I10', 1, restartlabel) 2654 self.'!cursorop'(ops, '!cursor_debug', 0, '"START"', regexname_esc) 2655 2656 $P0 = self.'post_regex'(node) 2657 ops.'push'($P0) 2658 ops.'push'(restartlabel) 2659 self.'!cursorop'(ops, '!cursor_debug', 0, '"NEXT"', regexname_esc) 2660 ops.'push'(faillabel) 2661 self.'!cursorop'(ops, '!mark_fail', 4, rep, pos, '$I10', '$P10', 0) 2662 ops.'push_pirop'('lt', pos, CURSOR_FAIL, donelabel) 2663 ops.'push_pirop'('eq', pos, CURSOR_FAIL, faillabel) 2664 ops.'push_pirop'('jump', '$I10') 2665 ops.'push'(donelabel) 2666 self.'!cursorop'(ops, '!cursor_fail', 0) 2667 self.'!cursorop'(ops, '!cursor_debug', 0, '"FAIL"', regexname_esc) 2668 ops.'push_pirop'('return', cur) 2669 .return (ops) 2670.end 2671 2672=item !cursorop(ops, func, retelems, arg :slurpy) 2673 2674Helper function to push POST nodes onto C<ops> that perform C<func> 2675on the regex's current cursor. By default this ends up being a method 2676call on the cursor, but some values of C<func> can result in inlined 2677code to perform the equivalent operation without using the method call. 2678 2679The C<retelems> argument is the number of elements in C<arg> that 2680represent return values from the function; any remaining elements in arg 2681are passed to the function as input arguments. 2682 2683=cut 2684 2685.sub '!cursorop' :method 2686 .param pmc ops 2687 .param string func 2688 .param int retelems 2689 .param pmc args :slurpy 2690 2691 $S0 = concat '!cursorop_', func 2692 $I0 = can self, $S0 2693 unless $I0 goto cursorop_default 2694 $P0 = self.$S0(ops, func, retelems, args :flat) 2695 unless null $P0 goto done 2696 2697 cursorop_default: 2698 if retelems < 1 goto result_done 2699 .local pmc retargs 2700 retargs = new ['ResizableStringArray'] 2701 $I0 = retelems 2702 retargs_loop: 2703 unless $I0 > 0 goto retargs_done 2704 $S0 = shift args 2705 push retargs, $S0 2706 dec $I0 2707 goto retargs_loop 2708 retargs_done: 2709 .local string result 2710 result = join ', ', retargs 2711 result = concat '(', result 2712 result = concat result, ')' 2713 result_done: 2714 2715 .local pmc cur 2716 cur = self.'!rxregs'('cur') 2717 $S0 = self.'escape'(func) 2718 $P0 = ops.'push_pirop'('callmethod', $S0, cur, args :flat) 2719 if retelems < 1 goto done 2720 $P0.'result'(result) 2721 done: 2722 .return (ops) 2723.end 2724 2725.sub '!cursorop_!cursor_debug' :method 2726 .param pmc ops 2727 .param string func 2728 .param int retelems 2729 .param pmc args :slurpy 2730 2731 .local pmc cur, debug, debuglabel 2732 $P99 = get_hll_global ['POST'], 'Label' 2733 debuglabel = $P99.'new'('name'=>'debug_') 2734 (cur, debug) = self.'!rxregs'('cur debug') 2735 ops.'push_pirop'('if_null', debug, debuglabel) 2736 $S0 = self.'escape'(func) 2737 ops.'push_pirop'('callmethod', $S0, cur, args :flat) 2738 ops.'push'(debuglabel) 2739 .return (ops) 2740.end 2741 2742 2743=item !rxregs(keystr) 2744 2745Helper function -- looks up the current regex register table 2746in the dynamic scope and returns a slice based on the keys 2747given in C<keystr>. 2748 2749=cut 2750 2751.sub '!rxregs' :method 2752 .param string keystr 2753 2754 .local pmc keys, reghash, vals 2755 keys = split ' ', keystr 2756 reghash = find_dynamic_lex '$*REG' 2757 vals = new ['ResizablePMCArray'] 2758 keys_loop: 2759 unless keys goto keys_done 2760 $S0 = shift keys 2761 $P0 = reghash[$S0] 2762 push vals, $P0 2763 goto keys_loop 2764 keys_done: 2765 .return (vals :flat) 2766.end 2767 2768 2769=item post_regex(PAST::Regex node) 2770 2771Return the POST representation of the regex component given by C<node>. 2772Normally this is handled by redispatching to a method corresponding to 2773the node's "pasttype" and "backtrack" attributes. If no "pasttype" is 2774given, then "concat" is assumed. 2775 2776=cut 2777 2778.sub 'post_regex' :method :multi(_, ['PAST';'Regex']) 2779 .param pmc node 2780 .param string cur :optional 2781 .param int have_cur :opt_flag 2782 2783 .local string pasttype 2784 pasttype = node.'pasttype'() 2785 if pasttype goto have_pasttype 2786 pasttype = 'concat' 2787 have_pasttype: 2788 $P0 = find_method self, pasttype 2789 $P1 = self.$P0(node) 2790 unless have_cur goto done 2791 $S0 = $P1.'result'() 2792 if $S0 == cur goto done 2793 $P1 = self.'coerce'($P1, cur) 2794 done: 2795 .return ($P1) 2796.end 2797 2798 2799.sub 'post_regex' :method :multi(_, _) 2800 .param pmc node 2801 .param string cur :optional 2802 .param int have_cur :opt_flag 2803 2804 $P0 = self.'as_post'(node) 2805 unless have_cur goto done 2806 $P0 = self.'coerce'($P0, cur) 2807 done: 2808 .return ($P0) 2809.end 2810 2811 2812=item alt(PAST::Regex node) 2813 2814=cut 2815 2816.sub 'alt' :method :multi(_, ['PAST';'Regex']) 2817 .param pmc node 2818 2819 .local pmc cur, pos 2820 (cur, pos) = self.'!rxregs'('cur pos') 2821 2822 .local string name 2823 name = self.'unique'('alt') 2824 name = concat name, '_' 2825 2826 .local pmc ops, iter 2827 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 2828 iter = node.'iterator'() 2829 unless iter goto done 2830 2831 .local int acount 2832 .local pmc alabel, endlabel 2833 acount = 0 2834 $S0 = acount 2835 $S0 = concat name, $S0 2836 alabel = self.'post_new'('Label', 'result'=>$S0) 2837 $S0 = concat name, 'end' 2838 endlabel = self.'post_new'('Label', 'result'=>$S0) 2839 2840 iter_loop: 2841 ops.'push'(alabel) 2842 .local pmc apast, apost 2843 apast = shift iter 2844 apost = self.'post_regex'(apast, cur) 2845 unless iter goto iter_done 2846 inc acount 2847 $S0 = acount 2848 $S0 = concat name, $S0 2849 alabel = self.'post_new'('Label', 'result'=>$S0) 2850 ops.'push_pirop'('set_addr', '$I10', alabel) 2851 self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10') 2852 ops.'push'(apost) 2853 ops.'push_pirop'('goto', endlabel) 2854 goto iter_loop 2855 iter_done: 2856 ops.'push'(apost) 2857 ops.'push'(endlabel) 2858 done: 2859 .return (ops) 2860.end 2861 2862 2863=item alt_longest(PAST::Regex node) 2864 2865Same as 'alt' above, but use declarative/LTM semantics. 2866(Currently we cheat and just use 'alt' above.) 2867 2868=cut 2869 2870.sub 'alt_longest' :method 2871 .param pmc node 2872 .tailcall self.'alt'(node) 2873.end 2874 2875 2876=item anchor(PAST::Regex node) 2877 2878Match various anchor points, including ^, ^^, $, $$. 2879 2880=cut 2881 2882.sub 'anchor' :method :multi(_, ['PAST';'Regex']) 2883 .param pmc node 2884 2885 .local pmc cur, tgt, pos, off, eos, fail, ops 2886 (cur, tgt, pos, off, eos, fail) = self.'!rxregs'('cur tgt pos off eos fail') 2887 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 2888 2889 .local string subtype 2890 subtype = node.'subtype'() 2891 2892 ops.'push_pirop'('inline', subtype, 'inline'=>' # rxanchor %0') 2893 2894 if subtype == 'null' goto done 2895 if subtype == 'fail' goto anchor_fail 2896 if subtype == 'bos' goto anchor_bos 2897 if subtype == 'eos' goto anchor_eos 2898 if subtype == 'lwb' goto anchor_lwb 2899 if subtype == 'rwb' goto anchor_rwb 2900 2901 .local pmc donelabel 2902 $S0 = self.'unique'('rxanchor') 2903 $S0 = concat $S0, '_done' 2904 donelabel = self.'post_new'('Label', 'result'=>$S0) 2905 2906 if subtype == 'bol' goto anchor_bol 2907 if subtype == 'eol' goto anchor_eol 2908 2909 self.'panic'('Unrecognized subtype "', subtype, '" in PAST::Regex anchor node') 2910 2911 anchor_fail: 2912 ops.'push_pirop'('goto', fail) 2913 goto done 2914 2915 anchor_bos: 2916 ops.'push_pirop'('ne', pos, 0, fail) 2917 goto done 2918 2919 anchor_eos: 2920 ops.'push_pirop'('ne', pos, eos, fail) 2921 goto done 2922 2923 anchor_bol: 2924 ops.'push_pirop'('eq', pos, 0, donelabel) 2925 ops.'push_pirop'('ge', pos, eos, fail) 2926 ops.'push_pirop'('sub', '$I10', pos, off) 2927 ops.'push_pirop'('dec', '$I10') 2928 ops.'push_pirop'('is_cclass', '$I11', .CCLASS_NEWLINE, tgt, '$I10') 2929 ops.'push_pirop'('unless', '$I11', fail) 2930 ops.'push'(donelabel) 2931 goto done 2932 2933 anchor_eol: 2934 ops.'push_pirop'('sub', '$I10', pos, off) 2935 ops.'push_pirop'('is_cclass', '$I11', .CCLASS_NEWLINE, tgt, '$I10') 2936 ops.'push_pirop'('if', '$I11', donelabel) 2937 ops.'push_pirop'('ne', pos, eos, fail) 2938 ops.'push_pirop'('eq', pos, 0, donelabel) 2939 ops.'push_pirop'('dec', '$I10') 2940 ops.'push_pirop'('is_cclass', '$I11', .CCLASS_NEWLINE, tgt, '$I10') 2941 ops.'push_pirop'('if', '$I11', fail) 2942 ops.'push'(donelabel) 2943 goto done 2944 2945 anchor_lwb: 2946 ops.'push_pirop'('ge', pos, eos, fail) 2947 ops.'push_pirop'('sub', '$I10', pos, off) 2948 ops.'push_pirop'('is_cclass', '$I11', .CCLASS_WORD, tgt, '$I10') 2949 ops.'push_pirop'('unless', '$I11', fail) 2950 ops.'push_pirop'('dec', '$I10') 2951 ops.'push_pirop'('is_cclass', '$I11', .CCLASS_WORD, tgt, '$I10') 2952 ops.'push_pirop'('if', '$I11', fail) 2953 goto done 2954 2955 anchor_rwb: 2956 ops.'push_pirop'('le', pos, 0, fail) 2957 ops.'push_pirop'('sub', '$I10', pos, off) 2958 ops.'push_pirop'('is_cclass', '$I11', .CCLASS_WORD, tgt, '$I10') 2959 ops.'push_pirop'('if', '$I11', fail) 2960 ops.'push_pirop'('dec', '$I10') 2961 ops.'push_pirop'('is_cclass', '$I11', .CCLASS_WORD, tgt, '$I10') 2962 ops.'push_pirop'('unless', '$I11', fail) 2963 goto done 2964 2965 done: 2966 .return (ops) 2967.end 2968 2969 2970=item charclass(PAST::Regex node) 2971 2972Match something in a character class, such as \w, \d, \s, dot, etc. 2973 2974=cut 2975 2976.sub 'charclass' :method 2977 .param pmc node 2978 2979 .local string subtype 2980 .local int cclass, negate 2981 (subtype, cclass, negate) = self.'!charclass_init'(node) 2982 2983 .local pmc cur, tgt, pos, off, eos, fail, ops 2984 (cur, tgt, pos, off, eos, fail) = self.'!rxregs'('cur tgt pos off eos fail') 2985 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 2986 2987 ops.'push_pirop'('inline', subtype, 'inline'=>' # rx charclass %0') 2988 ops.'push_pirop'('ge', pos, eos, fail) 2989 if cclass == .CCLASS_ANY goto charclass_done 2990 2991 .local pmc cctest 2992 cctest = self.'??!!'(negate, 'if', 'unless') 2993 2994 ops.'push_pirop'('sub', '$I10', pos, off) 2995 ops.'push_pirop'('is_cclass', '$I11', cclass, tgt, '$I10') 2996 ops.'push_pirop'(cctest, '$I11', fail) 2997 unless subtype == 'nl' goto charclass_done 2998 # handle logical newline here 2999 ops.'push_pirop'('substr', '$S10', tgt, '$I10', 2) 3000 ops.'push_pirop'('iseq', '$I11', '$S10', '"\r\n"') 3001 ops.'push_pirop'('add', pos, '$I11') 3002 3003 charclass_done: 3004 ops.'push_pirop'('inc', pos) 3005 3006 .return (ops) 3007.end 3008 3009 3010=item !charclass_init(PAST::Regex node) 3011 3012Return the subtype, cclass value, and negation for a 3013charclass C<node>. 3014 3015=cut 3016 3017.sub '!charclass_init' :method 3018 .param pmc node 3019 3020 .local string subtype 3021 .local int negate 3022 subtype = node.'subtype'() 3023 $S0 = downcase subtype 3024 negate = isne subtype, $S0 3025 3026 $I0 = node.'negate'() 3027 negate = xor negate, $I0 3028 3029 if $S0 == '.' goto cclass_dot 3030 if $S0 == 'd' goto cclass_digit 3031 if $S0 == 's' goto cclass_space 3032 if $S0 == 'w' goto cclass_word 3033 if $S0 == 'n' goto cclass_newline 3034 if $S0 == 'nl' goto cclass_newline 3035 self.'panic'('Unrecognized subtype "', subtype, '" in PAST::Regex charclass node') 3036 cclass_dot: 3037 .local int cclass 3038 cclass = .CCLASS_ANY 3039 goto cclass_done 3040 cclass_digit: 3041 cclass = .CCLASS_NUMERIC 3042 goto cclass_done 3043 cclass_space: 3044 cclass = .CCLASS_WHITESPACE 3045 goto cclass_done 3046 cclass_word: 3047 cclass = .CCLASS_WORD 3048 goto cclass_done 3049 cclass_newline: 3050 cclass = .CCLASS_NEWLINE 3051 cclass_done: 3052 .return (subtype, cclass, negate) 3053.end 3054 3055 3056=item charclass_q(PAST::Regex node) 3057 3058Optimize certain quantified character class shortcuts, if it 3059makes sense to do so. If not, return a null PMC and the 3060standard quantifier code will handle it. 3061 3062=cut 3063 3064.sub 'charclass_q' :method :multi(_, ['PAST';'Regex']) 3065 .param pmc node 3066 .param string backtrack 3067 .param int min 3068 .param int max 3069 .param pmc sep 3070 3071 if backtrack != 'r' goto pessimistic 3072 if sep goto pessimistic 3073 3074 .local string subtype 3075 .local int cclass, negate 3076 (subtype, cclass, negate) = self.'!charclass_init'(node) 3077 3078 # positive logical newline matching is special, don't try to optimize it 3079 if negate goto nl_done 3080 if subtype == 'nl' goto pessimistic 3081 nl_done: 3082 3083 .local pmc findop 3084 findop = self.'??!!'(negate, 'find_cclass', 'find_not_cclass') 3085 3086 quant_r: 3087 .local pmc cur, tgt, pos, off, eos, fail, ops 3088 (cur, tgt, pos, off, eos, fail) = self.'!rxregs'('cur tgt pos off eos fail') 3089 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3090 3091 ops.'push_pirop'('inline', subtype, backtrack, min, max, 'inline'=>' # rx charclass_q %0 %1 %2..%3') 3092 ops.'push_pirop'('sub', '$I10', pos, off) 3093 ops.'push_pirop'(findop, '$I11', cclass, tgt, '$I10', eos) 3094 unless min > 0 goto min_done 3095 ops.'push_pirop'('add', '$I12', '$I10', min) 3096 ops.'push_pirop'('lt', '$I11', '$I12', fail) 3097 min_done: 3098 unless max > 0 goto max_done 3099 .local pmc maxlabel 3100 maxlabel = self.'post_new'('Label', 'name'=>'rx_charclass_') 3101 ops.'push_pirop'('add', '$I12', '$I10', max) 3102 ops.'push_pirop'('le', '$I11', '$I12', maxlabel) 3103 ops.'push_pirop'('set', '$I11', '$I12') 3104 ops.'push'(maxlabel) 3105 max_done: 3106 ops.'push_pirop'('add', pos, off, '$I11') 3107 .return (ops) 3108 3109 pessimistic: 3110 null ops 3111 .return (ops) 3112.end 3113 3114 3115=item concat(PAST::Regex node) 3116 3117Handle a concatenation of regexes. 3118 3119=cut 3120 3121.sub 'concat' :method :multi(_, ['PAST';'Regex']) 3122 .param pmc node 3123 3124 .local pmc cur, ops, iter 3125 (cur) = self.'!rxregs'('cur') 3126 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3127 iter = node.'iterator'() 3128 3129 iter_loop: 3130 unless iter goto iter_done 3131 .local pmc cpast, cpost 3132 cpast = shift iter 3133 cpost = self.'post_regex'(cpast, cur) 3134 ops.'push'(cpost) 3135 goto iter_loop 3136 iter_done: 3137 3138 .return (ops) 3139.end 3140 3141 3142=item conj(PAST::Regex node) 3143 3144=cut 3145 3146.sub 'conj' :method :multi(_, ['PAST';'Regex']) 3147 .param pmc node 3148 3149 .local pmc cur, pos, fail 3150 (cur, pos, fail) = self.'!rxregs'('cur pos fail') 3151 3152 .local string name 3153 name = self.'unique'('conj') 3154 name = concat name, '_' 3155 3156 .local pmc ops, iter 3157 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3158 iter = node.'iterator'() 3159 unless iter goto done 3160 3161 .local pmc clabel 3162 $S0 = concat name, 'mark' 3163 clabel = self.'post_new'('Label', 'result'=>$S0) 3164 3165 .local int acount 3166 .local pmc alabel, apast, apost 3167 acount = 0 3168 $S0 = acount 3169 $S0 = concat name, $S0 3170 alabel = self.'post_new'('Label', 'result'=>$S0) 3171 3172 ops.'push_pirop'('inline', name, 'inline'=>' # rx %0') 3173 ops.'push_pirop'('set_addr', '$I10', clabel) 3174 self.'!cursorop'(ops, '!mark_push', 0, pos, CURSOR_FAIL, '$I10') 3175 ops.'push_pirop'('goto', alabel) 3176 ops.'push'(clabel) 3177 ops.'push_pirop'('goto', fail) 3178 ops.'push'(alabel) 3179 apast = shift iter 3180 apost = self.'post_regex'(apast, cur) 3181 ops.'push'(apost) 3182 ops.'push_pirop'('set_addr', '$I10', clabel) 3183 self.'!cursorop'(ops, '!mark_peek', 1, '$I11', '$I10') 3184 self.'!cursorop'(ops, '!mark_push', 0, '$I11', pos, '$I10') 3185 3186 iter_loop: 3187 inc acount 3188 $S0 = acount 3189 $S0 = concat name, $S0 3190 alabel = self.'post_new'('Label', 'result'=>$S0) 3191 ops.'push'(alabel) 3192 ops.'push_pirop'('set', pos, '$I11') 3193 apast = shift iter 3194 apost = self.'post_regex'(apast, cur) 3195 ops.'push'(apost) 3196 ops.'push_pirop'('set_addr', '$I10', clabel) 3197 self.'!cursorop'(ops, '!mark_peek', 2, '$I11', '$I12', '$I10') 3198 ops.'push_pirop'('ne', pos, '$I12', fail) 3199 if iter goto iter_loop 3200 iter_done: 3201 done: 3202 .return (ops) 3203.end 3204 3205 3206=item cut(PAST::Regex node) 3207 3208Generate POST for the cut-group and cut-rule operators. 3209 3210=cut 3211 3212.sub 'cut' :method :multi(_, ['PAST';'Regex']) 3213 .param pmc node 3214 3215 .local pmc cur, fail, ops 3216 (cur, fail) = self.'!rxregs'('cur fail') 3217 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3218 ops.'push_pirop'('set_addr', '$I10', fail) 3219 self.'!cursorop'(ops, '!mark_commit', 0, '$I10') 3220 .return (ops) 3221.end 3222 3223 3224=item enumcharlist(PAST::Regex node) 3225 3226Generate POST for matching a character from an enumerated 3227character list. 3228 3229=cut 3230 3231.sub 'enumcharlist' :method :multi(_, ['PAST';'Regex']) 3232 .param pmc node 3233 3234 .local pmc cur, tgt, pos, off, eos, fail, ops 3235 (cur, tgt, pos, off, eos, fail) = self.'!rxregs'('cur tgt pos off eos fail') 3236 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3237 3238 .local string charlist 3239 charlist = node[0] 3240 charlist = self.'escape'(charlist) 3241 .local pmc negate, testop 3242 negate = node.'negate'() 3243 testop = self.'??!!'(negate, 'ge', 'lt') 3244 .local string subtype 3245 .local int zerowidth 3246 subtype = node.'subtype'() 3247 zerowidth = iseq subtype, 'zerowidth' 3248 3249 ops.'push_pirop'('inline', negate, subtype, 'inline'=>' # rx enumcharlist negate=%0 %1') 3250 3251 if zerowidth goto skip_zero_1 3252 ops.'push_pirop'('ge', pos, eos, fail) 3253 skip_zero_1: 3254 ops.'push_pirop'('sub', '$I10', pos, off) 3255 ops.'push_pirop'('substr', '$S10', tgt, '$I10', 1) 3256 ops.'push_pirop'('index', '$I11', charlist, '$S10') 3257 ops.'push_pirop'(testop, '$I11', 0, fail) 3258 if zerowidth goto skip_zero_2 3259 ops.'push_pirop'('inc', pos) 3260 skip_zero_2: 3261 .return (ops) 3262.end 3263 3264.sub 'enumcharlist_q' :method :multi(_, ['PAST';'Regex']) 3265 .param pmc node 3266 .param string backtrack 3267 .param int min 3268 .param int max 3269 .param pmc sep 3270 3271 if backtrack != 'r' goto pessimistic 3272 if sep goto pessimistic 3273 3274 .local pmc cur, tgt, pos, off, eos, fail, rep, ops 3275 (cur, tgt, pos, off, eos, fail, rep) = self.'!rxregs'('cur tgt pos off eos fail rep') 3276 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3277 3278 .local string charlist 3279 charlist = node[0] 3280 charlist = self.'escape'(charlist) 3281 .local pmc negate, testop 3282 negate = node.'negate'() 3283 testop = self.'??!!'(negate, 'ge', 'lt') 3284 .local string subtype 3285 subtype = node.'subtype'() 3286 if subtype == 'zerowidth' goto pessimistic 3287 3288 .local pmc looplabel, donelabel 3289 .local string name 3290 name = self.'unique'('rxenumcharlistq') 3291 $S1 = concat name, '_loop' 3292 looplabel = self.'post_new'('Label', 'result'=>$S1) 3293 $S1 = concat name, '_done' 3294 donelabel = self.'post_new'('Label', 'result'=>$S1) 3295 3296 ops.'push_pirop'('inline', negate, subtype, backtrack, min, max, 'inline'=>' # rx enumcharlist_q negate=%0 %1 %2 %3..%4') 3297 ops.'push_pirop'('sub', '$I10', pos, off) 3298 ops.'push_pirop'('set', rep, 0) 3299 ops.'push_pirop'('sub', '$I12', eos, pos) 3300 unless max > 0 goto max1_done 3301 ops.'push_pirop'('le', '$I12', max, looplabel) 3302 ops.'push_pirop'('set', '$I12', max) 3303 max1_done: 3304 ops.'push'(looplabel) 3305 ops.'push_pirop'('le', '$I12', 0, donelabel) 3306 ops.'push_pirop'('substr', '$S10', tgt, '$I10', 1) 3307 ops.'push_pirop'('index', '$I11', charlist, '$S10') 3308 ops.'push_pirop'(testop, '$I11', 0, donelabel) 3309 ops.'push_pirop'('inc', rep) 3310 if max == 1 goto max2_done 3311 ops.'push_pirop'('inc', '$I10') 3312 ops.'push_pirop'('dec', '$I12') 3313 ops.'push_pirop'('goto', looplabel) 3314 max2_done: 3315 ops.'push'(donelabel) 3316 unless min > 0 goto min2_done 3317 ops.'push_pirop'('lt', rep, min, fail) 3318 min2_done: 3319 ops.'push_pirop'('add', pos, pos, rep) 3320 .return (ops) 3321 3322 pessimistic: 3323 null ops 3324 .return (ops) 3325.end 3326 3327 3328=item literal(PAST::Regex node) 3329 3330Generate POST for matching a literal string provided as the 3331second child of this node. 3332 3333=cut 3334 3335.sub 'literal' :method :multi(_,['PAST';'Regex']) 3336 .param pmc node 3337 3338 .local pmc cur, pos, eos, tgt, fail, off 3339 (cur, pos, eos, tgt, fail, off) = self.'!rxregs'('cur pos eos tgt fail off') 3340 .local pmc ops, lpast, lpost 3341 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3342 3343 .local string subtype 3344 .local int ignorecase 3345 subtype = node.'subtype'() 3346 ignorecase = iseq subtype, 'ignorecase' 3347 3348 # literal to be matched is our first child 3349 .local int litconst 3350 lpast = node[0] 3351 litconst = isa lpast, ['String'] 3352 if litconst goto lpast_string 3353 litconst = isa lpast, ['PAST';'Val'] 3354 if litconst goto lpast_val 3355 lpast_expr: 3356 lpost = self.'as_post'(lpast, 'rtype'=>'~') 3357 unless ignorecase goto lpast_done 3358 $S0 = lpost.'result'() 3359 lpost.'push_pirop'('downcase', $S0, $S0) 3360 goto lpast_done 3361 lpast_val: 3362 $S0 = lpast.'value'() 3363 lpast = box $S0 3364 lpast_string: 3365 unless ignorecase goto lpast_const 3366 $S0 = lpast 3367 $S0 = downcase $S0 3368 lpast = box $S0 3369 lpast_const: 3370 unless lpast > '' goto done 3371 lpost = self.'as_post'(lpast, 'rtype'=>'~') 3372 lpast_done: 3373 3374 $S0 = lpost.'result'() 3375 ops.'push_pirop'('inline', subtype, $S0, 'inline'=>' # rx literal %0 %1') 3376 ops.'push'(lpost) 3377 3378 .local string litlen 3379 if litconst goto litlen_const 3380 litlen = '$I10' 3381 ops.'push_pirop'('length', '$I10', lpost) 3382 goto have_litlen 3383 litlen_const: 3384 $S0 = lpast 3385 $I0 = length $S0 3386 litlen = $I0 3387 have_litlen: 3388 3389 # fail if there aren't enough characters left in string 3390 ops.'push_pirop'('add', '$I11', pos, litlen) 3391 ops.'push_pirop'('gt', '$I11', eos, fail) 3392 3393 # compute string to be matched and fail if mismatch 3394 ops.'push_pirop'('sub', '$I11', pos, off) 3395 if ignorecase goto literal_ignorecase 3396 if litlen == "1" goto literal_1 3397 ops.'push_pirop'('substr', '$S10', tgt, '$I11', litlen) 3398 ops.'push_pirop'('ne', '$S10', lpost, fail) 3399 goto literal_pass 3400 literal_1: 3401 $S0 = lpast 3402 $I0 = ord $S0 3403 ops.'push_pirop'('ord', '$I11', tgt, '$I11') 3404 ops.'push_pirop'('ne', '$I11', $I0, fail) 3405 goto literal_pass 3406 literal_ignorecase: 3407 ops.'push_pirop'('substr', '$S10', tgt, '$I11', litlen) 3408 ops.'push_pirop'('downcase', '$S10', '$S10') 3409 ops.'push_pirop'('ne', '$S10', lpost, fail) 3410 3411 literal_pass: 3412 # increase position by literal length and move on 3413 ops.'push_pirop'('add', pos, litlen) 3414 done: 3415 .return (ops) 3416.end 3417 3418 3419=item 'pastnode'(PAST::Regex node) 3420 3421=cut 3422 3423.sub 'pastnode' :method :multi(_, ['PAST';'Regex']) 3424 .param pmc node 3425 .local pmc cur, pos, fail, ops 3426 (cur, pos, fail) = self.'!rxregs'('cur pos fail') 3427 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3428 3429 .local pmc cpast, cpost 3430 cpast = node[0] 3431 cpost = self.'as_post'(cpast, 'rtype'=>'P') 3432 3433 self.'!cursorop'(ops, '!cursor_pos', 0, pos) 3434 ops.'push'(cpost) 3435 3436 .local pmc subtype, negate, testop 3437 subtype = node.'subtype'() 3438 if subtype != 'zerowidth' goto done 3439 negate = node.'negate'() 3440 testop = self.'??!!'(negate, 'if', 'unless') 3441 ops.'push_pirop'(testop, cpost, fail) 3442 done: 3443 .return (ops) 3444.end 3445 3446 3447=item pass(PAST::Regex node) 3448 3449=cut 3450 3451.sub 'pass' :method :multi(_,['PAST';'Regex']) 3452 .param pmc node 3453 3454 .local pmc cur, pos, ops 3455 (cur, pos) = self.'!rxregs'('cur pos') 3456 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3457 3458 .local string regexname 3459 $P0 = find_dynamic_lex '$*REGEXNAME' 3460 regexname = self.'escape'($P0) 3461 3462 ops.'push_pirop'('inline', 'inline'=>' # rx pass') 3463 self.'!cursorop'(ops, '!cursor_pass', 0, pos, regexname) 3464 self.'!cursorop'(ops, '!cursor_debug', 0, '"PASS"', regexname, '" at pos="', pos) 3465 3466 .local string backtrack 3467 backtrack = node.'backtrack'() 3468 if backtrack == 'r' goto backtrack_done 3469 self.'!cursorop'(ops, '!cursor_backtrack', 0) 3470 backtrack_done: 3471 3472 ops.'push_pirop'('return', cur) 3473 .return (ops) 3474.end 3475 3476 3477=item reduce 3478 3479=cut 3480 3481.sub 'reduce' :method :multi(_,['PAST';'Regex']) 3482 .param pmc node 3483 3484 .local pmc cur, pos, ops 3485 (cur, pos) = self.'!rxregs'('cur pos') 3486 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3487 3488 .local pmc cpost, posargs, namedargs 3489 (cpost, posargs, namedargs) = self.'post_children'(node, 'signature'=>'v:') 3490 3491 .local string regexname, key 3492 $P0 = find_dynamic_lex '$*REGEXNAME' 3493 regexname = self.'escape'($P0) 3494 key = posargs[0] 3495 3496 ops.'push_pirop'('inline', regexname, key, 'inline'=>' # rx reduce name=%0 key=%1') 3497 ops.'push'(cpost) 3498 self.'!cursorop'(ops, '!cursor_pos', 0, pos) 3499 self.'!cursorop'(ops, '!reduce', 0, regexname, posargs :flat, namedargs :flat) 3500 .return (ops) 3501.end 3502 3503 3504=item quant(PAST::Regex node) 3505 3506=cut 3507 3508.sub 'quant' :method :multi(_,['PAST';'Regex']) 3509 .param pmc node 3510 3511 .local string backtrack 3512 backtrack = node.'backtrack'() 3513 if backtrack goto have_backtrack 3514 backtrack = 'g' 3515 have_backtrack: 3516 3517 .local pmc sep 3518 .local int min, max 3519 sep = node.'sep'() 3520 min = node.'min'() 3521 $P0 = node.'max'() 3522 max = $P0 3523 $I0 = defined $P0 3524 if $I0 goto have_max 3525 max = -1 # -1 represents Inf 3526 have_max: 3527 3528 optimize: 3529 $I0 = node.'list'() 3530 if $I0 != 1 goto optimize_done 3531 .local pmc cpast 3532 cpast = node[0] 3533 $S0 = cpast.'pasttype'() 3534 $S0 = concat $S0, '_q' 3535 $I0 = can self, $S0 3536 unless $I0 goto optimize_done 3537 $P0 = self.$S0(cpast, backtrack, min, max, sep) 3538 if null $P0 goto optimize_done 3539 .return ($P0) 3540 optimize_done: 3541 3542 .local pmc cur, pos, rep, fail 3543 (cur, pos, rep, fail) = self.'!rxregs'('cur pos rep fail') 3544 3545 .local string qname, btreg 3546 .local pmc ops, q1label, q2label, cpost 3547 $S0 = concat 'rxquant', backtrack 3548 qname = self.'unique'($S0) 3549 ops = self.'post_new'('Ops', 'node'=>node) 3550 $S0 = concat qname, '_loop' 3551 q1label = self.'post_new'('Label', 'result'=>$S0) 3552 $S0 = concat qname, '_done' 3553 q2label = self.'post_new'('Label', 'result'=>$S0) 3554 cpost = self.'concat'(node) 3555 3556 .local pmc seppast, seppost 3557 null seppost 3558 seppast = node.'sep'() 3559 unless seppast goto have_seppost 3560 seppost = self.'post_regex'(seppast) 3561 have_seppost: 3562 3563 $S0 = max 3564 .local int needrep 3565 $I0 = isgt min, 1 3566 $I1 = isgt max, 1 3567 needrep = or $I0, $I1 3568 3569 unless max < 0 goto have_s0 3570 $S0 = '*' 3571 have_s0: 3572 ops.'push_pirop'('inline', qname, min, $S0, 'inline'=>' # rx %0 ** %1..%2') 3573 3574 if backtrack == 'f' goto frugal 3575 3576 greedy: 3577 btreg = '$I10' 3578 .local int needmark 3579 .local string peekcut 3580 needmark = needrep 3581 peekcut = '!mark_peek' 3582 if backtrack != 'r' goto greedy_1 3583 needmark = 1 3584 peekcut = '!mark_commit' 3585 greedy_1: 3586 if min == 0 goto greedy_2 3587 unless needmark goto greedy_loop 3588 ops.'push_pirop'('set_addr', btreg, q2label) 3589 self.'!cursorop'(ops, '!mark_push', 0, 0, CURSOR_FAIL, btreg) 3590 goto greedy_loop 3591 greedy_2: 3592 ops.'push_pirop'('set_addr', btreg, q2label) 3593 self.'!cursorop'(ops, '!mark_push', 0, 0, pos, btreg) 3594 greedy_loop: 3595 ops.'push'(q1label) 3596 ops.'push'(cpost) 3597 unless needmark goto greedy_3 3598 ops.'push_pirop'('set_addr', btreg, q2label) 3599 self.'!cursorop'(ops, peekcut, 1, rep, btreg) 3600 unless needrep goto greedy_3 3601 ops.'push_pirop'('inc', rep) 3602 greedy_3: 3603 unless max > 1 goto greedy_4 3604 ops.'push_pirop'('ge', rep, max, q2label) 3605 greedy_4: 3606 unless max != 1 goto greedy_5 3607 ops.'push_pirop'('set_addr', btreg, q2label) 3608 self.'!cursorop'(ops, '!mark_push', 0, rep, pos, btreg) 3609 if null seppost goto greedy_4a 3610 ops.'push'(seppost) 3611 greedy_4a: 3612 ops.'push_pirop'('goto', q1label) 3613 greedy_5: 3614 ops.'push'(q2label) 3615 unless min > 1 goto greedy_6 3616 ops.'push_pirop'('lt', rep, min, fail) 3617 greedy_6: 3618 .return (ops) 3619 3620 frugal: 3621 .local pmc ireg 3622 ireg = self.'uniquereg'('I') 3623 if min == 0 goto frugal_1 3624 unless needrep goto frugal_0 3625 ops.'push_pirop'('set', rep, 0) 3626 frugal_0: 3627 if null seppost goto frugal_2 3628 .local pmc seplabel 3629 $S0 = concat qname, '_sep' 3630 seplabel = self.'post_new'('Label', 'result'=>$S0) 3631 ops.'push_pirop'('goto', seplabel) 3632 goto frugal_2 3633 frugal_1: 3634 ops.'push_pirop'('set_addr', '$I10', q1label) 3635 self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10') 3636 ops.'push_pirop'('goto', q2label) 3637 frugal_2: 3638 ops.'push'(q1label) 3639 if null seppost goto frugal_2a 3640 ops.'push'(seppost) 3641 ops.'push'(seplabel) 3642 frugal_2a: 3643 unless needrep goto frugal_3 3644 ops.'push_pirop'('set', ireg, rep) 3645 unless max > 1 goto frugal_3 3646 ops.'push_pirop'('ge', rep, max, fail) 3647 frugal_3: 3648 ops.'push'(cpost) 3649 unless needrep goto frugal_4 3650 ops.'push_pirop'('add', rep, ireg, 1) 3651 frugal_4: 3652 unless min > 1 goto frugal_5 3653 ops.'push_pirop'('lt', rep, min, q1label) 3654 frugal_5: 3655 frugal_6: 3656 unless max != 1 goto frugal_7 3657 ops.'push_pirop'('set_addr', '$I10', q1label) 3658 self.'!cursorop'(ops, '!mark_push', 0, rep, pos, '$I10') 3659 frugal_7: 3660 ops.'push'(q2label) 3661 .return (ops) 3662.end 3663 3664 3665=item scan(POST::Regex) 3666 3667Code for initial regex scan. 3668 3669=cut 3670 3671.sub 'scan' :method :multi(_, ['PAST';'Regex']) 3672 .param pmc node 3673 3674 .local pmc cur, pos, eos, ops 3675 (cur, pos, eos) = self.'!rxregs'('cur pos eos') 3676 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3677 .local pmc looplabel, scanlabel, donelabel 3678 $S0 = self.'unique'('rxscan') 3679 $S1 = concat $S0, '_loop' 3680 looplabel = self.'post_new'('Label', 'result'=>$S1) 3681 $S1 = concat $S0, '_scan' 3682 scanlabel = self.'post_new'('Label', 'result'=>$S1) 3683 $S1 = concat $S0, '_done' 3684 donelabel = self.'post_new'('Label', 'result'=>$S1) 3685 3686 ops.'push_pirop'('callmethod', "'from'", 'self', 'result'=>'$I10') 3687 ops.'push_pirop'('ne', '$I10', CURSOR_FAIL, donelabel) 3688 ops.'push_pirop'('goto', scanlabel) 3689 ops.'push'(looplabel) 3690 self.'!cursorop'(ops, 'from', 1, '$P10') 3691 ops.'push_pirop'('inc', '$P10') 3692 ops.'push_pirop'('set', pos, '$P10') 3693 ops.'push_pirop'('ge', pos, eos, donelabel) 3694 ops.'push'(scanlabel) 3695 ops.'push_pirop'('set_addr', '$I10', looplabel) 3696 self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10') 3697 ops.'push'(donelabel) 3698 .return (ops) 3699.end 3700 3701 3702=item subcapture(PAST::Regex node) 3703 3704Perform a subcapture (capture of a portion of a regex). 3705 3706=cut 3707 3708.sub 'subcapture' :method :multi(_, ['PAST';'Regex']) 3709 .param pmc node 3710 3711 .local pmc cur, pos, tgt, fail 3712 (cur, pos, tgt, fail) = self.'!rxregs'('cur pos tgt fail') 3713 .local pmc ops, cpast, cpost 3714 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3715 cpast = node[0] 3716 cpost = self.'post_regex'(cpast) 3717 3718 .local pmc name 3719 $P0 = node.'name'() 3720 name = self.'as_post'($P0, 'rtype'=>'*') 3721 3722 .local string rxname 3723 rxname = self.'unique'('rxcap_') 3724 3725 .local pmc caplabel, donelabel 3726 $S0 = concat rxname, '_fail' 3727 caplabel = self.'post_new'('Label', 'result'=>$S0) 3728 $S0 = concat rxname, '_done' 3729 donelabel = self.'post_new'('Label', 'result'=>$S0) 3730 3731 ops.'push_pirop'('inline', name, 'inline'=>' # rx subcapture %0') 3732 ops.'push_pirop'('set_addr', '$I10', caplabel) 3733 self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10') 3734 ops.'push'(cpost) 3735 ops.'push_pirop'('set_addr', '$I10', caplabel) 3736 self.'!cursorop'(ops, '!mark_peek', 2, '$I12', '$I11', '$I10') 3737 self.'!cursorop'(ops, '!cursor_pos', 0, '$I11') 3738 self.'!cursorop'(ops, '!cursor_start', 1, '$P10') 3739 ops.'push_pirop'('callmethod', '"!cursor_pass"', '$P10', pos, '""') 3740 ops.'push'(name) 3741 self.'!cursorop'(ops, '!mark_push', 0, 0, CURSOR_FAIL, 0, '$P10') 3742 ops.'push_pirop'('callmethod', '"!cursor_names"', '$P10', name) 3743 ops.'push_pirop'('goto', donelabel) 3744 ops.'push'(caplabel) 3745 ops.'push_pirop'('goto', fail) 3746 ops.'push'(donelabel) 3747 .return (ops) 3748.end 3749 3750 3751=item subrule(PAST::Regex node) 3752 3753Perform a subrule call. 3754 3755=cut 3756 3757.sub 'subrule' :method :multi(_, ['PAST';'Regex']) 3758 .param pmc node 3759 3760 .local pmc cur, pos, fail, ops 3761 (cur, pos, fail) = self.'!rxregs'('cur pos fail') 3762 ops = self.'post_new'('Ops', 'node'=>node, 'result'=>cur) 3763 3764 .local pmc name 3765 $P0 = node.'name'() 3766 name = self.'as_post'($P0, 'rtype'=>'*') 3767 3768 .local pmc cpost, posargs, namedargs, subpost 3769 (cpost, posargs, namedargs) = self.'post_children'(node, 'signature'=>'v:') 3770 subpost = shift posargs 3771 3772 .local pmc negate 3773 .local string testop 3774 negate = node.'negate'() 3775 testop = self.'??!!'(negate, 'if', 'unless') 3776 3777 .local pmc subtype, backtrack 3778 subtype = node.'subtype'() 3779 backtrack = node.'backtrack'() 3780 3781 ops.'push_pirop'('inline', subpost, subtype, negate, 'inline'=>" # rx subrule %0 subtype=%1 negate=%2") 3782 3783 self.'!cursorop'(ops, '!cursor_pos', 0, pos) 3784 ops.'push'(cpost) 3785 ops.'push_pirop'('callmethod', subpost, cur, posargs :flat, namedargs :flat, 'result'=>'$P10') 3786 ops.'push_pirop'(testop, '$P10', fail) 3787 if subtype == 'zerowidth' goto done 3788 if backtrack != 'r' goto subrule_backtrack 3789 if subtype == 'method' goto subrule_pos 3790 self.'!cursorop'(ops, '!mark_push', 0, 0, CURSOR_FAIL, 0, '$P10') 3791 goto subrule_named 3792 subrule_backtrack: 3793 .local string rxname 3794 .local pmc backlabel, passlabel 3795 rxname = self.'unique'('rxsubrule') 3796 $S0 = concat rxname, '_back' 3797 backlabel = self.'post_new'('Label', 'result'=>$S0) 3798 $S0 = concat rxname, '_pass' 3799 passlabel = self.'post_new'('Label', 'result'=>$S0) 3800 ops.'push_pirop'('goto', passlabel) 3801 ops.'push'(backlabel) 3802 ops.'push_pirop'('callmethod', '"!cursor_next"', '$P10', 'result'=>'$P10') 3803 ops.'push_pirop'(testop, '$P10', fail) 3804 ops.'push'(passlabel) 3805 ops.'push_pirop'('set_addr', '$I10', backlabel) 3806 self.'!cursorop'(ops, '!mark_push', 0, 0, pos, '$I10', '$P10') 3807 if subtype == 'method' goto subrule_pos 3808 subrule_named: 3809 ops.'push'(name) 3810 ops.'push_pirop'('callmethod', '"!cursor_names"', '$P10', name) 3811 subrule_pos: 3812 ops.'push_pirop'('callmethod', '"pos"', '$P10', 'result'=>pos) 3813 done: 3814 .return (ops) 3815.end 3816 3817 3818=item post_new(type, args :slurpy, options :slurpy :named) 3819 3820Helper method to create a new POST node of C<type>. 3821 3822=cut 3823 3824.sub 'post_new' :method 3825 .param string type 3826 .param pmc args :slurpy 3827 .param pmc options :slurpy :named 3828 3829 $P0 = get_hll_global ['POST'], type 3830 .tailcall $P0.'new'(args :flat, options :flat :named) 3831.end 3832 3833=item ??!!(test, trueval, falseval) 3834 3835Helper method to perform ternary operation -- returns C<trueval> 3836if C<test> is true, C<falseval> otherwise. 3837 3838=cut 3839 3840.sub '??!!' :method 3841 .param pmc test 3842 .param pmc trueval 3843 .param pmc falseval 3844 3845 if test goto true 3846 .return (falseval) 3847 true: 3848 .return (trueval) 3849.end 3850 3851 3852=back 3853 3854=head1 AUTHOR 3855 3856Patrick Michaud <pmichaud@pobox.com> is the author and maintainer. 3857 3858=head1 COPYRIGHT 3859 3860Copyright (C) 2009, The Perl Foundation. 3861 3862=cut 3863 3864# Local Variables: 3865# mode: pir 3866# fill-column: 100 3867# End: 3868# vim: expandtab shiftwidth=4 ft=pir: 3869 3870 3871=head1 AUTHOR 3872 3873Patrick Michaud <pmichaud@pobox.com> is the author and maintainer. 3874 3875=head1 COPYRIGHT 3876 3877Copyright (C) 2009, The Perl Foundation. 3878 3879=cut 3880 3881# Local Variables: 3882# mode: pir 3883# fill-column: 100 3884# End: 3885# vim: expandtab shiftwidth=4 ft=pir: 3886