From b9c4079ccc62711f9e29f2a8d9833da27d5b14d8 Mon Sep 17 00:00:00 2001
From: Stefan O'Rear <stefanor@cox.net>
Date: Tue, 4 May 2010 03:00:55 -0700
Subject: [PATCH] Lexical persistence and printing for the REPL

It works by reusing and generalizing the settings machinery; each line acts
as the setting for subsequent lines.  The setting is also used to initialize
the symbol table for compilations, so lexicals will be found.

$*AUTOPRINT, a compile time contextual, causes 'say' to be wrapped around
every expression statement.  It is disabled in blocks and all non-REPL
sources of code.  Autoprinting can be toggled in the REPL itself by
assigning to $*AUTOPRINT.
---
 src/Perl6/Actions.pm   |   73 ++++++++++++++++++++++++++++++++++++------------
 src/Perl6/Compiler.pir |   43 ++++++++++++++++++++++++++++
 src/Perl6/Grammar.pm   |    2 +
 src/glue/run.pir       |   11 ++++++-
 4 files changed, 110 insertions(+), 19 deletions(-)

diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
index fca683c..a0115db 100644
--- a/src/Perl6/Actions.pm
+++ b/src/Perl6/Actions.pm
@@ -42,17 +42,42 @@ method deflongname($/) {
 }
 
 method comp_unit($/, $key?) {
+    my $setting := $*IN_REPL ?? '!RESUME_HERE' !! '!YOU_ARE_HERE';
+
     # If this is the start of the unit, add an outer module.
     if $key eq 'open' {
         @PACKAGE.unshift(Perl6::Compiler::Module.new());
         @PACKAGE[0].block(@BLOCK[0]);
+
+        # Make setting lexicals available at compile-time.  XXX not all of
+        # these should be :does_abstraction.
+
+        my $outer := pir::get_hll_global__PS($setting);
+
+        until pir::isnull__IP($outer) {
+            my $lexinfo := $outer.get_lexinfo;
+
+            for $lexinfo -> $kv {
+                @BLOCK[0].symbol($kv.key, :scope('lexical'),
+                    :does_abstraction(1));
+            }
+
+            $outer := $outer.get_outer;
+        }
+
         return 1;
     }
     
     # Create the block for the mainline code.
     my $mainline := @BLOCK.shift;
     $mainline.push($<statementlist>.ast);
-    
+
+    # In the REPL, we want to save the lexical scope so it can be reused
+    # in the next line
+    if $*IN_REPL {
+        $mainline[0].push(make_lexical_continuation("!RESUME_HERE"));
+    }
+
     # If it's the setting, just need to run the mainline.
     if $*SETTING_MODE {
         $mainline.hll($?RAKUDO_HLL);
@@ -73,6 +98,7 @@ method comp_unit($/, $key?) {
         PAST::Op.new(
             :pirop('tailcall'),
             PAST::Var.new( :name('!UNIT_START'), :namespace(''), :scope('package') ),
+            PAST::Var.new( :name($setting), :namespace(''), :scope('package') ),
             $mainline,
             PAST::Var.new( :scope('parameter'), :name('@_'), :slurpy(1) )
         )
@@ -96,7 +122,8 @@ method comp_unit($/, $key?) {
             :pirflags(':load'), :lexical(0), :namespace(''),
             PAST::Op.new(
                 :name('!UNIT_START'), :pasttype('call'),
-                PAST::Val.new( :value($unit) ),
+                PAST::Var.new( :name($setting), :namespace(''), :scope('package') ),
+                PAST::Val.new( :value($unit) )
             )
         )
     );
@@ -169,6 +196,9 @@ method statement($/, $key?) {
                 $past := PAST::Op.new($cond, $past, :pasttype(~$ml<sym>), :node($/) );
             }
         }
+        if $*AUTOPRINT && !$mc && !$ml {
+            $past := PAST::Op.new(:pasttype('call'), :name('&say'), $past);
+        }
     }
     elsif $<statement_control> { $past := $<statement_control>.ast; }
     else { $past := 0; }
@@ -594,25 +624,32 @@ method term:sym<statement_prefix>($/)   { make $<statement_prefix>.ast; }
 method term:sym<lambda>($/)             { make create_code_object($<pblock>.ast, 'Block', 0, ''); }
 method term:sym<sigterm>($/)            { make $<sigterm>.ast; }
 
