Optimize MATCH and CAPHASH to construct less objects.

Raku · May 26, 2012 · f8f164f · f8f164f
1 parent 25680d9
commit f8f164f
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 13 deletions.
diff --git a/src/HLL/Grammar.pm b/src/HLL/Grammar.pm
@@ -723,6 +723,14 @@ An operator precedence parser.
             .local pmc op, opOPER, opO
             .local string opassoc
             op = pop opstack
+            
+            # Give it a fresh capture list, since we'll have assumed it has
+            # no positional captures and not taken them.
+            .local pmc cap_class
+            cap_class = find_lex 'NQPCapture'
+            $P0 = new ['ResizablePMCArray']
+            setattribute op, cap_class, '@!array', $P0
+            
             opOPER = op['OPER']
             opO = opOPER['O']
             $P0 = opO['assoc']

diff --git a/src/QRegex/Cursor.nqp b/src/QRegex/Cursor.nqp
@@ -14,22 +14,35 @@ role NQPCursorRole {
     method from() { $!from }
     method pos() { $!pos }
 
+    my $NO_CAPS := nqp::hash();
     method CAPHASH() {
-        my $caps := nqp::hash();
-        my %caplist := $!regexsub ?? $!regexsub.nqpattr('caps') !! nqp::hash();
-        for %caplist {
-            $caps{~$_} := nqp::list() if %caplist{~$_} >= 2;
+        my $caps    := nqp::hash();
+        my %caplist := $NO_CAPS;
+        if $!regexsub {
+            %caplist := $!regexsub.nqpattr('caps');
+            if %caplist {
+                for %caplist {
+                    $caps{~$_} := nqp::list() if %caplist{~$_} >= 2;
+                }
+            }
         }
         if $!cstack {
             for $!cstack -> $subcur {
                 my $submatch := $subcur.MATCH;
                 my $name := nqp::getattr($subcur, $?CLASS, '$!name');
                 if pir::defined($name) {
-                    for nqp::split('=', $name) -> $name {
+                    if nqp::index($name, '=') < 0 {
                         %caplist{$name} >= 2
                             ?? nqp::push($caps{$name}, $submatch)
                             !! nqp::bindkey($caps, $name, $submatch);
                     }
+                    else {
+                        for nqp::split('=', $name) -> $name {
+                            %caplist{$name} >= 2
+                                ?? nqp::push($caps{$name}, $submatch)
+                                !! nqp::bindkey($caps, $name, $submatch);
+                        }
+                    }
                 }
             }
         } 
@@ -428,26 +441,33 @@ class NQPMatch is NQPCapture {
 }
 
 class NQPCursor does NQPCursorRole {
+    my $EMPTY_MATCH_LIST := nqp::list();
+    my $EMPTY_MATCH_HASH := nqp::hash();
     method MATCH() {
         my $match := nqp::getattr(self, NQPCursor, '$!match');
-        unless pir::isa($match, 'Hash') || nqp::istype($match, NQPMatch) {
-            my $list := nqp::list();
-            my $hash := nqp::hash();
+        unless nqp::istype($match, NQPMatch) || pir::isa($match, 'Hash') {
+            my $list := $EMPTY_MATCH_LIST;
+            my $hash := $EMPTY_MATCH_HASH;
             $match := nqp::create(NQPMatch);
             nqp::bindattr(self, NQPCursor, '$!match', $match);
-            nqp::bindattr($match, NQPCapture, '@!array', $list);
-            nqp::bindattr($match, NQPCapture, '%!hash', $hash);
             nqp::bindattr($match, NQPMatch, '$!cursor', self);
             nqp::bindattr($match, NQPMatch, '$!orig', nqp::getattr(self, NQPCursor, '$!orig'));
             nqp::bindattr_i($match, NQPMatch, '$!from', nqp::getattr_i(self, NQPCursor, '$!from'));
             nqp::bindattr_i($match, NQPMatch, '$!to', nqp::getattr_i(self, NQPCursor, '$!pos'));
             my %ch := self.CAPHASH;
             for %ch {
                 my $key := ~$_;
-                nqp::iscclass(pir::const::CCLASS_NUMERIC, $key, 0)
-                  ?? nqp::bindpos($list, $key, %ch{$key})
-                  !! nqp::bindkey($hash, $key, %ch{$key});
+                if nqp::iscclass(pir::const::CCLASS_NUMERIC, $key, 0) {
+                    $list := nqp::list() unless $list;
+                    nqp::bindpos($list, $key, %ch{$key});
+                }
+                else {
+                    $hash := nqp::hash() unless $hash;
+                    nqp::bindkey($hash, $key, %ch{$key});
+                }
             }
+            nqp::bindattr($match, NQPCapture, '@!array', $list);
+            nqp::bindattr($match, NQPCapture, '%!hash', $hash);
         }
         $match
     }