view release on metacpan or  search on metacpan

lib/Math/Symbolic/Custom/Transformation.pm  view on Meta::CPAN

This is the constructor for Math::Symbolic::Custom::Transformation objects.
It takes two arguments: A pattern to look for and a replacement.

The pattern may either be a Math::Symbolic::Custom::Pattern object (fastest),
or a Math::Symbolic tree which will internally be transformed into a pattern
or even just a string which will be parsed as a pattern.

The replacement for the pattern may either be a Math::Symbolic tree or a
string to be parsed as such.

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto)||$proto;

    my $pattern = shift;
    my $replacement = shift;

    # parameter checking
    if (not defined $pattern or not defined $replacement) {
        croak("Arguments to ".__PACKAGE__."->new() must be a valid pattern and a replacement for matched patterns.");
    }

    if (not ref($pattern)) {
        my $copy = $pattern;
        $pattern = parse_from_string($pattern);
        if (not ref($pattern)) {
            croak("Failed to parse pattern '$copy' as a Math::Symbolic tree.");
        }
    }

    if (not $pattern->isa('Math::Symbolic::Custom::Pattern')) {
        eval {$pattern = Math::Symbolic::Custom::Pattern->new($pattern);};
        if ( $@ or not ref($pattern)
             or not $pattern->isa('Math::Symbolic::Custom::Pattern')    )
        {
            croak(
                "Could not transform pattern source into a pattern object."
                . ($@?" Error: $@":"")
            );
        }
    }

    if (not ref($replacement) =~ /^Math::Symbolic/) {
        my $copy = $replacement;
        $replacement = $Parser->parse($replacement);
        if (not ref($replacement) =~ /^Math::Symbolic/) {
            croak(
                "Failed to parse replacement '$copy' as a Math::Symbolic tree."
            );
        }
    }

    my $self = {
        pattern => $pattern,
        replacement => $replacement,
    };

    bless $self => $class;

    return $self;
}


=item apply

Applies the transformation to a Math::Symbolic tree. First argument must be
a Math::Symbolic tree to transform. The tree is not transformed in-place,
but its matched subtrees are contained in the transformed tree, so if you plan
to use the original tree as well as the transformed tree, take
care to clone one of the trees.

C<apply()> returns the transformed tree if the transformation pattern matched
and a false value otherwise.

On errors, it throws a fatal error.

=cut

sub apply {
    my $self = shift;
    my $tree = shift;

    if (not ref($tree) =~ /^Math::Symbolic/) {
        croak("First argument to apply() must be a Math::Symbolic tree.");
    }

    my $pattern = $self->{pattern};
    my $repl = $self->{replacement};

    my $matched = $pattern->match($tree);

    return undef if not $matched;

    my $match_vars = $matched->{vars};
    my $match_trees = $matched->{trees};
    my $match_consts = $matched->{constants};

    my $new = $repl->new();

    no warnings 'recursion';
    
    my $subroutine;
    my @descend_options;

    $subroutine = sub {
        my $tree = shift;
        if ($tree->term_type() == T_VARIABLE) {
            my $name = $tree->{name};
            if ($name eq 'TRANSFORMATION_HOOK') {

        my $hook = $tree->value();
                if (not ref($hook) eq 'ARRAY' and @$hook == 2) {
                    croak("Found invalid transformation hook in replacement tree. Did you use a variable named 'TRANSFORMATION_HOOK'? If so, please change its name since that name is used internally.");
                }
                else {
                    my $type = $hook->[0];
                    my $operand = $hook->[1]->new();
                    $operand->descend(