artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: More informative error reporting for number asserts.

Browse source 
* src/math.c (assert_number): New function.  Update assert () users.
This commit is contained in:
Jan Nieuwenhuizen 2018-01-25 07:00:48 +01:00
parent da9d2247e0
commit 91070593e9
4 changed files with 33 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
module/mes/type-0.mes
View file

@ -63,7 +63,7 @@
(define (char? x) (define (char? x)
(and (eq? (core:type x) <cell:char>) (and (eq? (core:type x) <cell:char>)
(>= (char->integer x) 0))) (> (char->integer x) -1)))
(define (eof-object? x) (define (eof-object? x)
(and (eq? (core:type x) <cell:char>) (and (eq? (core:type x) <cell:char>)

2
src/lib.c
View file

@ -96,6 +96,8 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
x = CDR (x); x = CDR (x);
while (x != cell_nil && i++ < 10) while (x != cell_nil && i++ < 10)
{ {
g_depth = 1;
//display_helper (CAAR (x), 0, "", fd, write_p); fputs (" ", fd);
fdisplay_ (CAAR (x), fd, write_p); fputs (" ", fd); fdisplay_ (CAAR (x), fd, write_p); fputs (" ", fd);
x = CDR (x); x = CDR (x);
} }

48
src/math.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*- /* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software * Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of Mes. * This file is part of Mes.
* *
@ -20,13 +20,23 @@
#include <limits.h> #include <limits.h>
void
assert_number (char const* name, SCM x)
{
if (TYPE (x) != TNUMBER)
{
eputs (name);
error (cell_symbol_not_a_number, x);
}
}
SCM SCM
greater_p (SCM x) ///((name . ">") (arity . n)) greater_p (SCM x) ///((name . ">") (arity . n))
{ {
int n = INT_MAX; int n = INT_MAX;
while (x != cell_nil) while (x != cell_nil)
{ {
assert (TYPE (car (x)) == TNUMBER); assert_number ("greater_p", CAR (x));
if (VALUE (car (x)) >= n) return cell_f; if (VALUE (car (x)) >= n) return cell_f;
n = VALUE (car (x)); n = VALUE (car (x));
x = cdr (x); x = cdr (x);
@ -40,7 +50,7 @@ less_p (SCM x) ///((name . "<") (arity . n))
int n = INT_MIN; int n = INT_MIN;
while (x != cell_nil) while (x != cell_nil)
{ {
assert (TYPE (car (x)) == TNUMBER); assert_number ("less_p", CAR (x));
if (VALUE (car (x)) <= n) return cell_f; if (VALUE (car (x)) <= n) return cell_f;
n = VALUE (car (x)); n = VALUE (car (x));
x = cdr (x); x = cdr (x);
@ -52,8 +62,8 @@ SCM
is_p (SCM x) ///((name . "=") (arity . n)) is_p (SCM x) ///((name . "=") (arity . n))
{ {
if (x == cell_nil) return cell_t; if (x == cell_nil) return cell_t;
assert (TYPE (car (x)) == TNUMBER); assert_number ("is_p", CAR (x));
int n = VALUE (car (x)); int n = VALUE (CAR (x));
x = cdr (x); x = cdr (x);
while (x != cell_nil) while (x != cell_nil)
{ {
@ -66,15 +76,15 @@ is_p (SCM x) ///((name . "=") (arity . n))
SCM SCM
minus (SCM x) ///((name . "-") (arity . n)) minus (SCM x) ///((name . "-") (arity . n))
{ {
SCM a = car (x); assert_number ("minus", CAR (x));
assert (TYPE (a) == TNUMBER); SCM a = CAR (x);
int n = VALUE (a); int n = VALUE (a);
x = cdr (x); x = cdr (x);
if (x == cell_nil) if (x == cell_nil)
n = -n; n = -n;
while (x != cell_nil) while (x != cell_nil)
{ {
assert (TYPE (car (x)) == TNUMBER); assert_number ("minus", CAR (x));
n -= VALUE (car (x)); n -= VALUE (car (x));
x = cdr (x); x = cdr (x);
} }
@ -87,7 +97,7 @@ plus (SCM x) ///((name . "+") (arity . n))
int n = 0; int n = 0;
while (x != cell_nil) while (x != cell_nil)
{ {
assert (TYPE (car (x)) == TNUMBER); assert_number ("plus", CAR (x));
n += VALUE (car (x)); n += VALUE (car (x));
x = cdr (x); x = cdr (x);
} }
@ -99,13 +109,13 @@ divide (SCM x) ///((name . "/") (arity . n))
{ {
int n = 1; int n = 1;
if (x != cell_nil) { if (x != cell_nil) {
assert (TYPE (car (x)) == TNUMBER); assert_number ("divide", CAR (x));
n = VALUE (car (x)); n = VALUE (car (x));
x = cdr (x); x = cdr (x);
} }
while (x != cell_nil) while (x != cell_nil)
{ {
assert (TYPE (car (x)) == TNUMBER); assert_number ("divide", CAR (x));
n /= VALUE (car (x)); n /= VALUE (car (x));
x = cdr (x); x = cdr (x);
} }
@ -115,8 +125,8 @@ divide (SCM x) ///((name . "/") (arity . n))
SCM SCM
modulo (SCM a, SCM b) modulo (SCM a, SCM b)
{ {
assert (TYPE (a) == TNUMBER); assert_number ("modulo", a);
assert (TYPE (b) == TNUMBER); assert_number ("modulo", b);
int x = VALUE (a); int x = VALUE (a);
while (x < 0) x += VALUE (b); while (x < 0) x += VALUE (b);
return MAKE_NUMBER (x % VALUE (b)); return MAKE_NUMBER (x % VALUE (b));
@ -128,7 +138,7 @@ multiply (SCM x) ///((name . "*") (arity . n))
int n = 1; int n = 1;
while (x != cell_nil) while (x != cell_nil)
{ {
assert (TYPE (car (x)) == TNUMBER); assert_number ("multiply", CAR (x));
n *= VALUE (car (x)); n *= VALUE (car (x));
x = cdr (x); x = cdr (x);
} }
@ -141,7 +151,7 @@ logand (SCM x) ///((arity . n))
int n = 0; int n = 0;
while (x != cell_nil) while (x != cell_nil)
{ {
assert (TYPE (car (x)) == TNUMBER); assert_number ("multiply", CAR (x));
n &= VALUE (car (x)); n &= VALUE (car (x));
x = cdr (x); x = cdr (x);
} }
@ -154,7 +164,7 @@ logior (SCM x) ///((arity . n))
int n = 0; int n = 0;
while (x != cell_nil) while (x != cell_nil)
{ {
assert (TYPE (car (x)) == TNUMBER); assert_number ("logior", CAR (x));
n |= VALUE (car (x)); n |= VALUE (car (x));
x = cdr (x); x = cdr (x);
} }
@ -164,7 +174,7 @@ logior (SCM x) ///((arity . n))
SCM SCM
lognot (SCM x) lognot (SCM x)
{ {
assert (TYPE (x) == TNUMBER); assert_number ("lognot", x);
int n = ~VALUE (x); int n = ~VALUE (x);
return MAKE_NUMBER (n); return MAKE_NUMBER (n);
} }
@ -172,8 +182,8 @@ lognot (SCM x)
SCM SCM
ash (SCM n, SCM count) ash (SCM n, SCM count)
{ {
assert (TYPE (n) == TNUMBER); assert_number ("ash", n);
assert (TYPE (count) == TNUMBER); assert_number ("ash", count);
int cn = VALUE (n); int cn = VALUE (n);
int ccount = VALUE (count); int ccount = VALUE (count);
return MAKE_NUMBER ((ccount < 0) ? cn >> -ccount : cn << ccount); return MAKE_NUMBER ((ccount < 0) ? cn >> -ccount : cn << ccount);

1
src/mes.c
View file

@ -160,6 +160,7 @@ struct scm scm_symbol_write = {TSYMBOL, "write",0};
struct scm scm_symbol_display = {TSYMBOL, "display",0}; struct scm scm_symbol_display = {TSYMBOL, "display",0};
struct scm scm_symbol_throw = {TSYMBOL, "throw",0}; struct scm scm_symbol_throw = {TSYMBOL, "throw",0};
struct scm scm_symbol_not_a_number = {TSYMBOL, "not-a-number",0};
struct scm scm_symbol_not_a_pair = {TSYMBOL, "not-a-pair",0}; struct scm scm_symbol_not_a_pair = {TSYMBOL, "not-a-pair",0};
struct scm scm_symbol_system_error = {TSYMBOL, "system-error",0}; struct scm scm_symbol_system_error = {TSYMBOL, "system-error",0};
struct scm scm_symbol_wrong_number_of_args = {TSYMBOL, "wrong-number-of-args",0}; struct scm scm_symbol_wrong_number_of_args = {TSYMBOL, "wrong-number-of-args",0};