#!/usr/bin/perl
package Blondie::Backend::Perl::Interpreter;
use base qw/Blondie::Reducer Blondie::Reducer::DynamicScoping/;
use strict;
use warnings;
no warnings 'recursion';
sub new {
my $class = shift;
bless {
params => undef,
param_stack => [],
}, $class;
}
sub execute {
my $self = shift;
my $prog = shift;
$self->reduce($prog);
}
sub can_reduce { 1 }
sub generic_reduce {
my $self = shift;
my $node = shift;
die "generic reductions don't make sense while interpreting ($node)";
}
sub reduce_val { $_[1]->val }
sub reduce_app {
my $self = shift;
my $app = shift;
my ($thunk, @params) = map { $self->reduce($_) } $app->values;
$self->prepare_scope(@params);
# profiling actually slows this down by around 30%
#my $t = times;
#my $v =
$self->reduce($thunk);
#my $t2 = times;
#$self->{prof}{$thunk} += $t2-$t;
#$v;
}
sub reduce_thunk {
my $self = shift;
my $thunk = shift;
# FIXME - in the future the compiler might allow adding globals
# ought to check if the runtime has a hash for this right now this is a non
# issue since even higher order functions get prims instead of thunks when
# possible
my $body = $thunk->val;
$self->enter_scope;
my $v = $self->reduce($body);
$self->leave_scope;
return $v;
}
sub reduce_param {
my $self = shift;
my $param = shift;
$self->new_pad($param->val => $self->shift_param);
}
sub reduce_prim {
my $self = shift;
my $prim = shift;
$self->enter_scope;
my @params = $self->params;
# the body is a code ref
my $v = $prim->body->($self, map { $self->shift_param } 1 .. $prim->arity);
$self->leave_scope;
return $v;
}
sub reduce_sym {
my $self = shift;
my $symbol = shift->val;
$self->find_dyn_sym($symbol)->val;
}
sub reduce_seq {
my $self = shift;
my $seq = shift;
(map { $self->reduce($_) } $seq->values)[-1];
}
sub leave_scope {
my $self = shift;
$self->SUPER::leave_scope(@_);
# warn "unbound params @{ $self->{params} }" if $self->{params} and @{ $self->{params} };
$self->{params} = pop @{ $self->{param_stack} };
}
sub prepare_scope {
my $self = shift;
push @{ $self->{param_stack} }, $self->{params};
$self->{params} = [ @_ ];
}
sub shift_param {
my $self = shift;
shift @{ $self->{params} };
}
sub params {
my $self = shift;
@{ $self->{params} };
}
__PACKAGE__;
__END__
=pod
=head1 NAME
Blondie::Backend::Perl::Interpreter - A perl interpreter for compiled Blondie programs.
=head1 SYNOPSIS
use Blondie::Backend::Perl::Interpreter;
=head1 DESCRIPTION
This is a subclass of L<Blondie::Reducere> that performs the actions denoted by
the AST, ultimately flattenning the tree down to a single value.
=cut