-method term:sym<YOU_ARE_HERE>($/) {
-    my $past := PAST::Block.new(
-        :name('!YOU_ARE_HERE'),
-        PAST::Var.new( :name('mainline'), :scope('parameter') ),
-        PAST::Op.new( :pasttype('callmethod'), :name('set_outer'),
-            PAST::Var.new( :name('mainline'), :scope('lexical') ),
-            PAST::Var.new( :scope('keyed'), PAST::Op.new( :pirop('getinterp P') ), 'sub' )
-        ),
-        PAST::Op.new( :pasttype('call'), PAST::Var.new( :name('mainline'), :scope('lexical') ) )
-    );
-    @BLOCK[0][0].push(PAST::Var.new(
-        :name('!YOU_ARE_HERE'), :isdecl(1), :viviself($past), :scope('lexical')
-    ));
-    make PAST::Op.new( :pasttype('call'),
-        PAST::Var.new( :name('!YOU_ARE_HERE'), :scope('lexical') ),
-        PAST::Block.new( )
+sub make_lexical_continuation($name) {
+    PAST::Op.new(
+        :pasttype('bind'),
+        PAST::Var.new( :name($name), :namespace(''), :scope('package') ),
+        PAST::Block.new(
+            :blocktype('declaration'),
+            :name($name),
+            :nsentry(0),
+            PAST::Var.new( :name('!mainline'), :scope('parameter') ),
+            PAST::Op.new( :pasttype('callmethod'), :name('set_outer'),
+                PAST::Var.new( :name('!mainline'), :scope('lexical') ),
+                PAST::Var.new( :scope('keyed'),
+                    PAST::Op.new( :pirop('getinterp P') ), 'sub' )
+            ),
+            PAST::Op.new( :pasttype('call'),
+                PAST::Var.new( :name('!mainline'), :scope('lexical') ) )
+        )
     );
 }
 
+method term:sym<YOU_ARE_HERE>($/) {
+    # the first is for modules, the second is for the REPL
+    @BLOCK[0][0].push(make_lexical_continuation('!YOU_ARE_HERE'));
+    @BLOCK[0][0].push(make_lexical_continuation('!RESUME_HERE'));
+}
+
 method name($/) { }
 
 method module_name($/) {
diff --git a/src/Perl6/Compiler.pir b/src/Perl6/Compiler.pir
index 4d69039..d707488 100644
--- a/src/Perl6/Compiler.pir
+++ b/src/Perl6/Compiler.pir
@@ -152,6 +152,11 @@ Perl6::Compiler - Perl6 compiler
     $P2 = new ['Array']
     $P2.'!STORE'($P1)
     set_hll_global '@INC', $P2
+
+    $P0 = box 1
+    $P1 = box 1
+    setprop $P0, "rw", $P1
+    set_hll_global '$AUTOPRINT', $P0
 .end
 
 .sub load_module :method
@@ -185,6 +190,44 @@ Perl6::Compiler - Perl6 compiler
     exit 0
 .end
 
+# Thread the "Are we in the REPL?" state down into the compiler, where it can
+# be used to slightly modify behavior
+.sub 'interactive' :method
+    .param pmc adverbs :slurpy :named
+    .local pmc true, super
+    true = box 1
+    adverbs["in_repl"] = true
+
+    super = get_class ["HLL";"Compiler"]
+    super = super.'find_method'('interactive')
+
+    .tailcall super(self, adverbs :flat :named)
+.end
+
+.sub 'parse' :method
+    .param pmc source
+    .param pmc in_repl :named("in_repl") :optional
+    .param pmc adverbs :slurpy :named
+    .local pmc autoprint
+
+    autoprint = '!find_contextual'("$*AUTOPRINT")
+    .lex "$*AUTOPRINT", autoprint
+
+    unless null in_repl goto have_in_repl
+    in_repl = box 0
+    autoprint = box 0
+  have_in_repl:
+
+    .lex "$*IN_REPL", in_repl
+    .local pmc super
+
+    super = get_class ["HLL";"Compiler"]
+    super = super.'find_method'('parse')
+
+    $P0 = super(self, source, adverbs :flat :named)
+    .return($P0)
+.end
+
 .include 'src/gen/core.pir'
 
 # Cheats go at the end, because some of them are in the 'parrot' HLL
diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
index 04aa4b7..fdce8ad 100644
--- a/src/Perl6/Grammar.pm
+++ b/src/Perl6/Grammar.pm
@@ -333,6 +333,7 @@ token block($*IMPLICIT = 0) {
 }
 
 token blockoid {
+    :my $*AUTOPRINT := 0;
     <.finishpad>
     '{' ~ '}' <statementlist>
     <?ENDSTMT>
@@ -465,6 +466,7 @@ token statement_prefix:sym<gather>{ <sym> <blorst> }
 token statement_prefix:sym<do>    { <sym> <blorst> }
 
 token blorst {
+    :my $*AUTOPRINT := 0;
     \s <.ws> [ <?[{]> <block> | <statement> ]
 }
 
diff --git a/src/glue/run.pir b/src/glue/run.pir
index e54bb07..7e5a364 100644
--- a/src/glue/run.pir
+++ b/src/glue/run.pir
@@ -21,7 +21,16 @@ of the compilation unit.
  .include 'sysinfo.pasm'
 .include 'iglobals.pasm'
 
+# The initialization code here is problematic.  Parrot forces us
+# to put it here, because the command-line arguments do not
+# appear to be available anywhere else but in the :main sub; but
+# in order to inject @*ARGS into the namespace, we need to use
+# setting-defined types.  Which in turn means that !UNIT_START
+# cannot be used when compiling the setting, which leads to
+# somewhat more magic than we'd really like in the compiler.
+
 .sub '!UNIT_START'
+    .param pmc lex_cont
     .param pmc mainline
     .param pmc args            :slurpy
 
@@ -83,6 +92,6 @@ of the compilation unit.
     $P0 = mainline()
     .return ($P0)
   in_setting:
-    $P0 = '!YOU_ARE_HERE'(mainline)
+    $P0 = lex_cont(mainline)
     .return ($P0)
 .end
-- 
1.6.6