view release on metacpan or  search on metacpan

lib/AI/Prolog/Engine/Primitives.pm  view on Meta::CPAN

    return CONTINUE;
};

$PRIMITIVES[7] = sub {    # retract/1
    my ( $self, $term, $c ) = @_;
    if ( not $self->{_db}->retract( $term->getarg(0), $self->{_stack} ) ) {
        $self->backtrack;
        return FAIL;
    }
    $self->{_cp}->clause( $self->{_retract_clause} )
        ;                 # if $self->{_cp}; # doesn't work
    return CONTINUE;
};

$PRIMITIVES[8] = sub {    # listing/0
    my $self = shift;
    $self->{_db}->dump(0);
    return CONTINUE;
};

$PRIMITIVES[9] = sub {    # listing/1
    my ( $self, $term, $c ) = @_;
    my $predicate = $term->getarg(0)->getfunctor;
    $self->{_db}->list($predicate);
    return CONTINUE;
};

$PRIMITIVES[10] = sub {    # print/1
    my ( $self, $term, $c ) = @_;
    AI::Prolog::Engine::_print( $term->getarg(0)->to_string );
    return CONTINUE;
};

$PRIMITIVES[11] = sub {    # println/1
    my ( $self, $term, $c ) = @_;
    AI::Prolog::Engine::_print( $term->getarg(0)->to_string . "\n" );
    return CONTINUE;
};

$PRIMITIVES[12] = sub { AI::Prolog::Engine::_print("\n"); CONTINUE };    # nl

$PRIMITIVES[13] = sub {    # trace. notrace.
    my ( $self, $term ) = @_;
    $self->{_trace} = $term->getfunctor eq 'trace';
    AI::Prolog::Engine::_print(
        'Trace ' . ( $self->{_trace} ? 'ON' : 'OFF' ) );
    return CONTINUE;
};

$PRIMITIVES[15] = sub {    # is/2
    my ( $self, $term, $c ) = @_;
    my $rhs = $term->getarg(0)->deref;
    my $lhs = $term->getarg(1)->value;
    if ( $rhs->is_bound ) {
        my $value = $rhs->value;
        if ( not looks_like_number($value) ) {
            return FAIL;
        }
        return $value == $lhs;
    }
    $rhs->bind( Number->new($lhs) );
    push @{ $self->{_stack} } => $rhs;
    return CONTINUE;
};

$PRIMITIVES[16] = sub {    # gt/2
    my ( $self, $term ) = @_;
    return ( $term->getarg(0)->value > $term->getarg(1)->value )
        ? CONTINUE
        : FAIL;
};

$PRIMITIVES[17] = sub {    # lt/2
    my ( $self, $term ) = @_;
    return ( $term->getarg(0)->value < $term->getarg(1)->value )
        ? CONTINUE
        : FAIL;
};

$PRIMITIVES[19] = sub {    # ge/2
    my ( $self, $term ) = @_;
    return ( $term->getarg(0)->value >= $term->getarg(1)->value )
        ? CONTINUE
        : FAIL;
};

$PRIMITIVES[20] = sub {    # le/2
    my ( $self, $term ) = @_;
    return ( $term->getarg(0)->value <= $term->getarg(1)->value )
        ? CONTINUE
        : FAIL;
};

$PRIMITIVES[22] = sub {    # halt/0
    my ( $self, $term ) = @_;
    $self->halt(1);
    CONTINUE;
};

$PRIMITIVES[23] = sub {    # var/1
    my ( $self, $term, $c ) = @_;
    return $term->getarg(0)->bound() ? FAIL : CONTINUE;
};

# plus(X,Y)  := 25.
# minux(X,Y) := 26.
# mult(X,Y)  := 27.
# div(X,Y)   := 28.
# mod(X,Y)   := 29.

$PRIMITIVES[30] = sub {    # seq/1
    my ( $self, $term, $c ) = @_;
    $self->_splice_goal_list($term);
    CONTINUE;
};

my $HELP_OUTPUT;
$PRIMITIVES[31] = sub {    # help/0
    _load_builtins();
    if ( not $HELP_OUTPUT ) {
        $HELP_OUTPUT = "Help is available for the following builtins:\n\n";