# New Ticket Created by Stefan O'Rear
# Please include the string: [perl #75030]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=75030 >
> my $x = 10
10
> my $y = 1
1
> while $x { $y *= $x-- }
> $y
3628800
> [*] ^10
0
> [*] 1..10
3628800
> sub fac($n) { [*] 1..$n }
fac
> fac 10
3628800
> $*AUTOPRINT = 0
0
> fac(20)
> fac(20).say
2.43290200817664e+18
Internally, the YOU_ARE_HERE mechanism is generalized to allow continuing any
lexical scope. Yes, this does mean that extremely long REPL sessions will take
linear space; I'm not too worried.
>From b9c4079ccc62711f9e29f2a8d9833da27d5b14d8 Mon Sep 17 00:00:00 2001
From: Stefan O'Rear <[email protected]>
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
