CORE, SETTING and UNIT.

rakudo · Apr 16, 2012 · ef6fe01 · ef6fe01
1 parent f05a64d
commit ef6fe01
Show file tree

Hide file tree

Showing 2 changed files with 51 additions and 3 deletions.
diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -484,12 +484,24 @@ grammar Perl6::Grammar is HLL::Grammar {
         [ $ || <.typed_panic: 'X::Syntax::Confused'> ]
 
         {
+            # Install POD-related variables.
             $*POD_PAST := $*W.add_constant(
                 'Array', 'type_new', |$*POD_BLOCKS
             );
             $*W.install_lexical_symbol(
                 $*UNIT, '$=pod', $*POD_PAST<compile_time_value>
             );
+
+            # Tag UNIT with a magical lexical. Also if we're compiling CORE,
+            # give it such a tag too.
+            if %*COMPILING<%?OPTIONS><setting> eq 'NULL' {
+                $*W.install_lexical_symbol($*UNIT, '!CORE_MARKER',
+                    $*W.pkg_create_mo($/, %*HOW<package>, :name('!CORE_MARKER')));
+            }
+            else {
+                $*W.install_lexical_symbol($*UNIT, '!UNIT_MARKER',
+                    $*W.pkg_create_mo($/, %*HOW<package>, :name('!UNIT_MARKER')));
+            }
         }
 
         # CHECK time.

diff --git a/src/core/PseudoStash.pm b/src/core/PseudoStash.pm
@@ -28,7 +28,18 @@ my class PseudoStash is EnumMap {
                 $stash);
         },
         'CORE' => sub ($cur) {
-            die("CORE NYI");
+            my Mu $ctx := nqp::getattr(nqp::p6decont($cur), PseudoStash, '$!ctx');
+            until nqp::existskey(pir::getattribute__PPs($ctx, 'lex_pad'), '!CORE_MARKER') {
+                $ctx := pir::getattribute__PPs($ctx, 'outer_ctx');
+            }
+            my $stash := nqp::create(PseudoStash);
+            nqp::bindattr($stash, EnumMap, '$!storage',
+                pir::getattribute__PPs($ctx, 'lex_pad'));
+            nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
+            nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
+            pir::set_who__0PP(
+                Metamodel::ModuleHOW.new(:name('CORE')),
+                $stash);
         },
         'CALLER' => sub ($cur) {
             my Mu $ctx := pir::getattribute__PPs(
@@ -64,10 +75,35 @@ my class PseudoStash is EnumMap {
                 $stash);
         },
         'UNIT' => sub ($cur) {
-            die("UNIT NYI");
+            my Mu $ctx := nqp::getattr(nqp::p6decont($cur), PseudoStash, '$!ctx');
+            until nqp::existskey(pir::getattribute__PPs($ctx, 'lex_pad'), '!UNIT_MARKER') {
+                $ctx := pir::getattribute__PPs($ctx, 'outer_ctx');
+            }
+            my $stash := nqp::create(PseudoStash);
+            nqp::bindattr($stash, EnumMap, '$!storage',
+                pir::getattribute__PPs($ctx, 'lex_pad'));
+            nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
+            nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
+            pir::set_who__0PP(
+                Metamodel::ModuleHOW.new(:name('UNIT')),
+                $stash);
         },
         'SETTING' => sub ($cur) {
-            die("SETTING NYI");
+            # Same as UNIT, but go a little further out (two steps, for
+            # internals reasons).
+            my Mu $ctx := nqp::getattr(nqp::p6decont($cur), PseudoStash, '$!ctx');
+            until nqp::existskey(pir::getattribute__PPs($ctx, 'lex_pad'), '!UNIT_MARKER') {
+                $ctx := pir::getattribute__PPs($ctx, 'outer_ctx');
+            }
+            $ctx := pir::getattribute__PPs(pir::getattribute__PPs($ctx, 'outer_ctx'), 'outer_ctx');
+            my $stash := nqp::create(PseudoStash);
+            nqp::bindattr($stash, EnumMap, '$!storage',
+                pir::getattribute__PPs($ctx, 'lex_pad'));
+            nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
+            nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
+            pir::set_who__0PP(
+                Metamodel::ModuleHOW.new(:name('UNIT')),
+                $stash);
         },
         'OUR' => sub ($cur) {
             pir::find_lex_relative__PPs(