Changeset 21901 for src/perl6

Show
Ignore:
Timestamp:
08/15/08 18:39:27 (3 months ago)
Author:
lwall
Message:

[STD] various changes in preparation for inlining p5 regex optimizations

Location:
src/perl6
Files:
5 modified

Legend:

Unmodified
Added
Removed

  • src/perl6/Cursor.pmc

    r21852 r21901  
    14401440    my $buf = $self->{_orig}; 
    14411441    pos($$buf) = $P; 
    1442     if ($$buf =~ $qr) { 
     1442    if ($$buf =~ /$qr/gc) { 
    14431443        my $len = $+[0] - $P; 
    14441444        $self->deb("PATTERN $qr matched @{[substr($$buf,$P,$len)]} at $P $len") if $DEBUG & DEBUG::matchers; 

  • src/perl6/STD.pm

    r21852 r21901  
    1010 
    1111# random rule for debugging, please ignore 
    12 regex foo { 
     12token foo { 
    1313   'foo' 'bar' 'baz' 
    1414} 
    … …  
    154154constant %loose_and       = (:prec<d=>, :assoc<left>,  :assign); 
    155155constant %loose_or        = (:prec<c=>, :assoc<left>,  :assign); 
     156constant %feed_infix      = (:prec<b=>, :assoc<left>); 
    156157constant %LOOSEST         = (:prec<a=!>); 
    157158constant %terminator      = (:prec<a=>, :assoc<list>); 
    … …  
    257258    our %o = %loose_or; 
    258259} # end class 
     260class Feed_infix does PrecOp { 
     261    our %o = %feed_infix; 
     262} # end class 
    259263class Terminator does PrecOp { 
    260264    our %o = %terminator; 
    … …  
    419423token vws { 
    420424    \v :: 
    421     { $COMPILING::LINE++ } # XXX wrong several ways 
     425    { $COMPILING::LINE++ } # XXX wrong several ways, use self.lineof($¢.pos) 
    422426    [ '#DEBUG -1' { say "DEBUG"; $STD::DEBUG = $*DEBUG = -1; } ]? 
    423427} 
    … …  
    441445} 
    442446 
    443 token identish { 
     447token identifier { 
    444448    <.alpha> \w* 
    445449} 
    446450 
     451token apostrophe { 
     452    <[ ' \- ]> 
     453} 
     454 
    447455token ident { 
    448     <.identish> [<[ ' \- ]><identish>]* 
     456    <.identifier> [ <.apostrophe> <.identifier> ]* 
    449457} 
    450458 
    … …  
    454462    ^^ '=' <.unsp>? 
    455463    [ 
    456     | 'begin' \h+ <ident> :: .*? \n 
    457       '=' <.unsp>? 'end' \h+ $<ident> » \N*         {*}         #= tagged 
    458     | 'begin' » :: \h* \n .*? \n 
    459       '=' <.unsp>? 'end' » \N*                      {*}         #= anon 
     464    | 'begin' \h+ <ident> :: .*? 
     465      "\n=" <.unsp>? 'end' \h+ $<ident> » \N*         {*}         #= tagged 
     466    | 'begin' » :: \h* \n .*? 
     467      "\n=" <.unsp>? 'end' » \N*                      {*}         #= anon 
    460468    | ::  
    461469        [ <?before .*? ^^ '=cut' » > <.panic: "Obsolete pod format, please use =begin/=end instead"> ]? 
    … …  
    540548    :my $PARSER is context<rw> = self; 
    541549    [ 
     550    | $ 
    542551    | <?before <[\)\]\}]> > 
    543552    | [<statement><.eat_terminator> ]* 
    … …  
    570579    :my $endargs is context = -1; 
    571580    <!before <[\)\]\}]> > 
     581 
     582    # this could either be a statement that follows a declaration 
     583    # or a statement that is within the block of a code declaration 
    572584    <!!{ bless $¢, ref $PARSER; }> 
     585 
    573586    [ 
    574587    | <label> <statement>                        {*}            #= label 
    … …  
    29953008token infix:sym<.=> ( --> Item_assignment) { 
    29963009    <sym> <.ws> 
    2997     [ <?before \w+';' | < new sort subst trans > > || <worryobs('.= as append operator', '~=')> ] 
     3010    [ <?before \w+';' | 'new' | 'sort' | 'subst' | 'trans' > || <worryobs('.= as append operator', '~=')> ] 
    29983011    { $<O><nextterm> = 'dottyop' } 
    29993012} 
    … …  
    30973110    # unrecognized names are assumed to be post-declared listops. 
    30983111    || <args>? 
    3099 #    || <?before \s> <arglist> 
    3100 #        {*}                                                     #= listop args 
    3101 #    || 
    3102 #        [ 
    3103 #        | '.(' <in: ')', 'semilist', 'argument list'> 
    3104 #            {*}                                                 #= func args 
    3105 # 
    3106 #        | '(' <in: ')', 'semilist', 'argument list'> 
    3107 #            {*}                                                 #= func args 
    3108 # 
    3109 #        | <.unsp> '.'? '(' <in: ')', 'semilist', 'argument list'> 
    3110 #            {*}                                                 #= func args 
    3111 # 
    3112 # 
    3113 #        | ::  {*}                                               #= listop noarg 
    3114 #        ] 
    3115 # 
    3116 #        [ 
    3117 #        || ':' <?before \s> <arglist>    # either switch to listopiness 
    3118 #        || {{ $+prevop = $<O> = {}; }}   # or allow adverbs 
    3119 #        ] 
    31203112    ] 
    31213113} 
    … …  
    31443136     { <sym> } 
    31453137 
     3138token infix:sym« <== » ( --> Feed_infix) 
     3139    { <sym> } 
     3140 
     3141token infix:sym« ==> » ( --> Feed_infix) 
     3142    { <sym> {*} }              #' 
     3143 
     3144token infix:sym« <<== » ( --> Feed_infix) 
     3145    { <sym> } 
     3146 
     3147token infix:sym« ==>> » ( --> Feed_infix) 
     3148    { <sym> {*} }              #' 
     3149 
    31463150## expression terminator 
    31473151 
    … …  
    31693173token terminator:sym<when> ( --> Terminator) 
    31703174    { <?before 'when' » > } 
    3171  
    3172 token terminator:sym« <== » ( --> Terminator) 
    3173     { <?before '<==' > } 
    3174  
    3175 token terminator:sym« ==> » ( --> Terminator) 
    3176     { <?before '==>' > {*} }              #' 
    31773175 
    31783176token terminator:sym« --> » ( --> Terminator) 
    … …  
    37253723    token mod_internal:sym<:a( )> { $<sym>=[':a'|':ignoreaccent'] <mod_arg> { $+ignoreaccent = $<mod_arg>.eval } } 
    37263724 
    3727     token mod_internal:sym<:s>    { <sym> 'igspace'? » { $+sigspace = 1 } } 
    3728     token mod_internal:sym<:!s>   { <sym> 'igspace'? » { $+sigspace = 0 } } 
    3729     token mod_internal:sym<:s( )> { <sym> 'igspace'? <mod_arg> { $+sigspace = $<mod_arg>.eval } } 
    3730  
    3731     token mod_internal:sym<:r>    { <sym> 'atchet'? » { $+ratchet = 1 } } 
    3732     token mod_internal:sym<:!r>   { <sym> 'atchet'? » { $+ratchet = 0 } } 
    3733     token mod_internal:sym<:r( )> { <sym> 'atchet'? » <mod_arg> { $+ratchet = $<mod_arg>.eval } } 
     3725    token mod_internal:sym<:s>    { ':s' 'igspace'? » { $+sigspace = 1 } } 
     3726    token mod_internal:sym<:!s>   { ':s' 'igspace'? » { $+sigspace = 0 } } 
     3727    token mod_internal:sym<:s( )> { ':s' 'igspace'? <mod_arg> { $+sigspace = $<mod_arg>.eval } } 
     3728 
     3729    token mod_internal:sym<:r>    { ':r' 'atchet'? » { $+ratchet = 1 } } 
     3730    token mod_internal:sym<:!r>   { ':r' 'atchet'? » { $+ratchet = 0 } } 
     3731    token mod_internal:sym<:r( )> { ':r' 'atchet'? » <mod_arg> { $+ratchet = $<mod_arg>.eval } } 
    37343732 
    37353733    token mod_internal:adv { 

  • src/perl6/gimme5

    r21819 r21901  
    55use warnings; 
    66use Text::Balanced qw(extract_bracketed); 
     7binmode(STDIN, ":utf8"); 
     8binmode(STDOUT, ":utf8"); 
     9binmode(STDERR, ":utf8"); 
     10use Encode; 
     11use utf8; 
    712 
    813my $failover = 0; 
    … …  
    201206 
    202207{ 
    203     local $/; 
    204     $_ = <>; 
     208    open(IN, $ARGV[0]) or die "Can't open $ARGV[0]: $!\n"; 
     209    { 
     210        local $/; 
     211        binmode(IN, ':utf8'); 
     212        $_ = <IN>; 
     213    } 
     214    close IN; 
    205215    push @impure, m/^method (\w+)/mg; 
    206216    @impure{@impure} = (1) x @impure; 
    … …  
    448458            my $p = ""; 
    449459 
    450             local $MAYBACKTRACK = 1;  # XXX ratchet current broken 
    451             if ($KIND eq 'regex') { 
    452                 $MAYBACKTRACK = 1; 
     460            local $MAYBACKTRACK = 1; 
     461            if ($KIND eq 'token' or $KIND eq 'rule') { 
     462                $MAYBACKTRACK = 0; 
    453463            } 
    454464 
    … …  
    880890our %INSTANTIATED; 
    881891require 'mangle.pl'; 
     892use utf8; 
    882893 
    883894END 
    … …  
    889900    if (%$RETREE) { 
    890901        $out .= "BEGIN {\n    \$retree = YAML::XS::Load(<<'RETREE_END');\n"; 
    891         $out .= Dump($RETREE); 
     902        $out .= Encode::decode("utf8", Dump($RETREE)); 
    892903        $out .= "RETREE_END\n}\n"; 
    893904    } 
    … …  
    905916    return if $KIND eq 'rule';  # meta whitespace parsed in atom 
    906917    for (;;) { 
    907         next if s/^\s+//; 
    908         next if s/^#\(.*?\)//s; 
    909         next if s/^#\{.*?\}//s; 
    910         next if s/^#\[.*?\]//s; 
    911         next if s/^#\<.*?\>//s; 
    912         next if s/^#.*\n//; 
     918#       next if s/^(?!=[\0-~])\s+//; 
     919        next if s/^[\x20\t\n\r]+//; 
     920        last unless s/^#//; 
     921        next if s/^\(.*?\)//s; 
     922        next if s/^\{.*?\}//s; 
     923        next if s/^\[.*?\]//s; 
     924        next if s/^\<.*?\>//s; 
     925        next if s/^.*\n//; 
    913926        last; 
    914927    } 
    … …  
    16511664        $text =~ s/^-\[/[^/; 
    16521665        if ($$self{i}) { 
    1653             $self->bind("\$C->_CCLASS$REV(qr/^(?i)$text\$/)"); 
     1666            $self->bind("\$C->_PATTERN$REV(qr/\\G(?i:$text)/)"); 
    16541667        } 
    16551668        else { 
    1656             $self->bind("\$C->_CCLASS$REV(qr/^$text\$/)"); 
     1669            $self->bind("\$C->_PATTERN$REV(qr/\\G$text/)"); 
    16571670        } 
    16581671    } 
    … …  
    16731686        my $self = shift; 
    16741687        my $text = $$self{text}; 
     1688        $text = "(?<=$text)" if $REV; 
    16751689        if ($$self{i}) { 
    1676             $self->bind('$C->_PATTERN' . $REV . '(qr/(?i)\\Q' . $text . '\\E/")'); 
     1690            $self->bind('$C->_PATTERN(qr/\\G(?i:' . $text . ')/")'); 
    16771691        } 
    16781692        else { 
    1679             $self->bind('$C->_EXACT' . $REV . '("' . $text . '")'); 
     1693            $self->bind('$C->_PATTERN(qr/\\G' . $text . '/)'); 
    16801694        } 
    16811695    } 
    … …  
    16851699    sub walk { 
    16861700        my $self = shift; 
    1687         my $text = $$self{text}; 
    1688         $text =~ s/(['\\])/\\$1/g; 
     1701        my $text = quotemeta($$self{text}); 
     1702        $text = "(?<=$text)" if $REV; 
    16891703        if ($$self{i}) { 
    1690             '$C->_PATTERN' . $REV . '(qr/(?i)\\Q' . $text . '\\E/")'; 
     1704            '$C->_PATTERN(qr/\\G(?i:' . $text . ')/)'; 
    16911705        } 
    16921706        else { 
    1693             "\$C->_EXACT$REV('" . $text . "')"; 
     1707            "\$C->_PATTERN(qr/\\G$text/)"; 
     1708#           my $l = length($text); 
     1709#           "(substr(\$\$buf, \$C->{_pos}, $l) eq '" . $text .  "' ? \$C->cursor(\$C->{_pos} + $l) : ())" 
    16941710        } 
    16951711    } 
    … …  
    17071723        } 
    17081724        if ($text eq '.') { 
    1709             $code = "\$C->_ANY$REV()"; 
     1725            if ($REV) { 
     1726                $code = "\$C->_PATTERN(qr/\\G(?<=(?s:.))/)"; 
     1727            } 
     1728            else { 
     1729                $code = "\$C->_PATTERN(qr/\\G(?s:.)/)"; 
     1730            } 
     1731#            $code = "\$C->_ANY$REV()"; 
    17101732        } 
    17111733        elsif ($text eq '.*') { 
     1734#           if ($REV) { 
     1735#               $code = "\$C->_PATTERN(qr/\\G(?<=.*)/)"; 
     1736#           } 
     1737#           else { 
     1738#               $code = "\$C->_PATTERN(qr/\\G.*/)"; 
     1739#           } 
    17121740            $code = "\$C->_SCANg$REV()"; 
    17131741        } 
    17141742        elsif ($text eq '.*?') { 
     1743#           if ($REV) { 
     1744#               $code = "\$C->_PATTERN(qr/\\G(?<=.*?)/)"; 
     1745#           } 
     1746#           else { 
     1747#               $code = "\$C->_PATTERN(qr/\\G.*?/)"; 
     1748#           } 
    17151749            $code = "\$C->_SCANf$REV()"; 
    17161750        } 
    17171751        elsif ($text eq '^') { 
    1718             $code = "\$C->_BOS$REV()"; 
     1752            $code = "\$C->_PATTERN(qr/\\G\\A/)"; 
     1753#            $code = "\$C->_BOS$REV()"; 
    17191754        } 
    17201755        elsif ($text eq '^^') { 
    1721             $code = "\$C->_BOL$REV()"; 
     1756            $code = "\$C->_PATTERN(qr/\\G(?m:^)/)"; 
     1757#            $code = "\$C->_BOL$REV()"; 
    17221758        } 
    17231759        elsif ($text eq '$') { 
    1724             $code = "\$C->_EOS$REV()"; 
     1760            $code = "\$C->_PATTERN(qr/\\G\\z/)"; 
     1761#            $code = "\$C->_EOS$REV()"; 
    17251762        } 
    17261763        elsif ($text eq '$$') { 
    1727             $code = "\$C->_EOL$REV()"; 
     1764            $code = "\$C->_PATTERN(qr/\\G(?m:\$)/)"; 
     1765#            $code = "\$C->_EOL$REV()"; 
    17281766        } 
    17291767        elsif ($text eq ':') { 
    … …  
    17331771            $PURE = 0; 
    17341772            $code = "\$C->_COMMITBRANCH$REV()"; 
     1773            $MAYBACKTRACK = 1; 
    17351774        } 
    17361775        elsif ($text eq ':::') { 
    17371776            $PURE = 0; 
    17381777            $code = "\$C->_COMMITRULE$REV()"; 
     1778            $MAYBACKTRACK = 1; 
    17391779        } 
    17401780        elsif ($text eq '\\d') { 
    1741             $code = "\$C->_DIGIT$REV()"; 
     1781            if ($REV) { 
     1782                $code = "\$C->_PATTERN(qr/\\G(?<=\\d)/)"; 
     1783            } 
     1784            else { 
     1785                $code = "\$C->_PATTERN(qr/\\G\\d/)"; 
     1786            } 
     1787#            $code = "\$C->_DIGIT$REV()"; 
    17421788        } 
    17431789        elsif ($text eq '\\w') { 
    1744             $code = "\$C->_ALNUM$REV()"; 
     1790            if ($REV) { 
     1791                $code = "\$C->_PATTERN(qr/\\G(?<=\\w)/)"; 
     1792            } 
     1793            else { 
     1794                $code = "\$C->_PATTERN(qr/\\G\\w/)"; 
     1795            } 
     1796#           $code = "\$C->_ALNUM$REV()"; 
    17451797        } 
    17461798        elsif ($text eq '\\s') { 
    1747             $code = "\$C->_SPACE$REV()"; 
     1799            if ($REV) { 
     1800                $code = "\$C->_PATTERN(qr/\\G(?<=\\s)/)"; 
     1801            } 
     1802            else { 
     1803                $code = "\$C->_PATTERN(qr/\\G\\s/)"; 
     1804            } 
     1805#            $code = "\$C->_SPACE$REV()"; 
    17481806        } 
    17491807        elsif ($text eq '\\h') { 
    1750             $code = "\$C->_HSPACE$REV()"; 
     1808            if ($REV) { 
     1809                $code = "\$C->_PATTERN(qr/\\G(?<=[\\x20\\t\\r])/)"; 
     1810            } 
     1811            else { 
     1812                $code = "\$C->_PATTERN(qr/\\G[\\x20\\t\\r]/)"; 
     1813            } 
     1814#            $code = "\$C->_HSPACE$REV()"; 
    17511815        } 
    17521816        elsif ($text eq '\\v') { 
    1753             $code = "\$C->_VSPACE$REV()"; 
     1817            if ($REV) { 
     1818                $code = "\$C->_PATTERN(qr/\\G(?<=[\\n])/)"; 
     1819            } 
     1820            else { 
     1821                $code = "\$C->_PATTERN(qr/\\G[\\n]/)"; 
     1822            } 
     1823#            $code = "\$C->_VSPACE$REV()"; 
    17541824        } 
    17551825        elsif ($text eq '»') { 
    1756             $code = "\$C->_RIGHTWB$REV()"; 
     1826            $code = "\$C->_PATTERN(qr/\\G\\b/)"; 
     1827#            $code = "\$C->_RIGHTWB$REV()"; 
    17571828        } 
    17581829        elsif ($text eq '«') { 
    1759             $code = "\$C->_LEFTWB$REV()"; 
     1830            $code = "\$C->_PATTERN(qr/\\G\\b/)"; 
     1831#            $code = "\$C->_LEFTWB$REV()"; 
    17601832        } 
    17611833        elsif ($text eq '>>') { 
    … …  
    17971869            $$self{sym} = $SYM; 
    17981870            $$self{endsym} = $ENDSYM if $ENDSYM; 
     1871            if ($$self{i}) { 
     1872                return "\$C->_PATTERN(qr/\\G(?i:" . quotemeta($SYM) . ")/)"; 
     1873            } 
     1874            else { 
     1875                return "\$C->_PATTERN(qr/\\G" . quotemeta($SYM) . "/)"; 
     1876            } 
    17991877            return $re = '$C->_SYM($sym, ' . ($$self{i}//0) . ')';      # could pass endsym too here... 
    18001878        } 
     1879        elsif ($name eq "alpha") { 
     1880            return "\$C->_PATTERN(qr/\\G[_[:alpha:]]/)"; 
     1881        } 
     1882        elsif ($name eq "_ALNUM") { 
     1883            return "\$C->_PATTERN(qr/\\G\\w/)"; 
     1884        } 
     1885#        elsif ($name eq "ws") { 
     1886#            return "\$C->_PATTERN(qr/\\G(?{ \$C = \$C->ws; pos(\$_) = \$C->{_pos} })/)"; 
     1887#        } 
    18011888        elsif ($name eq "nextsame") { 
    18021889            $NEEDORIGARGS++; 
    … …  
    20172104            my $rep = "_REP"; 
    20182105            my $q = $$self{quant}; 
    2019             if ($q) { 
    2020                 my ($qfer,$how,$rest) = @{$$self{quant}}; 
    2021                 my $h = $how eq '!' ? 'g' : 
    2022                         $how eq '?' ? 'f' : 
    2023                                       'r'; 
    2024                 if ($qfer eq '*') { 
    2025                     $PURE = 0; 
    2026                     $quant = "\$C->_STAR$h$REV("; 
    2027                 } 
    2028                 elsif ($qfer eq '+') { 
    2029                     $quant = "\$C->_PLUS$h$REV("; 
    2030                 } 
    2031                 elsif ($qfer eq '?') { 
    2032                     $PURE = 0; 
    2033                     $quant = "\$C->_OPT$h$REV("; 
    2034                 } 
    2035                 elsif ($qfer eq '**') { 
    2036                     if (ref $rest) { 
    2037                         if (ref $rest eq "RE_block") { 
    2038                             $PURE = 0; 
    2039                             $rep = "_REPINDIRECT$REV"; 
    2040                             $rest = $rest->walk(); 
    2041                         } 
    2042                         else { 
    2043                             $rep = "_REPSEP$REV"; 
    2044                             $rest = " sub { my \$C=shift;\n" . ::indent($rest->walk()) . "\n}"; 
    2045                         } 
    2046                     } 
    2047                     else { 
    2048                         $PURE = 0 if $rest =~ /^0/; 
    2049                         $rest = "'$rest'"; 
    2050                     } 
    2051                     $quant = "\$C->$rep$h( $rest, "; 
    2052                 } 
    2053                 $result = $quant . "sub { my \$C=shift;\n" . ::indent($$self{atom}->walk(@_)) . "\n})"; 
    2054             } 
     2106            my $atom = $$self{atom}->walk(@_); 
     2107            if ($q) { 
     2108                if ($atom =~ s{ ^ \$C->_PATTERN\(qr/\\G(.*?)/\) $ }{(?:$1)}sx) { 
     2109                    my ($qfer,$how,$rest) = @{$$self{quant}}; 
     2110                    my $h = $how eq '!' ? '' : 
     2111                            $how eq '?' ? '?' : 
     2112                                          '+'; 
     2113                    if ($qfer eq '**') { 
     2114                        $h = $how eq '!' ? 'g' : 
     2115                             $how eq '?' ? 'f' : 
     2116                                           'r'; 
     2117                        if (ref $rest) { 
     2118                            if (ref $rest eq "RE_block") { 
     2119                                $PURE = 0; 
     2120                                $rep = "_REPINDIRECT$REV"; 
     2121                                $rest = $rest->walk(); 
     2122                            } 
     2123                            else { 
     2124                                $rep = "_REPSEP$REV"; 
     2125                                $rest = " sub { my \$C=shift;\n" . ::indent($rest->walk()) . "\n}"; 
     2126                            } 
     2127                        } 
     2128                        else { 
     2129                            $PURE = 0 if $rest =~ /^0/; 
     2130                            $rest = "'$rest'"; 
     2131                        } 
     2132                        $quant = "\$C->$rep$h( $rest, "; 
     2133                        $result = $quant . "sub { my \$C=shift;\n" . ::indent($atom) . "\n})"; 
     2134                    } 
     2135                    else { 
     2136                        $PURE = 0; 
     2137                        $result = "\$C->_PATTERN\(qr/\\G($atom$qfer$h)/\)"; 
     2138                    } 
     2139                } 
     2140                else { 
     2141                    my ($qfer,$how,$rest) = @{$$self{quant}}; 
     2142                    my $h = $how eq '!' ? 'g' : 
     2143                            $how eq '?' ? 'f' : 
     2144                                          'r'; 
     2145                    if ($qfer eq '*') { 
     2146                        $PURE = 0; 
     2147                        $quant = "\$C->_STAR$h$REV("; 
     2148                    } 
     2149                    elsif ($qfer eq '+') { 
     2150                        $quant = "\$C->_PLUS$h$REV("; 
     2151                    } 
     2152                    elsif ($qfer eq '?') { 
     2153                        $PURE = 0; 
     2154                        $quant = "\$C->_OPT$h$REV("; 
     2155                    } 
     2156                    elsif ($qfer eq '**') { 
     2157                        if (ref $rest) { 
     2158                            if (ref $rest eq "RE_block") { 
     2159                                $PURE = 0; 
     2160                                $rep = "_REPINDIRECT$REV"; 
     2161                                $rest = $rest->walk(); 
     2162                            } 
     2163                            else { 
     2164                                $rep = "_REPSEP$REV"; 
     2165                                $rest = " sub { my \$C=shift;\n" . ::indent($rest->walk()) . "\n}"; 
     2166                            } 
     2167                        } 
     2168                        else { 
     2169                            $PURE = 0 if $rest =~ /^0/; 
     2170                            $rest = "'$rest'"; 
     2171                        } 
     2172                        $quant = "\$C->$rep$h( $rest, "; 
     2173                    } 
     2174                    $result = $quant . "sub { my \$C=shift;\n" . ::indent($atom) . "\n})"; 
     2175                } 
     2176            } 
    20552177            else { 
    2056                 $result = $$self{atom}->walk(@_); 
     2178                $result = $atom; 
    20572179            } 
    20582180        } 
    … …  
    20932215        } 
    20942216        else { 
    2095             "map({ my \$C=\$_;\n" . 
    2096                 ::indent($inner) . 
    2097             "\n} ($outer)[0])"; 
     2217            my $oi = $outer . $inner; 
     2218            if ($oi =~ s{ ^ \$C->_PATTERN\(qr/\\G(.*?)/\) \$C->_PATTERN\(qr/\\G(.*?)/\) $ }{\$C->_PATTERN(qr/\\G$1$2/)}sx) { 
     2219                $oi; 
     2220            } 
     2221            else { 
     2222                my $in = ::indent($inner,2); 
     2223                substr(<<"END",0,-1); 
     2224do { 
     2225    if (my (\$C) = ($outer)[0]) { 
     2226$in; 
     2227    } 
     2228    else { 
     2229        (); 
     2230    } 
     2231} 
     2232END 
     2233 
     2234#               "map({ my \$C=\$_;\n" . 
     2235#                   ::indent($inner) . 
     2236#               "\n} ($outer)[0])"; 
     2237            } 
    20982238        } 
    20992239    } 

  • src/perl6/mangle.pl

    r21819 r21901  
    11package main; 
     2use utf8; 
    23 
    34sub mangle { 

  • src/perl6/tryfoo

    r21272 r21901  
    1010my $what = 'foo'; 
    1111my $text = "@ARGV"; 
    12 my $r = Perl->new($text)->$what(); 
     12my $r = STD->new($text)->$what(); 
    1313print Dump($r);