Merge pull request #5135 from vrurg/improve-rakuast-experimental

Implement a reliable approach to experimental RakuAST

lib/experimental.rakumod

@@ -1,11 +1,7 @@
 use nqp;
 
 package EXPORT::rakuast {
-    # This code can be removed once RakuAST is stable and
-    #   use experimental :rakuast;
-    # is no longer necessary to be able to access the RakuAST classes
-    # and their functionality.
-    OUR::<RakuAST> := nqp::getcurhllsym('RakuAST');
+    # Do nothing, just provide the tag.
 }
 
 package EXPORT::cached {

src/Perl6/Actions.nqp

@@ -1390,6 +1390,25 @@ class Perl6::Actions is HLL::Actions does STDActions {
             stderr().print($world.group_exception().gist());
         }
 
+        unless $*COMPILING_CORE_SETTING || $*WANT_RAKUAST || $world.have_outer {
+            my $Exception := $*W.find_symbol_in_setting(['X', 'Experimental']);
+            $world.add_object_if_no_sc($Exception);
+            $*UNIT_OUTER[0].push(
+                QAST::Op.new(
+                    :op<bind>,
+                    QAST::Var.new( :name<RakuAST>, :scope<lexical>, :decl<var>),
+                    QAST::Op.new(
+                        :op<callmethod>,
+                        :name<new>,
+                        QAST::Var.new( :name<Failure>, :scope<lexical> ),
+                        QAST::Op.new(
+                            :op<callmethod>,
+                            :name<new>,
+                            QAST::WVal.new(:value($Exception)),
+                            QAST::SVal.new(:value<RakuAST>, :named<feature>),
+                            QAST::SVal.new(:value<rakuast>, :named<use> )))));
+        }
+
         if %*COMPILING<%?OPTIONS><p> { # also covers the -np case, like Perl
             $mainline[1] := QAST::Stmt.new(wrap_option_p_code($/, $mainline[1]));
         }
@@ -10865,9 +10884,9 @@ Did you mean a call like '"
             $world.throw($/, ['X', 'NoSuchSymbol'], symbol => join('::', @name));
         }
         my $type := $world.find_symbol(@name);
