summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2013-05-30 03:12:25 -0500
committerJesse Luehrs <doy@tozt.net>2013-05-30 03:12:25 -0500
commit071e98547d4dda83c29ea87cd4cff9115667bf24 (patch)
tree5b20f0019eb42b385f7a452c973991a1149ef625
parent34218fd2af78b254dd424de2289981621ee85f94 (diff)
downloadreply-071e98547d4dda83c29ea87cd4cff9115667bf24.tar.gz
reply-071e98547d4dda83c29ea87cd4cff9115667bf24.zip
split evaluate into compile and execute
-rw-r--r--lib/App/REPL.pm3
-rw-r--r--lib/App/REPL/Plugin/Colors.pm10
-rw-r--r--lib/App/REPL/Plugin/Defaults.pm11
-rw-r--r--lib/App/REPL/Plugin/Hints.pm11
-rw-r--r--lib/App/REPL/Plugin/Interrupt.pm14
-rw-r--r--lib/App/REPL/Plugin/LexicalPersistence.pm12
-rw-r--r--lib/App/REPL/Plugin/Packages.pm15
7 files changed, 58 insertions, 18 deletions
diff --git a/lib/App/REPL.pm b/lib/App/REPL.pm
index 54a674c..56c6e1d 100644
--- a/lib/App/REPL.pm
+++ b/lib/App/REPL.pm
@@ -115,7 +115,8 @@ sub _eval {
($line) = $self->_chained_plugin('mangle_line', $line)
if defined $line;
- return $self->_wrapped_plugin('evaluate', $line);
+ my ($code) = $self->_wrapped_plugin('compile', $line);
+ return $self->_wrapped_plugin('execute', $code);
}
sub _print_error {
diff --git a/lib/App/REPL/Plugin/Colors.pm b/lib/App/REPL/Plugin/Colors.pm
index b06f857..dc00cfd 100644
--- a/lib/App/REPL/Plugin/Colors.pm
+++ b/lib/App/REPL/Plugin/Colors.pm
@@ -17,7 +17,15 @@ sub new {
return $self;
}
-sub evaluate {
+sub compile {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ local $SIG{__WARN__} = sub { $self->print_warn(@_) };
+ $next->(@args);
+}
+
+sub execute {
my $self = shift;
my ($next, @args) = @_;
diff --git a/lib/App/REPL/Plugin/Defaults.pm b/lib/App/REPL/Plugin/Defaults.pm
index 23368e8..ab533b4 100644
--- a/lib/App/REPL/Plugin/Defaults.pm
+++ b/lib/App/REPL/Plugin/Defaults.pm
@@ -27,7 +27,7 @@ sub read_line {
my $PREFIX = "package main; BEGIN { \$^H = \$" . __PACKAGE__ . "::default_hints; \%^H = \%\$" . __PACKAGE__ . "::default_hinthash; \${^WARNING_BITS} = \$" . __PACKAGE__ . "::default_warning_bits }";
-sub evaluate {
+sub compile {
my $self = shift;
my ($next, $line, %args) = @_;
@@ -35,7 +35,14 @@ sub evaluate {
source => "sub { $PREFIX; $line }",
terse_error => 1,
%args,
- )->();
+ );
+}
+
+sub execute {
+ my $self = shift;
+ my ($next, $code) = @_;
+
+ return $code->();
}
sub print_error {
diff --git a/lib/App/REPL/Plugin/Hints.pm b/lib/App/REPL/Plugin/Hints.pm
index 9d198e2..a09f117 100644
--- a/lib/App/REPL/Plugin/Hints.pm
+++ b/lib/App/REPL/Plugin/Hints.pm
@@ -25,7 +25,14 @@ sub new {
return $self;
}
-sub evaluate {
+sub mangle_line {
+ my $self = shift;
+ my ($line) = @_;
+
+ return "BEGIN { \$^H = \$" . __PACKAGE__ . "::hints; \%^H = \%\$" . __PACKAGE__ . "::hinthash; \${^WARNING_BITS} = \$" . __PACKAGE__ . "::warning_bits } $line; BEGIN { \$" . __PACKAGE__ . "::hints = \$^H; \$" . __PACKAGE__ . "::hinthash = \\\%^H; \$" . __PACKAGE__ . "::warning_bits = \${^WARNING_BITS} }";
+}
+
+sub compile {
my $self = shift;
my ($next, $line, %args) = @_;
@@ -36,8 +43,6 @@ sub evaluate {
our $hinthash = $self->{hinthash};
our $warning_bits = $self->{warning_bits};
- $line = "BEGIN { \$^H = \$" . __PACKAGE__ . "::hints; \%^H = \%\$" . __PACKAGE__ . "::hinthash; \${^WARNING_BITS} = \$" . __PACKAGE__ . "::warning_bits } $line; BEGIN { \$" . __PACKAGE__ . "::hints = \$^H; \$" . __PACKAGE__ . "::hinthash = \\\%^H; \$" . __PACKAGE__ . "::warning_bits = \${^WARNING_BITS} }";
-
my @result = $next->($line, %args);
$self->{hints} = $hints;
diff --git a/lib/App/REPL/Plugin/Interrupt.pm b/lib/App/REPL/Plugin/Interrupt.pm
index 346807e..d993a15 100644
--- a/lib/App/REPL/Plugin/Interrupt.pm
+++ b/lib/App/REPL/Plugin/Interrupt.pm
@@ -4,12 +4,20 @@ use warnings;
use base 'App::REPL::Plugin';
-sub evaluate {
+sub compile {
my $self = shift;
- my ($next, $line, %args) = @_;
+ my ($next, @args) = @_;
local $SIG{INT} = sub { die "Interrupted" };
- $next->($line, %args);
+ $next->(@args);
+}
+
+sub execute {
+ my $self = shift;
+ my ($next, @args) = @_;
+
+ local $SIG{INT} = sub { die "Interrupted" };
+ $next->(@args);
}
1;
diff --git a/lib/App/REPL/Plugin/LexicalPersistence.pm b/lib/App/REPL/Plugin/LexicalPersistence.pm
index 6c9b1d3..986fa03 100644
--- a/lib/App/REPL/Plugin/LexicalPersistence.pm
+++ b/lib/App/REPL/Plugin/LexicalPersistence.pm
@@ -13,13 +13,19 @@ sub new {
return $self;
}
-sub evaluate {
+sub compile {
my $self = shift;
my ($next, $line, %args) = @_;
- $line = $self->{env}->prepare($line);
+ my %c = %{ $self->{env}->get_context('_') };
+
+ $args{environment} ||= {};
+ $args{environment} = {
+ %{ $args{environment} },
+ (map { $_ => ref($c{$_}) ? $c{$_} : \$c{$_} } keys %c),
+ };
my ($code) = $next->($line, %args);
- return $self->{env}->call($code);
+ return $self->{env}->wrap($code);
}
1;
diff --git a/lib/App/REPL/Plugin/Packages.pm b/lib/App/REPL/Plugin/Packages.pm
index d35d3f0..c1c02d0 100644
--- a/lib/App/REPL/Plugin/Packages.pm
+++ b/lib/App/REPL/Plugin/Packages.pm
@@ -13,18 +13,23 @@ sub new {
return $self;
}
-sub evaluate {
+sub mangle_line {
my $self = shift;
- my ($next, $line, %args) = @_;
+ my ($line) = @_;
+
+ return "package $self->{package}; $line; BEGIN { \$" . __PACKAGE__ . "::package = __PACKAGE__ }";
+}
+
+sub compile {
+ my $self = shift;
+ my ($next, @args) = @_;
# XXX it'd be nice to avoid using globals here, but we can't use
# eval_closure's environment parameter since we need to access the
# information in a BEGIN block
our $package = $self->{package};
- $line = "package $package; $line; BEGIN { \$" . __PACKAGE__ . "::package = __PACKAGE__ }";
-
- my @result = $next->($line, %args);
+ my @result = $next->(@args);
$self->{package} = $package;