Rakudo updates for nqpattr removal.

Also bumps NQP_REVISION to get the kill-nqpattr merge. gen_op gets a bit messier in this, but the categorically-better branch eliminates the code that needed an update here anyway.
rakudo · Oct 21, 2012 · d4a9b19 · d4a9b19
1 parent e765c99
commit d4a9b19
Show file tree

Hide file tree

Showing 4 changed files with 66 additions and 20 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -2465,8 +2465,8 @@ class Perl6::Actions is HLL::Actions {
                 $block.symbol('$/', :scope<lexical>, :lazyinit(1));
             }
             $past := %*RX<P5>
-                ?? QRegex::P5Regex::Actions::qbuildsub($qast, $block)
-                !! QRegex::P6Regex::Actions::qbuildsub($qast, $block);
+                ?? %*LANG<P5Regex-actions>.qbuildsub($qast, $block, code_obj => $code)
+                !! %*LANG<Regex-actions>.qbuildsub($qast, $block, code_obj => $code);
         }
         $past.name($name);
         $past.blocktype("declaration");
@@ -5711,7 +5711,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions {
                 my $nibbled := $name eq 'after'
                     ?? self.flip_ast($<nibbler>[0].ast)
                     !! $<nibbler>[0].ast;
-                my $sub := QRegex::P6Regex::Actions::qbuildsub($nibbled, :anon(1), :addself(1));
+                my $sub := %*LANG<Regex-actions>.qbuildsub($nibbled, :anon(1), :addself(1));
                 $qast[0].push($sub);
             }
         }
@@ -5753,14 +5753,25 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions {
         my $arglist := $<arglist>.ast;
         make $arglist;
     }
-
-    # XXX Overriden during QAST migration.
-    method metachar:sym<( )>($/) {
-        my $subpast := QAST::Node.new(
-            QRegex::P6Regex::Actions::qbuildsub($<nibbler>.ast, :anon(1), :addself(1)));
-        my $qast := QAST::Regex.new( $subpast, $<nibbler>.ast, :rxtype('subrule'),
-                                     :subtype('capture'), :node($/) );
-        make $qast;
+
+    method create_regex_code_object($block) {
+        $*W.create_code_object($block, 'Regex',
+            $*W.create_signature(nqp::hash('parameters', [])))
+    }
+
+    method store_regex_nfa($code_obj, $block, $nfa) {
+        $code_obj.SET_NFA($nfa.save);
+    }
+}
+
+class Perl6::P5RegexActions is QRegex::P5Regex::Actions {
+    method create_regex_code_object($block) {
+        $*W.create_code_object($block, 'Regex',
+            $*W.create_signature(nqp::hash('parameters', [])))
+    }
+
+    method store_regex_nfa($code_obj, $block, $nfa) {
+        $code_obj.SET_NFA($nfa.save);
     }
 }
 

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -12,7 +12,7 @@ grammar Perl6::Grammar is HLL::Grammar {
         %*LANG<Regex>           := Perl6::RegexGrammar;
         %*LANG<Regex-actions>   := Perl6::RegexActions;
         %*LANG<P5Regex>         := QRegex::P5Regex::Grammar;
-        %*LANG<P5Regex-actions> := QRegex::P5Regex::Actions;
+        %*LANG<P5Regex-actions> := Perl6::P5RegexActions;
         %*LANG<MAIN>            := Perl6::Grammar;
         %*LANG<MAIN-actions>    := Perl6::Actions;
 
@@ -2943,13 +2943,23 @@ grammar Perl6::Grammar is HLL::Grammar {
         # table.
         my %*RX;
         %*RX<name> := $canname;
-        $parse := QRegex::P6Regex::Actions::qbuildsub($parse, :addself(1));
-        $parse.name($canname);
+        my $W     := QRegex::P6Regex::World.new(:handle('RAKUDO_GEN_OP_' ~ $canname));
+        my $block := QAST::Block.new( :name($canname) );
+        my $code  := $W.create_code($block, $canname);
+        QRegex::P6Regex::Actions.qbuildsub($parse, $block, :addself(1), :code_obj($code));
         my $*QAST_BLOCK_NO_CLOSE := 1;
         my $*PASTCOMPILER := pir::compreg__Ps('PAST');
-        my $pirt := QAST::Compiler.as_post($parse);
-        my $pir := $pirt.pir();
-        $self.HOW.add_method($self, $canname, QAST::Compiler.evalpmc($pir)[0]);
+        my $pirt := QAST::Compiler.as_post(QAST::CompUnit.new(
+            :hll('P6Regex'),
+            :sc($W.sc()),
+            :code_ref_blocks($W.code_ref_blocks()),
+            :compilation_mode(0),
+            :pre_deserialize($W.load_dependency_tasks()),
+            :post_deserialize($W.fixup_tasks()),
+            $block
+        ));
+        QAST::Compiler.evalpmc($pirt.pir());
+        $self.HOW.add_method($self, $canname, $code);
 
         # May also need to add to the actions.
         if $category eq 'circumfix' {

diff --git a/src/Perl6/Metamodel/BOOTSTRAP.pm b/src/Perl6/Metamodel/BOOTSTRAP.pm
@@ -635,8 +635,33 @@ BEGIN {
 
     # class Regex is Method { ... }
     Regex.HOW.add_parent(Regex, Method);
-    Regex.HOW.add_method(Regex, 'nqpattr', static(sub ($self, $key) {
-            nqp::getattr(pir::perl6_decontainerize__PP($self), Code, '$!do').nqpattr($key)
+    Regex.HOW.add_attribute(Regex, scalar_attr('$!caps', Mu, Regex));
+    Regex.HOW.add_attribute(Regex, scalar_attr('$!nfa', Mu, Regex));
+    Regex.HOW.add_attribute(Regex, scalar_attr('$!alt_nfas', Mu, Regex));
+    Regex.HOW.add_method(Regex, 'SET_CAPS', static(sub ($self, $caps) {
+            nqp::bindattr(pir::perl6_decontainerize__PP($self), Regex, '$!caps', $caps)
+        }));
+    Regex.HOW.add_method(Regex, 'SET_NFA', static(sub ($self, $nfa) {
+            nqp::bindattr(pir::perl6_decontainerize__PP($self), Regex, '$!nfa', $nfa)
+        }));
+    Regex.HOW.add_method(Regex, 'SET_ALT_NFA', static(sub ($self, str $name, $nfa) {
+            my %alts := nqp::getattr(pir::perl6_decontainerize__PP($self), Regex, '$!alt_nfas');
+            unless %alts {
+                %alts := nqp::hash();
+                nqp::bindattr(pir::perl6_decontainerize__PP($self), Regex, '$!alt_nfas', %alts);
+            }
+            nqp::bindkey(%alts, $name, $nfa);
+        }));
+    Regex.HOW.add_method(Regex, 'CAPS', static(sub ($self) {
+            nqp::getattr(pir::perl6_decontainerize__PP($self), Regex, '$!caps')
+        }));
+    Regex.HOW.add_method(Regex, 'NFA', static(sub ($self) {
+            nqp::getattr(pir::perl6_decontainerize__PP($self), Regex, '$!nfa')
+        }));
+    Regex.HOW.add_method(Regex, 'ALT_NFA', static(sub ($self, str $name) {
+            nqp::atkey(
+                nqp::getattr(pir::perl6_decontainerize__PP($self), Regex, '$!alt_nfas'),
+                $name)
         }));
 
     # class Str is Cool {

diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION
@@ -1 +1 @@
-2012.10
+2012.10-39-gdeb59ee