commit 33b87dafccd559d25f27b393fde1b434701e88cd
parent e7b96a3fb856e0d07d8704b675a08cf406495326
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sat, 9 Apr 2011 17:58:34 -0300
Added reading of bigints (still not tested, need writing of bigints first!). Reading of fixints between INT32_MIN & INT32_MAX works ok.
Diffstat:
5 files changed, 57 insertions(+), 16 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -44,7 +44,7 @@ klisp.o: klisp.c klisp.h kobject.h kread.h kwrite.h klimits.h kstate.h kmem.h \
kapplicative.h koperative.h keval.h krepl.h
kobject.o: kobject.c kobject.h klisp.h
ktoken.o: ktoken.c ktoken.h kobject.h kstate.h kpair.h kstring.h ksymbol.h \
- kerror.h klisp.h
+ kerror.h klisp.h kinteger.h
kinteger.o: kinteger.c kinteger.h kobject.h kstate.h kmem.h klisp.h
kpair.o: kpair.c kpair.h kobject.h kstate.h kmem.h klisp.h
kstring.o: kstring.c kstring.h kobject.h kstate.h kmem.h klisp.h
diff --git a/src/kinteger.c b/src/kinteger.c
@@ -26,7 +26,9 @@ Bigint_Node *make_new_node(klisp_State *K, uint32_t digit)
return node;
}
-TValue kbigint_new(klisp_State *K, int32_t fixint)
+/* for now used only for reading */
+/* NOTE: is uint to allow INT32_MIN as positive argument in read */
+TValue kbigint_new(klisp_State *K, bool sign, uint32_t digit)
{
Bigint *new_bigint = klispM_new(K, Bigint);
@@ -45,9 +47,9 @@ TValue kbigint_new(klisp_State *K, int32_t fixint)
new_bigint->sign_size = 0;
new_bigint->first = new_bigint->last = NULL;
- Bigint_Node *node = make_new_node(K, fixint);
+ Bigint_Node *node = make_new_node(K, digit);
new_bigint->first = new_bigint->last = node;
- new_bigint->sign_size = fixint < 0? -1 : 1;
+ new_bigint->sign_size = sign? -1 : 1;
return gc2bigint(new_bigint);
}
@@ -58,7 +60,6 @@ TValue kbigint_new(klisp_State *K, int32_t fixint)
void kbigint_add_digit(klisp_State *K, TValue tv_bigint, int32_t base,
int32_t digit)
{
- /* GC: root tv_bigint */
Bigint *bigint = tv2bigint(tv_bigint);
/* iterate in little endian mode */
bind_iter(iter, bigint, false);
@@ -77,6 +78,13 @@ void kbigint_add_digit(klisp_State *K, TValue tv_bigint, int32_t base,
if (carry != 0) {
/* must add one node to the bigint */
- kbigint_add_node(bigint, make_new_node(K, carry));
+ kbigint_add_node(bigint, make_new_node(K, (uint32_t) carry));
}
}
+
+/* Mutate the bigint to have the opposite sign, used in read */
+void kbigint_invert_sign(TValue tv_bigint)
+{
+ Bigint *bigint = tv2bigint(tv_bigint);
+ bigint->sign_size = -bigint->sign_size;
+}
diff --git a/src/kinteger.h b/src/kinteger.h
@@ -15,7 +15,8 @@
#include "kstate.h"
/* for now used only for reading */
-TValue kbigint_new(klisp_State *K, int32_t fixint);
+/* NOTE: is uint and has flag to allow INT32_MIN as positive argument */
+TValue kbigint_new(klisp_State *K, bool sign, uint32_t digit);
/* Create a stack allocated bigints from a fixint,
@@ -37,4 +38,7 @@ TValue kbigint_new(klisp_State *K, int32_t fixint);
void kbigint_add_digit(klisp_State *K, TValue tv_bigint, int32_t base,
int32_t digit);
+/* Mutate the bigint to have the opposite sign, used in read */
+void kbigint_invert_sign(TValue tv_bigint);
+
#endif
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -35,6 +35,7 @@
#include "ktoken.h"
#include "kobject.h"
#include "kstate.h"
+#include "kinteger.h"
#include "kpair.h"
#include "kstring.h"
#include "ksymbol.h"
@@ -359,11 +360,13 @@ int ktok_read_until_delimiter(klisp_State *K)
/*
** Numbers
-** TEMP: for now, only fixints in base 10
+** TEMP: for now, only integers in base 10
*/
TValue ktok_read_number(klisp_State *K, bool is_pos)
{
- int32_t res = 0;
+ uint32_t fixint_res = 0;
+ bool is_fixint = true;
+ TValue bigint_res;
while(!ktok_check_delimiter(K)) {
/* NOTE: can't be eof because it's a delimiter */
@@ -373,12 +376,32 @@ TValue ktok_read_number(klisp_State *K, bool is_pos)
/* avoid warning */
return KINERT;
}
- res = res * 10 + ktok_digit_value(ch);
+ int32_t new_digit = ktok_digit_value(ch);
+ if (is_fixint && CAN_ADD_DIGIT(fixint_res, !is_pos, new_digit)) {
+ fixint_res = fixint_res * 10 + new_digit;
+ } else {
+ if (is_fixint) {
+ /* up to the last loop was fixint, but can't be anymore.
+ Create a bigint and mutate to add the new digits. This
+ avoids unnecessary consing and discarding values that would
+ occur if it used the regular bigint+ and bigint* */
+ is_fixint = false;
+ bigint_res = kbigint_new(K, false, fixint_res);
+ /* GC: root bigint_res */
+ }
+ kbigint_add_digit(K, bigint_res, 10, new_digit);
+ }
}
- if (!is_pos)
- res = -res;
- return i2tv(res);
+ if (is_fixint) {
+ int32_t fixint = (is_pos)? (int32_t) fixint_res :
+ (int32_t) -((int64_t) fixint_res);
+ return i2tv(fixint);
+ } else {
+ if (!is_pos)
+ kbigint_invert_sign(bigint_res);
+ return bigint_res;
+ }
}
TValue ktok_read_maybe_signed_numeric(klisp_State *K)
@@ -581,7 +604,7 @@ TValue ktok_read_special(klisp_State *K)
}
int new_digit = ktok_digit_value(ch);
- if (CAN_ADD_DIGIT(res, new_digit)) {
+ if (CAN_ADD_DIGIT(res, false, new_digit)) {
res = res * 10 + new_digit;
} else {
ktok_error(K, "IMP. RESTRICTION: shared token too big");
diff --git a/src/ktoken.h b/src/ktoken.h
@@ -48,8 +48,14 @@ extern kcharset ktok_delimiter, ktok_extended, ktok_subsequent;
kch_[KCHS_OCTANT(ch__)] & KCHS_BIT(ch__); })
/* TODO: add other bases */
-#define CAN_ADD_DIGIT(res, new_digit) \
- ((res) <= (INT32_MAX - new_digit) / 10)
+/* This takes the args in sign magnitude form (sign_ & res_),
+ but must work for any representation of negative numbers */
+#define CAN_ADD_DIGIT(res_, sign_, new_digit_) \
+ ({ uint32_t res = (res_); \
+ uint32_t digit = (new_digit_); \
+ (sign_)? res <= -(INT32_MIN + digit) / 10 : \
+ res <= (INT32_MAX - digit) / 10;})
+
/*
** Char set contains macro interface
