Skip to content

Instantly share code, notes, and snippets.

@latk
Last active December 19, 2015 00:00
Show Gist options
  • Save latk/5866025 to your computer and use it in GitHub Desktop.
Save latk/5866025 to your computer and use it in GitHub Desktop.
Transforming Syntax – Tree Cloning example
use strict; use warnings; use 5.010;
use Data::Dumper;
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' );
print Dumper $ast;
print Dumper $ast->clone;
say "The trees are equivalent" if Dumper($ast) eq Dumper($ast->clone);
# AST classes below
package Ast;
use Scalar::Util qw/blessed/;
sub new {
my ($class, @args) = @_;
bless \@args => $class;
}
sub childs { @{ shift() } }
sub clone {
my ($self) = @_;
my @childs = map { blessed($_) && $_->can("clone") ? $_->clone : $_ } $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] }
package Ast::Cond;
use parent -norequire, 'Ast';
sub cond { shift()->[0] }
sub then { shift()->[1] }
sub else { shift()->[2] }
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] }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment