revive Perl6::P5World

rakudo-p5 · Mar 24, 2013 · 4ae984e · 4ae984e
1 parent 3eefed5
commit 4ae984e
Show file tree

Hide file tree

Showing 5 changed files with 31 additions and 18 deletions.
diff --git a/Makefile b/Makefile
@@ -4,11 +4,15 @@ RM_F       = perl -MExtUtils::Command -e rm_f
 
 all: blib/perl5.pbc 
 
-blib/perl5.pbc: lib/v5.pm blib/Perl6/P5Actions.pbc blib/Perl6/P5Grammar.pbc
+blib/perl5.pbc: lib/v5.pm blib/Perl6/P5World.pbc blib/Perl6/P5Actions.pbc blib/Perl6/P5Grammar.pbc
 
 	$(NQP) --vmlibs=perl6_group,perl6_ops --target=pir --stagestats --output=blib/perl5.pir lib/v5.pm
 	$(PARROT) -o blib/perl5.pbc blib/perl5.pir
 
+blib/Perl6/P5World.pbc: lib/Perl6/P5World.pm
+	$(NQP) --vmlibs=perl6_group,perl6_ops --target=pir --stagestats --output=blib/Perl6/P5World.pir lib/Perl6/P5World.pm
+	$(PARROT) -o blib/Perl6/P5World.pbc blib/Perl6/P5World.pir
+
 blib/Perl6/P5Actions.pbc: lib/Perl6/P5Actions.pm
 	$(NQP) --vmlibs=perl6_group,perl6_ops --target=pir --stagestats --output=blib/Perl6/P5Actions.pir lib/Perl6/P5Actions.pm
 	$(PARROT) -o blib/Perl6/P5Actions.pbc blib/Perl6/P5Actions.pir

diff --git a/lib/Perl6/P5Actions.pm b/lib/Perl6/P5Actions.pm
@@ -6,11 +6,6 @@ use Perl6::Ops;
 use QRegex;
 use QAST;
 
