klisp

commit 5b66729c016af058c3f50bed846edb24934ea10f
parent 60e982b9e3efeef6c181e206aa0e3a6019495125
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed,  9 Mar 2011 17:01:27 -0300

Slightly changed the token buffer interface to allow it to be used as a char stack

Diffstat:
M
src/kstate.h
 | 
29
+++++++++++++++++++++++++++--
M
src/ktoken.c
 | 
29
+++++++++++++++++------------

2 files changed, 44 insertions(+), 14 deletions(-)
diff --git a/src/kstate.h b/src/kstate.h
@@ -185,7 +185,13 @@ inline bool ks_sisempty(klisp_State *K)
 */
 
 inline void ks_tbadd(klisp_State *K, char ch);
-inline char *ks_tbget(klisp_State *K);
+#define ks_tbpush(K_, ch_) (ks_tbadd((K_), (ch_)))
+inline char ks_tbget(klisp_State *K);
+inline char ks_tbpop(klisp_State *K);
+/* this is for DISCARDING stack pop (value isn't used, avoid warning) */ 
+#define ks_tbdpop(st_) (UNUSED(ks_tbpop(st_)))
+
+inline char *ks_tbget_buffer(klisp_State *K);
 inline void ks_tbclear(klisp_State *K);
 inline bool ks_tbisempty(klisp_State *K);
 
@@ -208,7 +214,26 @@ inline void ks_tbadd(klisp_State *K, char ch)
     ++ks_tbidx(K);
 }
 
-inline char *ks_tbget(klisp_State *K)
+inline char ks_tbget(klisp_State *K)
+{
+    return ks_tbelem(K, ks_tbidx(K) - 1);
+}
+
+inline char ks_tbpop(klisp_State *K)
+{
+    if (ks_tbsize(K) != KS_ITBSIZE && ks_tbidx(K) < (ks_tbsize(K) / 4)) {
+	/* NOTE: shrink can't fail */
+	size_t old_size = ks_tbsize(K);
+	size_t new_size = old_size / 2;
+	ks_tbuf(K) = klispM_realloc_(K, ks_tbuf(K), old_size, new_size);
+	ks_tbsize(K) = new_size; 
+    }
+    char ch = ks_tbelem(K, ks_tbidx(K) - 1);
+    --ks_tbidx(K);
+    return ch;
+}
+
+inline char *ks_tbget_buffer(klisp_State *K)
 {
     assert(ks_tbelem(K, ks_tbidx(K) - 1) == '\0');
     return ks_tbuf(K);
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -400,7 +400,7 @@ TValue ktok_read_maybe_signed_numeric(klisp_State *K)
     if (ktok_check_delimiter(K)) {
 	ks_tbadd(K, ch);
 	ks_tbadd(K, '\0');
-	TValue new_sym = ksymbol_new(K, ks_tbuf(K));
+	TValue new_sym = ksymbol_new(K, ks_tbget_buffer(K));
 	ks_tbclear(K);
 	return new_sym;
     } else {
@@ -454,7 +454,7 @@ TValue ktok_read_string(klisp_State *K)
 	    i++;
 	}
     }
-    TValue new_str = kstring_new(K, ks_tbuf(K), i);
+    TValue new_str = kstring_new(K, ks_tbget_buffer(K), i);
     ks_tbclear(K);
     return new_str;
 }
@@ -484,9 +484,10 @@ TValue ktok_read_special(klisp_State *K)
 	ktok_read_until_delimiter(K);
 	/* NOTE: can use strcmp even in the presence of '\0's */
 	TValue ret_val;
-	if (strcmp(ks_tbuf(K), "gnore") == 0)
+	char *buf = ks_tbget_buffer(K);
+	if (strcmp(buf, "gnore") == 0)
 	    ret_val = KIGNORE;
-	else if (strcmp(ks_tbuf(K), "nert") == 0)
+	else if (strcmp(buf, "nert") == 0)
 	    ret_val =  KINERT;
 	else {
 	    ktok_error(K, "unexpected char in # constant");
@@ -496,15 +497,16 @@ TValue ktok_read_special(klisp_State *K)
 	ks_tbclear(K);
 	return ret_val;
     }
-    case 'e':
+    case 'e': {
 	/* an exact infinity */
 	/* XXX: could also be an exact number */
 	ktok_read_until_delimiter(K);
 	TValue ret_val;
 	/* NOTE: can use strcmp even in the presence of '\0's */
-	if (strcmp(ks_tbuf(K), "+infinity") == 0) {
+	char *buf = ks_tbget_buffer(K);
+	if (strcmp(buf, "+infinity") == 0) {
 	    ret_val = KEPINF;
-	} else if (strcmp(ks_tbuf(K), "-infinity") == 0) {
+	} else if (strcmp(buf, "-infinity") == 0) {
 	    ret_val =  KEMINF;
 	} else {
 	    ktok_error(K, "unexpected char in # constant");
@@ -513,6 +515,7 @@ TValue ktok_read_special(klisp_State *K)
 	}
 	ks_tbclear(K);
 	return ret_val;
+    }
     case 't':
     case 'f':
 	/* boolean constant */
@@ -523,7 +526,7 @@ TValue ktok_read_special(klisp_State *K)
 	    /* avoid warning */
 	    return KINERT;
 	}
-    case '\\':
+    case '\\': {
 	/* char constant */
 	/* 
 	** RATIONALE: in the scheme spec (R5RS) it says that only alphabetic 
@@ -546,16 +549,17 @@ TValue ktok_read_special(klisp_State *K)
 	    return ch2tv(ch);
 
 	ktok_read_until_delimiter(K);
-	char *p = ks_tbuf(K);
+	char *p = ks_tbget_buffer(K);
 	while (*p) {
 	    *p = tolower(*p);
 	    p++;
 	}
 	ch = tolower(ch);
 	/* NOTE: can use strcmp even in the presence of '\0's */
-	if (ch == 's' && strcmp(ks_tbuf(K), "pace") == 0)
+	char *buf = ks_tbget_buffer(K);
+	if (ch == 's' && strcmp(buf, "pace") == 0)
 	    ch = ' ';
-	else if (ch == 'n' && strcmp(ks_tbuf(K), "ewline") == 0)
+	else if (ch == 'n' && strcmp(buf, "ewline") == 0)
 	    ch = ('\n');
 	else {
 	    ktok_error(K, "Unrecognized character name");
@@ -564,6 +568,7 @@ TValue ktok_read_special(klisp_State *K)
 	}
 	ks_tbclear(K);
 	return ch2tv(ch);
+    }
     case '0': case '1': case '2': case '3': case '4': 
     case '5': case '6': case '7': case '8': case '9': {
 	/* srfi-38 type token (can be either a def or ref) */
@@ -613,7 +618,7 @@ TValue ktok_read_identifier(klisp_State *K)
 	    ktok_error(K, "Invalid char in identifier");	    
     }
     ks_tbadd(K, '\0');
-    TValue new_sym = ksymbol_new(K, ks_tbuf(K));
+    TValue new_sym = ksymbol_new(K, ks_tbget_buffer(K));
     ks_tbclear(K);
     return new_sym;
 }