-        my $is_generic := 
-            nqp::can($type.HOW, "archetypes") 
-            && nqp::can($type.HOW.archetypes($type), "generic") 
+        my $is_generic :=
+            nqp::can($type.HOW, "archetypes")
+            && nqp::can($type.HOW.archetypes($type), "generic")
             && $type.HOW.archetypes($type).generic;
         my $past;
         if $is_generic || nqp::isnull(nqp::getobjsc($type)) || istype($type.HOW,$/.how('package')) {

src/Perl6/Grammar.nqp

@@ -796,6 +796,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
         :my %*SIG_INFO;                            # information about recent signature
         :my $*CAN_LOWER_TOPIC := 1;                # true if we optimize the $_ lexical away
         :my $*MAY_USE_RETURN := 0;                 # true if the current routine may use return
+        :my $*WANT_RAKUAST := 0;                   # if `use experimental :rakuast` is in effect
 
         # Various interesting scopes we'd like to keep to hand.
         :my $*GLOBALish;

src/Perl6/World.nqp

@@ -545,6 +545,8 @@ class Perl6::World is HLL::World {
         $!in_unit_parse
     }
 
+    method have_outer() { $!have_outer }
+
     method add_check($check) {
         @!CHECKs := [] unless @!CHECKs;
         @!CHECKs.unshift($check);
@@ -1271,6 +1273,25 @@ class Perl6::World is HLL::World {
                 self.throw($/, 'X::Pragma::UnknownArg', :$name, :$arg);
             }
         }
+        elsif $name eq 'experimental' {
+            # Make sure if an experimental feature requires compile-time pre-processing. Currently used for masking
+            # RakuAST symbol unless `use experimental :rakuast` is used.
+            if $on && nqp::defined($arglist) && nqp::elems($arglist) {
+                my $Pair := self.find_single_symbol_in_setting('Pair');
+                my $Bool := self.find_single_symbol_in_setting('Bool');
+                for $arglist -> $arg {
+                    if nqp::istype($arg, $Pair) {
+                        my $value := $arg.value;
+                        if nqp::istype($value, $Bool) && $value && $arg.key eq 'rakuast' {
+                            $*WANT_RAKUAST := 1;
+                            last;
+                        }
+                    }
+                }
+            }
+            # Load module 'experimental' anyway
+            return 0;
+        }
         elsif $name eq 'lib' {
             unless $on {
                 self.throw($/, 'X::Pragma::CannotWhat', :what<no>, :$name);
@@ -4890,6 +4911,7 @@ class Perl6::World is HLL::World {
     # Checks if a given symbol is declared.
     method is_name(@name) {
         my int $is_name := 0;
+        self."!no_experimental_rakuast"(@name);
         if self.is_pseudo_package(@name[0]) {
             $is_name := 1;
         }
@@ -5149,6 +5171,13 @@ class Perl6::World is HLL::World {
         $value
 
     }
+
+    method !no_experimental_rakuast(@name) {
+        if (@name[0] eq 'RakuAST') && !($*COMPILING_CORE_SETTING || $*WANT_RAKUAST) {
+            $*LEAF.typed_panic('X::Experimental', :feature<RakuAST>, :use<rakuast>);
+        }
+    }
+
     method find_symbol(@name, :$setting-only, :$upgrade_to_global, :$cur-package) {
         my $fullname := join("::", @name);
         if $setting-only && nqp::existskey(%!setting_symbols, $fullname) && !$upgrade_to_global {
@@ -5158,6 +5187,8 @@ class Perl6::World is HLL::World {
         # Make sure it's not an empty name.
         unless +@name { nqp::die("Cannot look up empty name"); }
 
+        self."!no_experimental_rakuast"(@name);
+
         if +@name == 1 {
             #note("got a single element argument to find_symbol: " ~ @name[0]);
             return self.find_single_symbol(~@name[0], :$setting-only, :$upgrade_to_global, :$cur-package);

src/core.c/RakuAST/Deparse.pm6

@@ -527,7 +527,7 @@ class RakuAST::Deparse {
     }
 
     multi method deparse(RakuAST::Postcircumfix::LiteralHashIndex:D $ast --> str) {
-        self.deparse($ast.index)  
+        self.deparse($ast.index)
     }
 
     multi method deparse(RakuAST::Postfix:D $ast --> str) {
@@ -1502,4 +1502,6 @@ class RakuAST::Deparse {
     }
 }
 
+nqp::bindhllsym('Raku', 'DEPARSE', RakuAST::Deparse);
+
 # vim: expandtab shiftwidth=4

src/core.c/Rakudo/Internals.pm6

@@ -1786,6 +1786,10 @@ my class Rakudo::Internals {
     method NEXT-ID(--> Int:D) {
         cas $next-id, { nqp::add_I(nqp::decont($_), 1, Int) }
     }
+
+    method DEPARSE(Mu \node) {
+        nqp::gethllsym('Raku', 'DEPARSE').new.deparse(node)
+    }
 }
 
 # expose the number of bits a native int has

src/core.c/Stash.pm6

@@ -24,13 +24,6 @@ my class Stash { # declared in BOOTSTRAP
                ContainerDescriptor::BindHashKey.new(Mu, self, $key)
              )
     }
-
-    method !fail-not-found($key) {
-        (self.Str eq 'must-use-experimental-rakuast'
-          ?? "Must do a 'use experimental :rakuast' to access RakuAST::$key.substr(1)"
-          !! "Could not find symbol '$key' in '{self}'"
-        ).Failure
-    }
     multi method AT-KEY(Stash:D: Str() $key, :$global_fallback!) is raw {
         my \storage := nqp::getattr(self,Map,'$!storage');
         nqp::if(
@@ -41,7 +34,7 @@ my class Stash { # declared in BOOTSTRAP
             nqp::if(
               nqp::existskey(GLOBAL.WHO,$key),
               nqp::atkey(GLOBAL.WHO,$key),
-              self!fail-not-found($key)
+              "Could not find symbol '$key' in '{self}'".Failure
             ),
             nqp::p6scalarfromdesc(
               ContainerDescriptor::BindHashKey.new(Mu, self, $key)

src/core.c/core_epilogue.pm6

@@ -135,24 +135,6 @@ BEGIN .^compose for
 
 BEGIN Metamodel::ClassHOW.exclude_parent(Mu);
 
-# This code can be removed once RakuAST is stable and
-#   use experimental :rakuast;
-# is no longer necessary to be able to access the RakuAST classes
-# and their functionality.
-{
-    my Mu $ctx := nqp::getattr(CORE::, PseudoStash, '$!ctx');
-    my class must-use-experimental-rakuast is Nil { }
-    until nqp::isnull($ctx) {
-        my $pad := nqp::ctxlexpad($ctx);
-        if nqp::existskey($pad, 'CORE-SETTING-REV') {
-            nqp::bindcurhllsym('RakuAST',RakuAST);
-            nqp::bindkey($pad,'RakuAST',must-use-experimental-rakuast);
-            last;
-        }
-        $ctx := nqp::ctxouterskipthunks($ctx);
-    }
-}
-
 {YOU_ARE_HERE}
 
 # vim: expandtab shiftwidth=4