klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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:
Msrc/kstate.h | 29+++++++++++++++++++++++++++--
Msrc/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; }