diff --git a/module/mes/type-0.mes b/module/mes/type-0.mes index 6b709cfe..c98f8113 100644 --- a/module/mes/type-0.mes +++ b/module/mes/type-0.mes @@ -63,7 +63,7 @@ (define (char? x) (and (eq? (core:type x) ) - (>= (char->integer x) 0))) + (> (char->integer x) -1))) (define (eof-object? x) (and (eq? (core:type x) ) diff --git a/src/lib.c b/src/lib.c index f7296c7e..ec1702b0 100644 --- a/src/lib.c +++ b/src/lib.c @@ -96,6 +96,8 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p) x = CDR (x); 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); x = CDR (x); } diff --git a/src/math.c b/src/math.c index 1e9df4da..4117d1aa 100644 --- a/src/math.c +++ b/src/math.c @@ -1,6 +1,6 @@ /* -*-comment-start: "//";comment-end:""-*- * Mes --- Maxwell Equations of Software - * Copyright © 2016,2017 Jan Nieuwenhuizen + * Copyright © 2016,2017,2018 Jan Nieuwenhuizen * * This file is part of Mes. * @@ -20,13 +20,23 @@ #include +void +assert_number (char const* name, SCM x) +{ + if (TYPE (x) != TNUMBER) + { + eputs (name); + error (cell_symbol_not_a_number, x); + } +} + SCM greater_p (SCM x) ///((name . ">") (arity . n)) { int n = INT_MAX; while (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("greater_p", CAR (x)); if (VALUE (car (x)) >= n) return cell_f; n = VALUE (car (x)); x = cdr (x); @@ -40,7 +50,7 @@ less_p (SCM x) ///((name . "<") (arity . n)) int n = INT_MIN; while (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("less_p", CAR (x)); if (VALUE (car (x)) <= n) return cell_f; n = VALUE (car (x)); x = cdr (x); @@ -52,8 +62,8 @@ SCM is_p (SCM x) ///((name . "=") (arity . n)) { if (x == cell_nil) return cell_t; - assert (TYPE (car (x)) == TNUMBER); - int n = VALUE (car (x)); + assert_number ("is_p", CAR (x)); + int n = VALUE (CAR (x)); x = cdr (x); while (x != cell_nil) { @@ -66,15 +76,15 @@ is_p (SCM x) ///((name . "=") (arity . n)) SCM minus (SCM x) ///((name . "-") (arity . n)) { - SCM a = car (x); - assert (TYPE (a) == TNUMBER); + assert_number ("minus", CAR (x)); + SCM a = CAR (x); int n = VALUE (a); x = cdr (x); if (x == cell_nil) n = -n; while (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("minus", CAR (x)); n -= VALUE (car (x)); x = cdr (x); } @@ -87,7 +97,7 @@ plus (SCM x) ///((name . "+") (arity . n)) int n = 0; while (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("plus", CAR (x)); n += VALUE (car (x)); x = cdr (x); } @@ -99,13 +109,13 @@ divide (SCM x) ///((name . "/") (arity . n)) { int n = 1; if (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("divide", CAR (x)); n = VALUE (car (x)); x = cdr (x); } while (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("divide", CAR (x)); n /= VALUE (car (x)); x = cdr (x); } @@ -115,8 +125,8 @@ divide (SCM x) ///((name . "/") (arity . n)) SCM modulo (SCM a, SCM b) { - assert (TYPE (a) == TNUMBER); - assert (TYPE (b) == TNUMBER); + assert_number ("modulo", a); + assert_number ("modulo", b); int x = VALUE (a); while (x < 0) x += VALUE (b); return MAKE_NUMBER (x % VALUE (b)); @@ -128,7 +138,7 @@ multiply (SCM x) ///((name . "*") (arity . n)) int n = 1; while (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("multiply", CAR (x)); n *= VALUE (car (x)); x = cdr (x); } @@ -141,7 +151,7 @@ logand (SCM x) ///((arity . n)) int n = 0; while (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("multiply", CAR (x)); n &= VALUE (car (x)); x = cdr (x); } @@ -154,7 +164,7 @@ logior (SCM x) ///((arity . n)) int n = 0; while (x != cell_nil) { - assert (TYPE (car (x)) == TNUMBER); + assert_number ("logior", CAR (x)); n |= VALUE (car (x)); x = cdr (x); } @@ -164,7 +174,7 @@ logior (SCM x) ///((arity . n)) SCM lognot (SCM x) { - assert (TYPE (x) == TNUMBER); + assert_number ("lognot", x); int n = ~VALUE (x); return MAKE_NUMBER (n); } @@ -172,8 +182,8 @@ lognot (SCM x) SCM ash (SCM n, SCM count) { - assert (TYPE (n) == TNUMBER); - assert (TYPE (count) == TNUMBER); + assert_number ("ash", n); + assert_number ("ash", count); int cn = VALUE (n); int ccount = VALUE (count); return MAKE_NUMBER ((ccount < 0) ? cn >> -ccount : cn << ccount); diff --git a/src/mes.c b/src/mes.c index 603ace0c..743e298f 100644 --- a/src/mes.c +++ b/src/mes.c @@ -160,6 +160,7 @@ struct scm scm_symbol_write = {TSYMBOL, "write",0}; struct scm scm_symbol_display = {TSYMBOL, "display",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_system_error = {TSYMBOL, "system-error",0}; struct scm scm_symbol_wrong_number_of_args = {TSYMBOL, "wrong-number-of-args",0};