#!/usr/bin/perl
use strict;
use warnings;
use Language::AttributeGrammar;
package Leaf;
sub new{
return bless { value => $_[1] }, 'Leaf';
}
package Branch;
sub new{
return bless { value => $_[1], _list => undef }, 'Branch';
}
sub add_child{
my $self = shift;
push @{ $self->{_list} }, @_;
return $self;
}
sub list {
if (@_) {
bless { head => $_[0], tail => list(@_[1..$#_]) }, 'Cons';
}
else {
bless {}, 'Nil';
}
}
sub children{
return list( @{ $_[0]->{_list} });
}
####
package main;
my $grammar = new Language::AttributeGrammar <<'EOG';
Branch: $/.len = { 1 + $.len }
Leaf: $/.len = { 1 }
Cons: $/.len = { $.len + $.len }
Nil: $/.len = { 0 }
EOG
##
##
my $tree = Branch->new(3)->add_child(
Branch->new(1.1)->add_child(
Leaf->new(1),
Leaf->new(1.2)
),
Branch->new(2.0)->add_child(
Leaf->new(2.1),
# Leaf->new(2.15),
Leaf->new(2.2),
)
);
my $result = $grammar->apply($tree, 'len');
print "$result\n";
##
##
Deep recursion on subroutine "Language::AttributeGrammar::Thunk::get" at (eval 29) line 5.
##
##
# find the global minimum and propagate it back down the tree
ROOT: $/.gmin = { $/.min }
Branch: $.gmin = { $/.gmin }
| $.gmin) = { $/.gmin }
^
|
this is superfluous