#!/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