-sub p5disect_longname( $longname ) {
-    $longname<colonpair> := nqp::list();
-    $*W.disect_longname( $longname )
-}
-
 my role STDActions {
     method quibble($/) {
         make $<nibble>.ast;
@@ -208,7 +203,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
     }
 
     method deflongname($/) {
-        make p5disect_longname($/).name(
+        make $*W.p5dissect_longname($/).name(
             :dba("$*IN_DECL declaration"),
             :decl<routine>,
         );
@@ -972,7 +967,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
     method package_declarator:sym<require>($/) {
         my $past := QAST::Stmts.new(:node($/));
         my $name_past := $<module_name>
-                        ?? p5disect_longname($<module_name><longname>).name_past()
+                        ?? $*W.p5dissect_longname($<module_name><longname>).name_past()
                         !! $<EXPR>[0].ast;
 
         $past.push(QAST::Op.new(
@@ -1308,7 +1303,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
         else {
             my $indirect;
             if $<desigilname> && $<desigilname><longname> {
-                my $longname := p5disect_longname($<desigilname><longname>);
+                my $longname := $*W.p5dissect_longname($<desigilname><longname>);
                 if $longname.contains_indirect_lookup() {
                     if $*IN_DECL {
                         $*W.throw($/, ['X', 'Syntax', 'Variable', 'IndirectDeclaration']);
@@ -2296,7 +2291,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
 
         my $name;
         if $<longname> {
-            my $longname := $*W.disect_longname($<longname>);
+            my $longname := $*W.dissect_longname($<longname>);
             $name := $longname.name(:dba('method name'),
                             :decl<routine>, :with_adverbs);
         }
@@ -2692,7 +2687,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
 
         # Get, or find, enumeration base type and create type object with
         # correct base type.
-        my $longname  := $<longname> ?? p5disect_longname($<longname>) !! 0;
+        my $longname  := $<longname> ?? $*W.p5dissect_longname($<longname>) !! 0;
         my $name      := $<longname> ?? $longname.name() !! $<variable><desigilname>;
 
         my $type_obj;
@@ -2839,7 +2834,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
             QAST::Op.new( :op('p6bool'), QAST::IVal.new( :value(1) ) ));
 
         # Create the meta-object.
-        my $longname := $<longname> ?? p5disect_longname($<longname>[0]) !! 0;
+        my $longname := $<longname> ?? $*W.p5dissect_longname($<longname>[0]) !! 0;
         my $subset := $<longname> ??
             $*W.create_subset(%*HOW<subset>, $refinee, $refinement, :name($longname.name())) !!
             $*W.create_subset(%*HOW<subset>, $refinee, $refinement);
@@ -3330,7 +3325,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
 
             # If we have a type name then we need to dispatch with that type; otherwise
             # we need to dispatch with it as a named argument.
-            my @name := p5disect_longname($<longname>).components();
+            my @name := $*W.p5dissect_longname($<longname>).components();
             if $*W.is_name(@name) {
                 my $trait := $*W.find_symbol(@name);
                 make -> $declarand {
@@ -3435,7 +3430,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
         # runs after CHECK time.
         my $past := $<methodop>.ast;
         if $<methodop><longname> {
-            my @parts   := p5disect_longname($<methodop><longname>).components();
+            my @parts   := $*W.p5dissect_longname($<methodop><longname>).components();
             my $name    := @parts.pop;
             if @parts {
                 my $methpkg := $*W.find_symbol(@parts);
@@ -3478,7 +3473,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
         if $<longname> {
             # May just be .foo, but could also be .Foo::bar. Also handle the
             # macro-ish cases.
-            my @parts := p5disect_longname($<longname>).components();
+            my @parts := $*W.p5dissect_longname($<longname>).components();
             my $name := @parts.pop;
             if +@parts {
                 $past.unshift($*W.symbol_lookup(@parts, $/));
@@ -4945,7 +4940,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
         # GenericHOW, though whether/how it's used depends on context.
         if $<longname> {
             if nqp::substr(~$<longname>, 0, 2) ne '::' {
-                my $longname := p5disect_longname($<longname>);
+                my $longname := $*W.p5dissect_longname($<longname>);
                 my $type := $*W.find_symbol($longname.type_name_parts('type name'));
                 if $<arglist> {
                     $type := $*W.parameterize_type($type, $<arglist>, $/);

diff --git a/lib/Perl6/P5Grammar.pm b/lib/Perl6/P5Grammar.pm
@@ -2,6 +2,7 @@ use QRegex;
 use NQPP6QRegex;
 use NQPP5QRegex;
 use Perl6::P5Actions;
+use Perl6::P5World;
 use Perl6::Pod; # XXX do we need that?
 
 role startstop5[$start,$stop] {
@@ -1652,7 +1653,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
         { unless $*SCOPE { $*SCOPE := 'our'; } }
 
         [
-            [ <longname> { $longname := p5disect_longname($<longname>[0]); } ]?
+            [ <longname> { $longname := $*W.p5dissect_longname($<longname>[0]); } ]?
             <.newlex>
 
             [ :dba('generic role')
@@ -3566,7 +3567,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
     token term:sym<name> {
         <longname>
         :my $*longname;
-        { say("token term:sym<name> longname:" ~ ~$<longname>); $*longname := p5disect_longname($<longname>) }
+        { say("token term:sym<name> longname:" ~ ~$<longname>); $*longname := $*W.p5dissect_longname($<longname>) }
         [
         ||  <?{ nqp::substr($<longname>.Str, 0, 2) eq '::' || $*W.is_name($*longname.components()) }>
             <.unsp>?

diff --git a/lib/Perl6/P5World.pm b/lib/Perl6/P5World.pm
@@ -0,0 +1,10 @@
+
+# This will be mixed in within v5.pm.
+role Perl6::P5World {
+    method p5dissect_longname( $longname ) {
+        $longname<colonpair> := nqp::list();
+        self.dissect_longname( $longname )
+    }
+}
+
+# vim: ft=perl6
diff --git a/lib/v5.pm b/lib/v5.pm
@@ -1,5 +1,6 @@
 use Perl6::Grammar;
 use Perl6::P5Grammar;
+use Perl6::P5World;
 
 # we use the MOP because that's the only way nqp supports multiple inheritance 
 grammar Foo {
@@ -10,5 +11,7 @@ $grammar.HOW.add_parent($grammar,Perl6::P5Grammar);
 $grammar.HOW.add_parent($grammar,Perl6::Grammar);
 $grammar.HOW.compose($grammar);
 
+$*W.HOW.mixin( $*W, Perl6::P5World );
+
 %*LANG<MAIN> := $grammar;
 %*LANG<MAIN-actions> := Perl6::P5Actions;