Skip to content

GitLab

L
lis.pl
Commit 4ce8ef4c authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files
Options

checkargs N list of numbers; results in more Builtin conversions

parent 07380576
Hide whitespace changes
Inline Side-by-side
Showing with 58 additions and 53 deletions
Builtin.pm
View file @ 4ce8ef4c
......@@ -565,85 +565,69 @@ sub Bfset {
}
sub Bplus {
my ($arglist) = @_;
my @args = checkargs($_[0], 'N');
my $sum = 0;
while (consp($arglist)) {
$sum += is_num(car($arglist));
$arglist = cdr($arglist);
while (@args) {
$sum += pop(@args);
}
return $sum;
}
sub Bminus {
my ($arglist) = @_;
my $value = is_num(car($arglist));
$arglist = cdr($arglist);
if ($arglist == $Nil) {
return -$value;
}
my $result = $value;
while (consp($arglist)) {
$result -= is_num(car($arglist));
$arglist = cdr($arglist);
my ($arg1, @more_args) = checkargs($_[0], 'nN');
return -$arg1 unless @more_args;
my $result = $arg1;
while (@more_args) {
$result -= pop(@more_args);
}
return $result;
}
sub Bmodulo {
my ($arglist) = @_;
my $result = is_num(car($arglist));
$arglist = cdr($arglist);
while (consp($arglist)) {
$result %= is_num(car($arglist));
$arglist = cdr($arglist);
my ($start, @more_args) = checkargs($_[0], 'nN');
while (@more_args) {
$start %= pop(@more_args);
}
return $result;
return $start;
}
sub Bproduct {
my ($arglist) = @_;
my (@args) = checkargs($_[0], 'N');
my $prod = 1;
while (consp($arglist)) {
$prod *= is_num(car($arglist));
$arglist = cdr($arglist);
while (@args) {
$prod *= pop(@args);
}
return $prod;
}
sub Bpower {
my ($arglist) = @_;
my $result = is_num(car($arglist));
$arglist = cdr($arglist);
while (consp($arglist)) {
$result **= is_num(car($arglist));
$arglist = cdr($arglist);
my ($base, @more_args) = checkargs($_[0], 'nN');
while (@more_args) {
$base **= pop(@more_args);
}
return $result;
return $base;
}
sub Bdivide {
my ($arglist) = @_;
my $result = is_num(car($arglist));
$arglist = cdr($arglist);
if (is_nil($arglist)) {
return 1 / $result;
my ($start, @more_args) = checkargs($_[0], 'nN');
unless (@more_args) {
return 1 / $start;
}
while (consp($arglist)) {
$result /= is_num(car($arglist));
$arglist = cdr($arglist);
while (@more_args) {
$start /= pop(@more_args);
}
return $result;
return $start;
}
sub Bdiv {
my ($arglist) = @_;
my $result = is_num(car($arglist));
$arglist = cdr($arglist);
while (consp($arglist)) {
$result = int($result / is_num(car($arglist)));
$arglist = cdr($arglist);
my ($start, @more_args) = checkargs($_[0], 'nN');
unless (@more_args) {
return 1 / $start;
}
return $result;
while (@more_args) {
$start = int($start / pop(@more_args));
}
return $start;
}
sub Band {
......@@ -683,7 +667,7 @@ sub Bfunction {
sub Bquote {
my ($arg) = checkargs($_[0], 'e');
return is_def($arg);
return $arg;
}
sub Bdump {
......@@ -691,6 +675,13 @@ sub Bdump {
return Dumper($arg);
}
sub Bperl {
my ($expr) = checkargs($_[0], 'S');
my $result = eval $expr;
return error($@) if $@;
return $result;
}
sub Bnum_equal {
my ($arglist) = @_;
my $val1 = is_num(car($arglist));
......@@ -986,6 +977,8 @@ my @builtins = # [name, func, is_special, doc]
"return a random number a with 0 <= a < LIMIT (or 1)"],
["read", \&Bread, 0,
"return an expression read from stdin or &optional INPUT (a string)"],
["perl", \&Bperl, 0,
"evaluate the ARG string as Perl code and return the result"],
);
for my $b (@builtins) {
......
Util.pm
View file @ 4ce8ef4c
......@@ -45,6 +45,7 @@ sub arg_type_error {
# S: convert to string
# r: rest of the arglist as list
# R: rest of the arglist converted to array
# N: rest of the arglist as numbers, converted to array
sub checkargs {
my ($arglist, $descriptor) = @_;
my @result = ();
......@@ -57,6 +58,17 @@ sub checkargs {
push(@result, list2array($arglist));
last;
}
if ($desc eq 'N') {
while (consp($arglist)) {
my $arg;
($arg, $arglist) = cxr($arglist);
$argno++;
arg_type_error($argno, "number", $arg)
unless numberp($arg);
push(@result, $arg);
}
last;
}
if ($desc eq 'r') {
#warn("checkargs: set $desc to ", &$Princs($arglist));
push(@result, $arglist);
......
tests/021-incfdecf.lisp
View file @ 4ce8ef4c
......@@ -3,23 +3,23 @@
(m 7.25)
(o -123456))
(testcmp "incf 1" '(progn (incf n)
n)
n)
"5")
(testcmp "incf 2" '(incf n) "6")
(testcmp "incf 3" '(incf n 3) "9")
(testcmp "incf 4" '(progn (errset (incf n 'b))
*last-error*)
"not a number: b")
"argument 2 to builtin function plus is not a number: b")
(testcmp "incf 5" '(incf m) "8.25")
(testcmp "incf 6" '(incf o (- 3)) "-123459")
(testcmp "decf 1" '(progn (decf n)
n)
n)
"8")
(testcmp "decf 2" '(decf n) "7")
(testcmp "decf 3" '(decf n 3) "4")
(testcmp "decf 4" '(progn (errset (decf n 'b))
*last-error*)
"not a number: b")
"argument 2 to builtin function minus is not a number: b")
(testcmp "decf 5" '(decf m) "7.25")
(testcmp "decf 6" '(decf o (- 3)) "-123456")
)
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