view release on metacpan or  search on metacpan

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

    if ( $self->{bound} && !$self->{deref} ) {
        $self->{args}[$pos] = $val;
    }
    else {
        croak(    "AI::Prolog::Term->setarg($pos, "
                . $val->to_string
                . ").  Cannot setarg on variables!" );
    }
}

# retrieves an argument of a term
sub getarg {
    my ( $self, $pos ) = @_;

    # should check if position is valid
    if ( $self->{bound} ) {
        return $self->{ref}->getarg($pos) if $self->{deref};
        return $self->{args}[$pos];
    }
    else {
        croak("AI::Prolog::Term->getarg.  Error -- lookup on unbound term!");
    }
}

sub getfunctor {
    my $self = shift;
    return "" unless $self->{bound};
    return $self->{ref}->getfunctor if $self->{deref};
    return $self->{functor};
}

sub getarity {
    my $self = shift;
    return 0 unless $self->{bound};
    return $self->{ref}->getarity if $self->{deref};
    return $self->{arity};
}

# check whether a variable occurs in a term
# XXX Since a variable is not consideref to occur in itself,
# XXX added occurs1 and a new front end called occurs()
sub occurs {
    my ( $self, $var ) = @_;
    return if $self->{varid} == $var;
    return $self->occurs1($var);
}

sub occurs1 {
    my ( $self, $var ) = @_;
    if ( $self->{bound} ) {
        return $self->ref->occurs1($var) if $self->{deref};
        for my $i ( 0 .. $self->arity - 1 ) {
            return 1 if $self->{args}[$i]->occurs1($var);
        }
    }
    else {
        return $self->varid == $var;
    }
}

# used internally for debugging
sub _dumpit {
    local $^W;
    my $self = shift;
    my $indent = shift || '';
    print( $indent . "source:  ", $self->{source} );
    print( $indent . "bound:  ", ( $self->{bound} ? 'true' : 'false' ) );
    print( $indent . "functor:  ", ( $self->{functor} || 'null' ) );
    if ( !$self->{ref} ) {
        print( $indent . "ref:  null" );
    }
    else {
        print( "\n$indent" . "ref:" );
        $self->{ref}->_dumpit( $indent . '  ' );
    }
    print( $indent . "arity:  ", $self->{arity} );
    if ( defined $self->{args}[0] ) {
        print( $indent. "args:" );
        foreach ( @{ $self->{args} } ) {
            $_->_dumpit( $indent . "  " );
        }
    }
    else {
        print( $indent. "args:  null" );
    }

#print($indent . "args:  ", scalar @{$self->{args}}) if defined $self->{args}[0];
    print( $indent . "deref:  ", ( $self->{deref} ? 'true' : 'false' ) );
    print( $indent . "varid:  ", $self->{varid}, "\n" );
}

# Unification is the basic primitive operation in logic programming.
# $stack: the stack is used to store the address of variables which
# are bound by the unification.  This is needed when backtracking.

sub unify {
    my ( $self, $term, $stack ) = @_;

    #_dumpit($self);
    #_dumpit($term);

    foreach ( $self, $term ) {
        $_ = $_->{ref} while $_->{bound} and $_->{deref};
    }

    if ( $self->{bound} and $term->{bound} ) {    # bound and not deref
        if (   $self->functor eq $term->getfunctor
            && $self->arity == $term->getarity )
        {
            for my $i ( 0 .. $self->arity - 1 ) {
                return
                    unless $self->{args}[$i]
                    ->unify( $term->getarg($i), $stack );
            }
            return 1;
        }
        else {
            return;    # functor/arity don't match ...
        }
    }    # at least one arg not bound ...
    if ( $self->{bound} ) {