checkargs N list of numbers; results in more Builtin conversions

Builtin.pm

@@ -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

@@ -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

@@ -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")
   )