Commit 3c48fb90 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

long/long double duality mostly completed including range checks for keeping...

long/long double duality mostly completed including range checks for keeping the integer property; new observation regarding gc noted in TODO
parent 7ae85a99
......@@ -20,6 +20,16 @@
@ garbage collection
> (fac 400)
[GC... 235 marked, 28730 freed, 4 alloced, 28734 visited]
Error: invalid argument count; invalid number of arguments, 0 not in [2..-1]: #<builtin:-:2..>
#904: (- n 1)
[...]
#3: (fac (- n 1))
#2: (* n (fac (- n 1)))
#1: (if (zerop n) 1 (* n (fac (- n 1))))
#0: Segmentation fault
@ lots of builtins (to be refined)
* strbuf functions
......
......@@ -11,7 +11,7 @@
#define __USE_POSIX
#define _GNU_SOURCE
#define NDEBUG
//#define NDEBUG
typedef unsigned int uint;
typedef unsigned char uchar;
......
#include "cbasics.h"
#include <math.h>
#include <limits.h>
#include "objects.h"
#include "signals.h"
#include "builtins.h"
......@@ -8,6 +9,8 @@
#include "numbers.h"
#define INTRANGE(value) ((value) >= LONG_MIN && (value) <= LONG_MAX)
/**
* Return the sum of all arguments, which must be numbers.
* (+ [n1 ...])
......@@ -20,7 +23,7 @@ obp_t bf_plus(int nargs, obp_t args, obp_t out_port, int level)
obp_t arg = CAR(args);
CHECKTYPE_RET(out_port, arg, NUMBER);
value += AS(arg, NUMBER)->value;
is_int &= IS_INT(arg);
is_int &= IS_INT(arg) && INTRANGE(value);
args = CDR(args);
}
obp_t newval = new_ldouble(value);
......@@ -44,7 +47,7 @@ obp_t bf_minus(int nargs, obp_t args, obp_t out_port, int level)
obp_t arg = CAR(args);
CHECKTYPE_RET(out_port, arg, NUMBER);
value -= AS(arg, NUMBER)->value;
is_int &= IS_INT(arg);
is_int &= IS_INT(arg) && INTRANGE(value);
args = CDR(args);
}
obp_t newval = new_ldouble(value);
......@@ -64,7 +67,7 @@ obp_t bf_times(int nargs, obp_t args, obp_t out_port, int level)
obp_t arg = CAR(args);
CHECKTYPE_RET(out_port, arg, NUMBER);
value *= AS(arg, NUMBER)->value;
is_int &= IS_INT(arg);
is_int &= IS_INT(arg) && INTRANGE(value);
args = CDR(args);
}
obp_t newval = new_ldouble(value);
......@@ -92,7 +95,7 @@ obp_t bf_divide(int nargs, obp_t args, obp_t out_port, int level)
args = CDR(args);
}
obp_t newval = new_ldouble(value);
IS_INT(newval) = is_int ? 1 : 0;
IS_INT(newval) = is_int;
return newval;
}
......@@ -105,15 +108,19 @@ obp_t bf_modulo(int nargs, obp_t args, obp_t out_port, int level)
obp_t start = CAR(args);
CHECKTYPE_RET(out_port, start, NUMBER);
long long value = AS(start, NUMBER)->value;
long double value = AS(start, NUMBER)->value;
int is_int = 1;
args = CDR(args);
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
CHECKTYPE_RET(out_port, arg, NUMBER);
value %= lroundl(AS(arg, NUMBER)->value);
value = fmodl(value, AS(arg, NUMBER)->value);
is_int &= IS_INT(arg) && remainderl(value, 1.0) == 0;
args = CDR(args);
}
return new_integer(value);
obp_t newval = new_ldouble(value);
IS_INT(newval) = is_int && remainderl(value, 1.0) == 0;
return newval;
}
/**
......
......@@ -7,6 +7,7 @@
#include "xmemory.h"
#include "io.h"
#include "functions.h"
#include "math.h"
typedef void (*printer_t)(obp_t ob, obp_t port);
......@@ -148,7 +149,11 @@ strbuf_t s_pair(obp_t ob, strbuf_t sb, int flags)
strbuf_t s_number(obp_t ob, strbuf_t sb, int flags)
{
sprintf(tmp_buf, "%Lg", AS(ob, NUMBER)->value);
if (IS_INT(ob)) {
sprintf(tmp_buf, "%ld", lrint(AS(ob, NUMBER)->value));
} else {
sprintf(tmp_buf, "%Lg", AS(ob, NUMBER)->value);
}
return strbuf_append(sb, tmp_buf);
}
......
Supports Markdown
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