klisp

commit a273cea706e2bbf56c544cd606c3c6f577faa2ac
parent 9237f3ba9e0fba456f75cf351c95bfd9179b34b5
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue, 12 Apr 2011 23:59:50 -0300

Some refactoring in ktoken to allow other radix prefixes.

Diffstat:
M
src/ktoken.c
 | 
53
+++++++++++++++++++++++++++++++++++++----------------
M
src/ktoken.h
 | 
42
++++++++++++++++++++++++++----------------

2 files changed, 63 insertions(+), 32 deletions(-)
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -14,7 +14,7 @@
 **
 ** From the Report:
 ** - Support other number types besides integers and exact infinities
-** - Support for complete number syntax (exactness, radix, etc)
+** - Support for complete number syntax (inexacts, rationals, reals, complex)
 ** 
 ** NOT from the Report:
 ** - Support for unicode (strings, char and symbols).
@@ -222,8 +222,11 @@ void ktok_ignore_whitespace_and_comments(klisp_State *K);
 bool ktok_check_delimiter(klisp_State *K);
 TValue ktok_read_string(klisp_State *K);
 TValue ktok_read_special(klisp_State *K);
-TValue ktok_read_number(klisp_State *K, bool sign);
-TValue ktok_read_maybe_signed_numeric(klisp_State *K);
+TValue ktok_read_number(klisp_State *K, bool sign, bool has_exactp, 
+			bool exactp, bool has_radixp, int32_t radix);
+TValue ktok_read_maybe_signed_numeric(klisp_State *K, bool has_exactp,
+				      bool exactp, bool has_radixp,
+				      int32_t radix);
 TValue ktok_read_identifier(klisp_State *K);
 int ktok_read_until_delimiter(klisp_State *K);
 
@@ -271,9 +274,11 @@ TValue ktok_read_token (klisp_State *K)
 	return ktok_read_special(K);
     case '0': case '1': case '2': case '3': case '4': 
     case '5': case '6': case '7': case '8': case '9':
-	return ktok_read_number(K, true); /* positive number */
+        /* positive number, no exactness or radix indicator */
+	return ktok_read_number(K, true, false, false, false, 10); 
     case '+': case '-':
-	return ktok_read_maybe_signed_numeric(K);
+        /* signed number, no exactness or radix indicator */
+	return ktok_read_maybe_signed_numeric(K, false, false, false, 10);
     case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G': 
     case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N': 
     case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U': 
@@ -360,9 +365,10 @@ int ktok_read_until_delimiter(klisp_State *K)
 
 /*
 ** Numbers
-** TEMP: for now, only integers in base 10
+** TEMP: for now, only integers, ignore exactness
 */
-TValue ktok_read_number(klisp_State *K, bool is_pos) 
+TValue ktok_read_number(klisp_State *K, bool is_pos, bool has_exactp, 
+			bool exactp, bool has_radixp, int32_t radix)
 {
     uint32_t fixint_res = 0;
     bool is_fixint = true;
@@ -370,15 +376,21 @@ TValue ktok_read_number(klisp_State *K, bool is_pos)
 
     while(!ktok_check_delimiter(K)) {
 	/* NOTE: can't be eof because it's a delimiter */
-	char ch = (char) ktok_getc(K);
-	if (!ktok_is_numeric(ch)) {
-	    ktok_error(K, "Not a digit found in number");
+	/* both is_digit and digit_value only recognize lowercase 
+	   for hex */
+	char ch = tolower((char) ktok_getc(K));
+
+	if (!ktok_is_digit(ch, radix)) {
+	    /* TODO show the char */
+	    ktok_error(K, "Invalid char found in number");
 	    /* avoid warning */
 	    return KINERT;
 	}
 	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;
+
+	if (is_fixint && can_add_digit(fixint_res, !is_pos, new_digit,
+		radix)) {
+	    fixint_res = fixint_res * radix + new_digit;
 	} else {
 	    if (is_fixint) {
 		/* up to the last loop was fixint, but can't be anymore.
@@ -389,7 +401,7 @@ TValue ktok_read_number(klisp_State *K, bool is_pos)
 		bigint_res = kbigint_new(K, false, fixint_res);
 		/* GC: root bigint_res */
 	    }
-	    kbigint_add_digit(K, bigint_res, 10, new_digit);
+	    kbigint_add_digit(K, bigint_res, radix, new_digit);
 	}
     }
 
@@ -404,18 +416,27 @@ TValue ktok_read_number(klisp_State *K, bool is_pos)
     }
 }
 
-TValue ktok_read_maybe_signed_numeric(klisp_State *K) 
+TValue ktok_read_maybe_signed_numeric(klisp_State *K, bool has_exactp,
+				      bool exactp, bool has_radixp,
+				      int32_t radix) 
 {
     /* NOTE: can't be eof, it's either '+' or '-' */
     char ch = (char) ktok_getc(K);
     if (ktok_check_delimiter(K)) {
+	if (has_exactp || has_radixp) {
+	    ktok_error(K, "No digit found in number");
+	    /* avoid warning */
+	    return KINERT;
+	}
+
 	ks_tbadd(K, ch);
 	ks_tbadd(K, '\0');
 	TValue new_sym = ksymbol_new_i(K, ks_tbget_buffer(K), 1);
 	ks_tbclear(K);
 	return new_sym;
     } else {
-	return ktok_read_number(K, ch == '+');
+	return ktok_read_number(K, ch == '+', has_exactp, exactp, 
+				has_radixp, radix);
     }
 }
 
@@ -604,7 +625,7 @@ TValue ktok_read_special(klisp_State *K)
 	    }
 
 	    int new_digit = ktok_digit_value(ch);
-	    if (CAN_ADD_DIGIT(res, false, new_digit)) {
+	    if (can_add_digit(res, false, new_digit, 10)) {
 		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
@@ -27,6 +27,12 @@ void clear_shared_dict(klisp_State *K);
    representation as an identifier */
 /* REFACTOR: think out a better interface to all this */
 
+/*
+** Char set contains macro interface
+*/
+#define KCHS_OCTANT(ch) ((ch) >> 5)
+#define KCHS_BIT(ch) (1 << ((ch) & 0x1f))
+
 /* Each bit correspond to a char in the 0-255 range */
 typedef uint32_t kcharset[8];
 
@@ -34,10 +40,8 @@ extern kcharset ktok_alphabetic, ktok_numeric, ktok_whitespace;
 extern kcharset ktok_delimiter, ktok_extended, ktok_subsequent;
 
 #define ktok_is_alphabetic(chi_) kcharset_contains(ktok_alphabetic, chi_)
-/* TODO: add is_digit, that takes the base as parameter */
 #define ktok_is_numeric(chi_) kcharset_contains(ktok_numeric, chi_)
-/* TODO: add hex digits */
-#define ktok_digit_value(ch_) (ch_ - '0')
+
 #define ktok_is_whitespace(chi_) kcharset_contains(ktok_whitespace, chi_)
 #define ktok_is_delimiter(chi_) ((chi_) == EOF ||			\
 				 kcharset_contains(ktok_delimiter, chi_))
@@ -47,20 +51,26 @@ extern kcharset ktok_delimiter, ktok_extended, ktok_subsequent;
     ({ unsigned char ch__ = (unsigned char) (ch_);	\
 	kch_[KCHS_OCTANT(ch__)] & KCHS_BIT(ch__); })
 
-/* TODO: add other bases */
-/* 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;})
 
+/* NOTE: only lowercase chars for hexa */
+inline bool ktok_is_digit(char ch, int32_t radix)
+{
+    return (ktok_is_numeric(ch) && (ch - '0') < radix) ||
+	(ktok_is_alphabetic(ch) && (10 + (ch - 'a')) < radix);
+}
 
-/*
-** Char set contains macro interface
-*/
-#define KCHS_OCTANT(ch) ((ch) >> 5)
-#define KCHS_BIT(ch) (1 << ((ch) & 0x1f))
+inline int32_t ktok_digit_value(char ch)
+{
+    return (ch <= '9')? ch - '0' : 10 + (ch - 'a');
+}
+
+/* This takes the args in sign magnitude form (sign & res),
+   but must work for any representation of negative numbers */
+inline bool can_add_digit(uint32_t res, bool sign, uint32_t new_digit, 
+			  int32_t radix)
+{
+    return (sign)? res <= -(INT32_MIN + new_digit) / radix :
+	res <= (INT32_MAX - new_digit) / radix;
+}
 
 #endif