Create a gist now

Instantly share code, notes, and snippets.

@latk /gist:5866793
Last active Dec 19, 2015

What would you like to do?
Transforming Syntax – optimizer example
use strict; use warnings; use 5.010;
my $ast = bless( [
[
bless( [
bless( [
bless( [
bless( ['Myvalue.xyz'], 'Ast::Var' ),
'==',
bless( ['1'], 'Ast::Literal' )
], 'Ast::Binop' ),
'Or',
bless( [
bless( ['Frmae_1.signal_1'], 'Ast::Var' ),
'==',
bless( ['1'], 'Ast::Literal' )
], 'Ast::Binop' )
], 'Ast::Binop' ),
bless( [
bless( ['a'], 'Ast::Var' ),
'=',
bless( ['1'], 'Ast::Literal' )
], 'Ast::Binop' ),
bless( [
bless( ['a'], 'Ast::Var' ),
'=',
bless( ['0'], 'Ast::Literal' )
], 'Ast::Binop' )
], 'Ast::Cond' )
]
], 'Ast::Block' );
say $ast->simplify->prettyprint;
# AST classes below
package Ast;
use Scalar::Util qw/blessed/;
sub new {
my ($class, @args) = @_;
bless \@args => $class;
}
sub childs { @{ shift() } }
sub prettyprint {
my ($self, $indent) = @_;
$indent //= 0; # initialize $indent if no value passed
$indent++; # increment indent level
my $items = join "\n", # concatenate items with newline in between
map { " "x$indent . $_ } # pad the items with correct intendation
map { blessed($_) && $_->can("prettyprint") ? $_->prettyprint($indent) : $_ } $self->childs;
my $type = ref $self;
return "$type(\n" . $items . " )";
}
sub simplify {
my $self = shift;
my @childs = map {blessed($_) && $_->can("simplify") ? $_->simplify : $_} $self->childs;
ref($self)->new(@childs);
}
package Ast::Binop;
use parent -norequire, 'Ast';
sub l { shift()->[0] }
sub op { shift()->[1] }
sub r { shift()->[2] }
package Ast::Var;
use parent -norequire, 'Ast';
sub name { shift()->[0] }
sub prettyprint {
my $self = shift;
'${' . $self->name . '}';
}
package Ast::Cond;
use parent -norequire, 'Ast';
sub cond { shift()->[0] }
sub then { shift()->[1] }
sub else { shift()->[2] }
sub prettyprint {
my ($self, $indent) = @_;
$indent //= 0;
my ($cond, $then, $else) =
map { Scalar::Util::blessed($_) && $_->can("prettyprint") ? $_->prettyprint($indent) : $_ }
$self->childs;
return "if $cond\n"
. " "x$indent . "then $then\n"
. " "x$indent . "else $else";
}
sub simplify {
my $self = shift;
my ($cond, $then, $else) = @$self;
if (
not( grep not($_->isa('Ast::Binop') && $_->op eq '=' && $_->l->isa('Ast::Var')), $then, $else) and
$then->l->name eq $else->l->name
) {
return Ast::Binop->new(
$then->l->simplify,
'=',
Ast::Cond->new($cond->simplify, $then->r->simplify, $else->r->simplify),
);
}
# else: just do what would have been done by default
return $self->SUPER::simplify;
}
package Ast::Block;
use parent -norequire, 'Ast';
sub contents { shift()->[0] }
sub new {
my ($class, @items) = @_;
$class->SUPER::new(\@items);
}
sub childs { @{ shift()->contents } }
package Ast::Literal;
use parent -norequire, 'Ast';
sub val { shift()->[0] }
sub prettyprint {
my $self = shift;
my $val = $self->val // return "undef";
return qq("$val");
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment