#!/usr/bin/perl

# This is just a hand-written lazy attribute grammar to help
# me decide if I want to port L::AG to Perl 6 (i.e. whether
# pugs is going to give me too much bullshit like it did
# last time I tried to port an object-oriented module).
# So far, it looks pretty good.

class Thunk {
    method call () {
        my $thunk = $.code;
        if $thunk {
            undefine $.code;
            return $.value = $thunk();
        }
        else {
            return $.value;
        }
    }
    
    has $.code;
    has $.value;
}

sub *thunk(&code) {
    return Thunk.new(code => &code);
}

class Leaf {
    method visit ($parent) {
        my $compute = {
            min     => thunk { $.value },
            result  => thunk { Leaf.new(value => $compute<gmin>.call) },
            gmin    => thunk { $parent<gmin>.call },
        };
        return $compute;
    }

    has $.value;
}

class Branch {
    method visit ($parent) {
        my ($lvis, $rvis);
        my $compute = {
            min     => thunk { min($lvis<min>.call, $rvis<min>.call) },
            result  => thunk { Branch.new(left => $lvis<result>.call, right => $rvis<result>.call) },
            gmin    => thunk { $parent<gmin>.call },
        };
        ($lvis, $rvis) = ($.left.visit($compute), $.right.visit($compute));
        return $compute;
    }

    has $.left;
    has $.right;
}

class Root {
    method visit ($parent) {
        my $tvis;
        my $compute = {
            result => thunk { $tvis<result>.call },
            gmin   => thunk { $tvis<min>.call },
        };
        $tvis = $.tree.visit($compute);
        $compute;
    }

    has $.tree;
}

my $tree = Root.new(
    tree => Branch.new(
        left  => Leaf.new(value => 1),
        right => Branch.new(
            left  => Branch.new(
                left  => Leaf.new(value => 2),
                right => Leaf.new(value => 3),
            ),
            right => Leaf.new(value => -3),
        ),
    ),
);

say $tree.perl;
say $tree.visit( {} ).<result>.call.perl;