Commit 8a46ffb3 authored by Juergen Nickelsen's avatar Juergen Nickelsen

eliminate is_cons and is_num; applied checkargs 'N' where possible

parent d1302203
......@@ -699,31 +699,18 @@ sub Bperl {
}
sub Bnum_equal {
my ($arglist) = @_;
my $val1 = is_num(car($arglist));
#debug("val1 is %s", $val1);
$arglist = cdr($arglist);
while (consp($arglist)) {
my $arg;
($arg, $arglist) = cxr($arglist);
my $val2 = is_num($arg);
#debug("val1 is %s", $val1);
#debug("val2 is %s arglist %s", $val2, $arglist);
my ($val1, @args) = checkargs($_[0], 'nN');
while (defined(my $val2 = pop(@args))) {
return $Nil unless $val1 == $val2;
}
return $T;
}
sub Bnum_less {
my ($arglist) = @_;
my $val = is_num(car($arglist));
$arglist = cdr($arglist);
while (consp($arglist)) {
my $arg;
($arg, $arglist) = cxr($arglist);
my $newval = is_num($arg);
return $Nil unless $val < $newval;
$val = $newval;
my ($val1, @args) = checkargs($_[0], 'nN');
while (defined(my $val2 = pop(@args))) {
return $Nil unless $val1 < $val2;
$val1 = $val2;
}
return $T;
}
......
......@@ -16,8 +16,8 @@ use Exporter ();
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw( is_def is_sym is_cons is_list is_num tornil is_string
array2list list2array checkargs
@EXPORT = qw( is_def is_sym is_list tornil array2list list2array
checkargs
);
}
......@@ -159,14 +159,6 @@ sub is_sym {
return $arg;
}
# value is defined and a pair
sub is_cons {
my ($arg) = @_;
return error("undefined argument") unless defined($arg);
return error("not a pair: %s", $arg) unless consp($arg);
return $arg;
}
# value is defined and a list
sub is_list {
my ($arg) = @_;
......@@ -175,21 +167,6 @@ sub is_list {
return $arg;
}
# value is defined and a number
sub is_num {
my ($arg) = @_;
return error("undefined argument") unless defined($arg);
return error("not a number: %s", $arg) unless numberp($arg);
return $arg;
}
sub is_string {
my ($arg) = @_;
return error("undefined argument") unless defined($arg);
return error("not a string: %s", $arg) unless stringp($arg);
return $arg;
}
# convert Perl truth value to Lisp t or nil
sub tornil {
my ($arg) = @_;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment