Commit 4ce8ef4c authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

checkargs N list of numbers; results in more Builtin conversions

parent 07380576

Builtin.pm

+42 −49
Original line number Diff line number Diff line
@@ -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

+12 −0
Original line number Diff line number Diff line
@@ -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

+4 −4
Original line number Diff line number Diff line
@@ -9,7 +9,7 @@ 
  (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)
@@ -19,7 +19,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")

  )