The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl -T
# -*- perl -*-
use strict;
use warnings;
use Test::More tests => 9;
use Data::Variant;
use Switch;
use vars qw{&Num &Add &Mul};

ok( 1, 'Loaded okay');

ok( register_variant("Arith", 	
    "Num <NUM>", "Add Arith Arith", "Mul Arith Arith"), 'register_variant' );

our ($num1,$num2,$i);

$num1 = Num 40;
$num2 = Num 3;

ok( ((defined $num1) and (defined $num2)), 'Initialized numbers');

ok( match($num1,"Num",$i), 'Matches properly' );

is( evaluate($num1), 40, '$num1 is okay');
is( evaluate($num2), 3,  '$num2 is okay');

# A more complex structure
our ($term, $factor);

$factor = Add $num1, $num2;
$term = Mul $num1, $factor;
ok( ((defined $term) && (defined $factor)), 'Complex structures defined okay');

is( evaluate($term), 1720, 'Evaluation of complex structure okay');

# Test something that shouldn't work.
my($f1,$f2);
ok( not($num1->match("Add",$f1,$f2)), 'No false match');

#ok( not $f1 =  Num("Badness"), 'No false construction');


sub evaluate {
    my $expr = shift;
    my ($o1,$o2);
    switch($expr->match) {
	case (mkpat "Num", $o1) { return $o1 };
    }

    if ($expr->match("Add", $o1, $o2)) {
	return evaluate($o1) + evaluate ($o2);
    }
    
    set_match($expr);

    if ($expr->match("Mul",$o1,$o2)) {
	return evaluate($o1) * evaluate($o2);
    }

    return -1;
}

exit;