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

moved numbers from long to long double; naively, for the moment

parent 603ba3bb
#include <math.h>
#include <string.h>
#include <stdlib.h>
#include <sys/time.h>
......@@ -381,14 +382,14 @@ obp_t bf_eql(int nargs, obp_t args, obp_t out_port, int level)
*/
obp_t bf_plus(int nargs, obp_t args, obp_t out_port, int level)
{
long value = 0;
long double value = 0;
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
CHECKTYPE_RET(out_port, arg, NUMBER);
value += AS(arg, NUMBER)->value;
args = CDR(args);
}
return new_integer(value);
return new_ldouble(value);
}
/**
......@@ -400,7 +401,7 @@ obp_t bf_minus(int nargs, obp_t args, obp_t out_port, int level)
obp_t first = CAR(args);
CHECKTYPE_RET(out_port, first, NUMBER);
long value = AS(first, NUMBER)->value;
long double value = AS(first, NUMBER)->value;
args = CDR(args);
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
......@@ -408,7 +409,7 @@ obp_t bf_minus(int nargs, obp_t args, obp_t out_port, int level)
value -= AS(arg, NUMBER)->value;
args = CDR(args);
}
return new_integer(value);
return new_ldouble(value);
}
/**
......@@ -417,14 +418,14 @@ obp_t bf_minus(int nargs, obp_t args, obp_t out_port, int level)
*/
obp_t bf_times(int nargs, obp_t args, obp_t out_port, int level)
{
long value = 1;
long double value = 1;
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
CHECKTYPE_RET(out_port, arg, NUMBER);
value *= AS(arg, NUMBER)->value;
args = CDR(args);
}
return new_integer(value);
return new_ldouble(value);
}
/**
......@@ -436,7 +437,7 @@ obp_t bf_divide(int nargs, obp_t args, obp_t out_port, int level)
obp_t start = CAR(args);
CHECKTYPE_RET(out_port, start, NUMBER);
long value = AS(start, NUMBER)->value;
long double value = AS(start, NUMBER)->value;
args = CDR(args);
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
......@@ -444,7 +445,7 @@ obp_t bf_divide(int nargs, obp_t args, obp_t out_port, int level)
value /= AS(arg, NUMBER)->value;
args = CDR(args);
}
return new_integer(value);
return new_ldouble(value);
}
/**
......@@ -456,12 +457,12 @@ 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 value = AS(start, NUMBER)->value;
long long value = AS(start, NUMBER)->value;
args = CDR(args);
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
CHECKTYPE_RET(out_port, arg, NUMBER);
value %= AS(arg, NUMBER)->value;
value %= lroundl(AS(arg, NUMBER)->value);
args = CDR(args);
}
return new_integer(value);
......@@ -499,7 +500,7 @@ obp_t bf_greater(int nargs, obp_t args, obp_t out_port, int level)
obp_t start = CAR(args);
CHECKTYPE_RET(out_port, start, NUMBER);
long value = AS(start, NUMBER)->value;
long double value = AS(start, NUMBER)->value;
args = CDR(args);
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
......@@ -526,7 +527,7 @@ obp_t bf_greatere(int nargs, obp_t args, obp_t out_port, int level)
obp_t start = CAR(args);
CHECKTYPE_RET(out_port, start, NUMBER);
long value = AS(start, NUMBER)->value;
long double value = AS(start, NUMBER)->value;
args = CDR(args);
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
......@@ -552,7 +553,7 @@ obp_t bf_less(int nargs, obp_t args, obp_t out_port, int level)
obp_t start = CAR(args);
CHECKTYPE_RET(out_port, start, NUMBER);
long value = AS(start, NUMBER)->value;
long double value = AS(start, NUMBER)->value;
args = CDR(args);
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
......@@ -577,7 +578,7 @@ obp_t bf_lesse(int nargs, obp_t args, obp_t out_port, int level)
obp_t start = CAR(args);
CHECKTYPE_RET(out_port, start, NUMBER);
long value = AS(start, NUMBER)->value;
long double value = AS(start, NUMBER)->value;
args = CDR(args);
while (!IS_NIL(args)) {
obp_t arg = CAR(args);
......
......@@ -355,6 +355,14 @@ obp_t new_integer(long value)
return (obp_t) ob;
}
obp_t new_ldouble(long double value)
{
Lnumber_t *ob = NEW_OBJ(NUMBER);
ob->value = value;
ob->obj.eq_is_eqv = 1;
return (obp_t) ob;
}
obp_t new_string(char *content, uint length)
{
Lstring_t *ob = NEW_OBJ2(STRING, sizeof(Lstring_t) + length);
......
......@@ -129,7 +129,7 @@ typedef struct PAIR { /* a cons cell */
typedef struct NUMBER { /* a number of any type */
Lobject_t obj;
long value; /* will be something else some day */
long double value; /* will be something else some day */
} Lnumber_t;
......@@ -248,6 +248,7 @@ obp_t new_object(uint size, int type);
obp_t new_pair(obp_t car, obp_t cdr);
#define new_pair0() new_pair(the_Nil, the_Nil)
obp_t new_integer(long value);
obp_t new_ldouble(long double value);
obp_t new_string(char *content, uint length);
obp_t new_zstring(char *zero_terminated_string);
obp_t new_char(int content);
......
......@@ -148,7 +148,7 @@ 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, "%ld", AS(ob, NUMBER)->value);
sprintf(tmp_buf, "%Lg", AS(ob, NUMBER)->value);
return strbuf_append(sb, tmp_buf);
}
......
......@@ -308,9 +308,9 @@ token_t make_atom(l_state_t state, reader_t rdr)
}
} else {
char *end;
long value = strtol(s, &end, 0);
long double value = strtold(s, &end);
if (end - s == len) {
rdr->tok_atom = new_integer(value);
rdr->tok_atom = new_ldouble(value);
return T_ISATOM;
}
rdr->tok_atom = intern(s, len);
......
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