summaryrefslogtreecommitdiff
path: root/liblali.c
diff options
context:
space:
mode:
Diffstat (limited to 'liblali.c')
-rw-r--r--liblali.c192
1 files changed, 115 insertions, 77 deletions
diff --git a/liblali.c b/liblali.c
index 78872fd..80d27fc 100644
--- a/liblali.c
+++ b/liblali.c
@@ -223,9 +223,9 @@ Object *newObjectFrom(Object **from, GC_PARAM) {
return object;
}
-Object *newNumber(double number, GC_PARAM) {
+Object *newNumber(char *number, GC_PARAM) {
Object *object = newObject(TYPE_NUMBER, GC_ROOTS);
- object->number = number;
+ strcpy(object->string, number);
return object;
}
@@ -545,15 +545,17 @@ Object *readNumberOrSymbol(Stream *stream, GC_PARAM) {
if (isdigit(ch))
ch = readWhile(stream, isdigit);
if (!isSymbolChar(ch))
- return newSymbolWithLength(TYPE_NUMBER, stream->buffer + offset,
- stream->offset - offset, GC_ROOTS);
+ return newSymbolWithLength(TYPE_NUMBER,
+ stream->buffer + offset,
+ stream->offset - offset, GC_ROOTS);
if (ch == '.') {
ch = streamGetc(stream);
if (isdigit(streamPeek(stream))) {
ch = readWhile(stream, isdigit);
if (!isSymbolChar(ch))
- return newSymbolWithLength(TYPE_NUMBER, stream->buffer + offset,
- stream->offset - offset, GC_ROOTS);
+ return newSymbolWithLength(TYPE_NUMBER,
+ stream->buffer + offset,
+ stream->offset - offset, GC_ROOTS);
}
}
}
@@ -561,7 +563,8 @@ Object *readNumberOrSymbol(Stream *stream, GC_PARAM) {
// non-numeric character encountered, read a symbol
readWhile(stream, isSymbolChar);
- return newSymbolWithLength(TYPE_SYMBOL, stream->buffer + offset,
+ return newSymbolWithLength(TYPE_SYMBOL,
+ (stream->buffer + offset),
stream->offset - offset, GC_ROOTS);
}
@@ -670,14 +673,36 @@ Object *readExpr(Stream *stream, GC_PARAM) {
// WRITING OBJECTS ////////////////////////////////////////////////////////////
+char *removeZeroPadding(char *string) {
+ size_t length = 0;
+ bool floatingPoint = false;
+ for (; string[length] != '\0'; length++)
+ if (string[length] == '.')
+ floatingPoint = true;
+
+ if (!floatingPoint)
+ return string;
+
+ size_t i = length - 1;
+ for (; string[i] == '0'; i--)
+ ;
+ if (i == 1)
+ string[i] = '0';
+ else if (string[i] == '.')
+ i--;
+
+ string[i+1] = '\0';
+ return string;
+}
+
void writeObject(Object *object, bool readably, FILE *file) {
switch (object->type) {
#define CASE(type, ...) \
case type: \
fprintf(file, __VA_ARGS__); \
break
+ CASE(TYPE_NUMBER, "%s", removeZeroPadding(object->string));
/* CASE(TYPE_NUMBER, (object->number < 0) ? "%g" : "+%g", object->number); */
- CASE(TYPE_NUMBER, "%s", object->string);
CASE(TYPE_SYMBOL, "%s", object->string);
CASE(TYPE_PRIMITIVE, "#<Primitive %s>", object->name);
#undef CASE
@@ -901,8 +926,10 @@ Object *primitiveTime(Object **args, GC_PARAM) {
GC_TRACE(gcSymbol, nil);
GC_TRACE(gcCons, nil);
+ char number[7];
- *gcSymbol = newNumber(today->tm_gmtoff, GC_ROOTS);
+ sprintf(number, "+%ld", today->tm_gmtoff);
+ *gcSymbol = newNumber(number, GC_ROOTS);
*gcCons = newCons(gcSymbol, gcCons, GC_ROOTS);
*gcCons = newCons(today->tm_isdst ? &t : &f, gcCons, GC_ROOTS);
@@ -912,7 +939,8 @@ Object *primitiveTime(Object **args, GC_PARAM) {
};
for (int i = 0; i < 7; i++) {
- *gcSymbol = newNumber(tmp[i], GC_ROOTS);
+ sprintf(number, "+%d", tmp[i]);
+ *gcSymbol = newNumber(number, GC_ROOTS);
*gcCons = newCons(gcSymbol, gcCons, GC_ROOTS);
}
@@ -920,73 +948,83 @@ Object *primitiveTime(Object **args, GC_PARAM) {
}
Object *primitiveRandom(Object **args, GC_PARAM) {
- srandom((unsigned int)(seed + time(NULL)));
- double number = (double)random();
- seed = (unsigned int)number;
+ srandom((unsigned int)(seed + time(NULL)));
+ long nrandom = random();
+ seed = (unsigned int)nrandom;
+ char string[22];
- if (*args == nil)
- return newNumber(number, GC_ROOTS);
- else
- return
- newNumber(((unsigned int)number % (unsigned int)(*args)->car->number),
- GC_ROOTS);
-}
-
-#define DEFINE_PRIMITIVE_ARITHMETIC(name, op, init, datatype) \
- Object *name(Object **args, GC_PARAM) { \
- if (*args == nil) \
- return newNumber(init, GC_ROOTS); \
- else if ((*args)->car->type != TYPE_NUMBER) \
- exceptionWithObject((*args)->car, "is not a number"); \
- else { \
- Object *object, *rest; \
- \
- if ((*args)->cdr == nil) { \
- object = newNumber(init, GC_ROOTS); \
- rest = *args; \
- } else { \
- GC_TRACE(gcFirst, (*args)->car); \
- object = newObjectFrom(gcFirst, GC_ROOTS); \
- rest = (*args)->cdr; \
- } \
- \
- for (; rest != nil; rest = rest->cdr) { \
- if (rest->car->type != TYPE_NUMBER) \
- exceptionWithObject(rest->car, "is not a number"); \
- \
- object->number = \
- (datatype)object->number op (datatype)rest->car->number; \
- } \
- \
- return object; \
- } \
+ if (*args == nil)
+ sprintf(string, "+%ld", nrandom);
+ else
+ sprintf(string, "+%ld", nrandom % atol((*args)->car->string));
+
+ return newNumber(string, GC_ROOTS);
+}
+
+#define DEFINE_PRIMITIVE_ARITHMETIC(name, op, init, converter, datatype, fmt, fmtpos) \
+ Object *name(Object **args, GC_PARAM) { \
+ if (*args == nil) \
+ return newNumber(init, GC_ROOTS); \
+ else if ((*args)->car->type != TYPE_NUMBER) \
+ exceptionWithObject((*args)->car, "is not a number"); \
+ else { \
+ Object *object, *rest; \
+ \
+ if ((*args)->cdr == nil) { \
+ object = newNumber(init, GC_ROOTS); \
+ rest = *args; \
+ } else { \
+ GC_TRACE(gcFirst, (*args)->car); \
+ object = newObjectFrom(gcFirst, GC_ROOTS); \
+ rest = (*args)->cdr; \
+ } \
+ \
+ datatype result = 0; \
+ char resString[22]; \
+ for (; rest != nil; rest = rest->cdr) { \
+ if (rest->car->type != TYPE_NUMBER) \
+ exceptionWithObject(rest->car, "is not a number"); \
+ \
+ result = \
+ converter(object->string) op converter(rest->car->string); \
+ \
+ if (result < 0) \
+ sprintf(resString, fmt, result); \
+ else \
+ sprintf(resString, fmtpos, result); \
+ \
+ object = newNumber(resString, GC_ROOTS); \
+ } \
+ \
+ return object; \
+ } \
}
-DEFINE_PRIMITIVE_ARITHMETIC(primitiveAdd, +, 0, double)
-DEFINE_PRIMITIVE_ARITHMETIC(primitiveSubtract, -, 0, double)
-DEFINE_PRIMITIVE_ARITHMETIC(primitiveMultiply, *, 1, double)
-DEFINE_PRIMITIVE_ARITHMETIC(primitiveDivide, /, 1, double)
-DEFINE_PRIMITIVE_ARITHMETIC(primitiveRemainder, %, 1, int )
-
-#define DEFINE_PRIMITIVE_RELATIONAL(name, op, until_the_end) \
- Object *name(Object **args, GC_PARAM) { \
- if ((*args)->car->type != TYPE_NUMBER) \
- exceptionWithObject((*args)->car, "is not a number"); \
- else { \
- Object *rest = *args; \
- bool result = until_the_end; \
- \
- for (; (result == until_the_end) && rest->cdr != nil; \
- rest = rest->cdr) { \
- if (rest->cdr->car->type != TYPE_NUMBER) \
- exceptionWithObject(rest->cdr->car, "is not a number"); \
- else if (until_the_end) \
- result &= rest->car->number op rest->cdr->car->number; \
- else \
- result = rest->car->number op rest->cdr->car->number; \
- } \
- return result ? t : f; \
- } \
+DEFINE_PRIMITIVE_ARITHMETIC(primitiveAdd, +, "+0", atof, double, "%lf", "+%lf")
+DEFINE_PRIMITIVE_ARITHMETIC(primitiveSubtract, -, "+0", atof, double, "%lf", "+%lf")
+DEFINE_PRIMITIVE_ARITHMETIC(primitiveMultiply, *, "+1", atof, double, "%lf", "+%lf")
+DEFINE_PRIMITIVE_ARITHMETIC(primitiveDivide, /, "+1", atof, double, "%lf", "+%lf")
+DEFINE_PRIMITIVE_ARITHMETIC(primitiveRemainder, %, "+1", atoi, int , "%d" , "+%d")
+
+#define DEFINE_PRIMITIVE_RELATIONAL(name, op, until_the_end) \
+ Object *name(Object **args, GC_PARAM) { \
+ if ((*args)->car->type != TYPE_NUMBER) \
+ exceptionWithObject((*args)->car, "is not a number"); \
+ else { \
+ Object *rest = *args; \
+ bool result = until_the_end; \
+ \
+ for (; (result == until_the_end) && rest->cdr != nil; \
+ rest = rest->cdr) { \
+ if (rest->cdr->car->type != TYPE_NUMBER) \
+ exceptionWithObject(rest->cdr->car, "is not a number"); \
+ else if (until_the_end) \
+ result &= atol(rest->car->string) op atol(rest->cdr->car->string); \
+ else \
+ result = atol(rest->car->string) op atol(rest->cdr->car->string); \
+ } \
+ return result ? t : f; \
+ } \
}
DEFINE_PRIMITIVE_RELATIONAL(primitiveDifferent, !=, false)
@@ -1404,7 +1442,7 @@ static char *stdlib = LISP(
(defun listp (x) (not (atom x)))
- (defun zerop (x) (not (! x 0)))
+ (defun zerop (x) (not (! x +0)))
(defmacro and args
(fill ((ap args) t)
@@ -1433,8 +1471,8 @@ static char *stdlib = LISP(
(differ (cdr x) (cdr y))))))
(defun nth (num xs)
- (fill ((dif num 0) (car xs))
- (f (nth (- num 1) (cdr xs)))))
+ (fill ((dif num +0) (car xs))
+ (f (nth (- num +1) (cdr xs)))))
(defun append (xs y)
(fill ((ap xs) y)
generated by cgit (git 2.34.1) at 2025-06-06 19:36:05 +0000