view release on metacpan or  search on metacpan

lib/AI/Prolog/Term.pm  view on Meta::CPAN

                return;
            }
        }
        $term->bind($self);
        push @{$stack} => $term;    # side-effect -- setting stack vars
        return 1;
    }

    # do occurcheck if turned on
    return if $self->occurcheck && $term->occurs( $self->varid );
    $self->bind($term);
    push @{$stack} => $self;        # save for backtracking
    return 1;
}

# refresh creates new variables.  If the variables already exist
# in its arguments then they are used.  This is used when parsing
# a clause so that variables throughout the clause are shared.
# Includes a copy operation.

sub refresh {
    my ( $self, $term_aref ) = @_;
    if ( $self->{bound} ) {
        if ( $self->{deref} ) {
            return $self->{ref}->refresh($term_aref);
        }
        else {
            if ( 0 == $self->{arity} ) {
                return $self;
            }
            else {
                my $term = ( CORE::ref $self)
                    ->_new_from_functor_and_arity( $self->{functor},
                    $self->{arity} );
                for my $i ( 0 .. $self->{arity} - 1 ) {
                    $term->{args}[$i]
                        = $self->{args}[$i]->refresh($term_aref);
                }
                return $term;
            }
        }
    }

    # else unbound
    unless ( $term_aref->[ $self->{varid} ] ) {
        $term_aref->[ $self->{varid} ] = $self->new;
    }
    return $term_aref->[ $self->{varid} ];
}

sub to_data {
    my $self = shift;
    $self->{_results} = {};

    # @results is the full results, if we ever need it
    my @results = $self->_to_data($self);
    return AsObject->new( $self->{_results} ), \@results;
}

sub _to_data {
    my ( $self, $parent ) = @_;
    if ( defined $self->{varname} ) {

        # XXX here's where the [HEAD|TAIL] bug is.  The engine works fine,
        # but we can't bind TAIL to a result object and are forced to
        # switch to raw_results.
        my $varname = delete $self->{varname};
        ( $parent->{_results}{$varname} ) = $self->_to_data($parent);
        $self->{varname} = $varname;
    }
    if ( $self->{bound} ) {
        my $functor = $self->functor;
        my $arity   = $self->arity;
        return $self->ref->_to_data($parent) if $self->{deref};
        return [] if NULL eq $functor && !$arity;
        if ( "cons" eq $functor && 2 == $arity ) {
            my @result = $self->{args}[0]->_to_data($parent);
            my $term   = $self->{args}[1];

            while ( "cons" eq $term->getfunctor && 2 == $term->getarity ) {
                if ( $term->{varname} ) {
                  push @result => $term->_to_data($parent);
                } else {
                  push @result => $term->getarg(0)->_to_data($parent);
                }
                $term = $term->getarg(1);
            }

            # XXX Not really sure about this one
            push @result => $term->_to_data($parent)
                unless NULL eq $term->getfunctor && !$term->getarity;

            #    ? "]"
            #    : "|" . $term->_to_data($parent) . "]";
            return \@result;
        }
        else {
            my @results = $self->functor;
            if ( $self->arity ) {

                #push @results => [];
                my $arity = $self->arity;
                my @args  = @{ $self->args };
                if (@args) {
                    for my $i ( 0 .. $arity - 1 ) {
                        push @results => $args[$i]->_to_data($parent);
                    }

                    # I have no idea what the following line was doing.
                    #push @results => $args[$arity - 1]->_to_data($parent)
                }
            }
            return @results;
        }
    }    # else unbound;
    return undef;
}

my %varname_for;
my $varname = 'A';

sub to_string {
    require Data::Dumper;
    my $self = shift;
    return $self->_to_string(@_);
}

sub _to_string {
    my ( $self, $extended ) = @_;
    if ( $self->{bound} ) {
        my $functor     = $self->functor;
        my $arity       = $self->arity;
        my $prettyprint = $self->prettyprint;
        return $self->ref->_to_string($extended) if $self->{deref};
        return "[]" if NULL eq $functor && !$arity && $prettyprint;
        my $string;
        if ( "cons" eq $functor && 2 == $arity && $prettyprint ) {
            $string = "[" . $self->{args}[0]->_to_string;
            my $term = $self->{args}[1];

            while ( "cons" eq $term->getfunctor && 2 == $term->getarity ) {
                $string .= "," . $term->getarg(0)->_to_string;
                $term = $term->getarg(1);
            }

            $string .=
                ( NULL eq $term->getfunctor && !$term->getarity )
                ? "]"
                : "|" . $term->_to_string . "]";
            return "$string";
        }
        else {
            $string = $self->functor;
            if ( $self->arity ) {
                $string .= "(";
                if ( $self->arity ) {
                    local $Data::Dumper::Terse  = 1;    # don't use $var1
                    local $Data::Dumper::Indent = 0;    # no newline
                    my @args = map {
                        my $string = $_->_to_string;
                        $string =~ /\s/
                            && !$_->arity
                            ? Data::Dumper::Dumper($string)
                            : $string;
                    } @{ $self->args };
                    $string .= join ", " => @args;
                }
                $string .= ")";
            }
        }