view release on metacpan or  search on metacpan

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

        # 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 .= ")";
            }
        }
        return $string;
    }    # else unbound;
         # return "_" . $self->varid;
    my $var = $self->{varname} || $varname_for{ $self->varid } || $varname++;
    $varname_for{ $self->varid } = $var;
    return $var;
}

# ----------------------------------------------------------
#  Copy a term to put in the database
#    - with new variables (freshly renumbered)
# ----------------------------------------------------------

# XXX XProlog
my %CVDICT;
my $CVN;

sub clean_up {
    my $self = shift;
    %CVDICT = ();
    $CVN    = 0;
    return $self->_clean_up;
}

sub _clean_up {
    my $self = shift;
    my $term;
    if ( $self->{bound} ) {
        if ( $self->{deref} ) {
            return $self->{ref}->_clean_up;
        }
        elsif ( defined $self->{arity} && 0 == $self->{arity} ) {
            return $self;
        }
        else {
            $term = $self->dup;
            for my $i ( 0 .. $self->{arity} - 1 ) {
                $term->{args}[$i] = $self->{args}[$i]->_clean_up;
            }
        }
    }
    else {    # unbound
        $term = $CVDICT{$self};
        unless ($term) {
            $term = $self->new( $CVN++ );
            $CVDICT{$self} = $term;    # XXX Should this be $self->to_string?
        }
    }
    return $term;
}

# From XProlog
sub value {