view release on metacpan or  search on metacpan

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

            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";
        my @predicates = sort keys %DESCRIPTION_FOR;
        my $length     = length $LONGEST_PREDICATE;
        my $columns    = 5;
        my $format     = join '    ' => ("%-${length}s") x $columns;
        while (@predicates) {
            my @row;
            for ( 1 .. $columns ) {
                push @row => @predicates
                    ? shift @predicates
                    : '';
            }
            $HELP_OUTPUT .= sprintf $format => @row;
            $HELP_OUTPUT .= "\n";
        }
        $HELP_OUTPUT .= "\n";
    }
    AI::Prolog::Engine::_print($HELP_OUTPUT);
    CONTINUE;
};

$PRIMITIVES[32] = sub {    # help/1
    my ( $self, $term, $c ) = @_;
    my $predicate = $term->getarg(0)->to_string;
    _load_builtins();
    if ( my $description = $DESCRIPTION_FOR{$predicate} ) {
        AI::Prolog::Engine::_print($description);
    }
    else {
        AI::Prolog::Engine::_print("No help available for ($predicate)\n\n");
        $PRIMITIVES[31]->();
    }
    CONTINUE;
};

my $gensym_int = 0;
$PRIMITIVES[33] = sub {    # gemsym/1
    my ( $self, $term, $c ) = @_;
    my $t2 = Term->new( 'v' . $gensym_int++, 0 );
    return $t2->unify( $term->getarg(0), $self->{_stack} )
        ? CONTINUE
        : FAIL;
};

use constant UNDEFINED_SUBROUTINE_ERROR => do {
    eval {
        no strict 'refs';    ## no critic NoStrict
        &{'---'};
    };
    my $e = $@;

    # Undefined subroutine &main::--- called at .../Primitives.pm line 12.
    my ($msg) = $e =~ / \A
                        (.+)    # 'Undefined subroutine'
                        (?<=\s) # ' '
                        \S*     # &main::
                        ---/mx
        or die q[Perl's error message changed! Damn! Fix this regex.];

    $msg;
};

$PRIMITIVES[34] = sub {    # perlcall2/2
    my ( $self, $term ) = @_;

    # Get a function name...
    my $function_term = $term->getarg(0);
    if ( not $function_term->is_bound ) {
        return FAIL;
    }
    my $function_name = $function_term->to_string;

    # Lookup a fully qualified function name...
    my $function_ref;
    if ( $function_name =~ /[:\']/mx ) {
        $function_ref = $function_name;
    }
    elsif ( defined( my $package = $self->{_perlpackage} ) ) {