klisp

commit 3ca515c7e8aee79d3847ba3ee495af1d11529b80
parent 66534051fd2ca953cb3e5fe3f63302b25f450276
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 18 Mar 2011 16:25:37 -0300

Added char->integer & integer->char. Restricted char constants and string constants to ASCII in tokenizer (non ASCII chars allowed in comments).

Diffstat:
M
src/kgchars.c
 | 
29
++++++++++++++++++++++++++++-
M
src/kgchars.h
 | 
5
++++-
M
src/kground.c
 | 
3
++-
M
src/ktoken.c
 | 
15
+++++++++++++--

4 files changed, 47 insertions(+), 5 deletions(-)
diff --git a/src/kgchars.c b/src/kgchars.c
@@ -39,7 +39,34 @@ bool kchar_upper_casep(TValue ch) { return isupper(chvalue(ch)) != 0; }
 bool kchar_lower_casep(TValue ch) { return islower(chvalue(ch)) != 0; }
 
 /* 14.1.4? char->integer, integer->char */
-/* TODO */
+void kchar_to_integer(klisp_State *K, TValue *xparams, TValue ptree, 
+		      TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    bind_1tp(K, "char->integer", ptree, "character", ttischar, ch);
+
+    kapply_cc(K, i2tv((int32_t) chvalue(ch)));
+}
+
+/* TEMP: this should arbitrary integers (and throw an error if out of 
+   range */
+void kinteger_to_char(klisp_State *K, TValue *xparams, TValue ptree, 
+		      TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    bind_1tp(K, "integer->char", ptree, "finite integer", ttisfixint, itv);
+    
+    int32_t i = ivalue(itv);
+
+    /* for now only allow ASCII */
+    if (i < 0 || i > 127) {
+	klispE_throw(K, "integer->char: integer out of ASCII range [0 - 127]");
+	return;
+    }
+    kapply_cc(K, ch2tv((char) i));
+}
 
 /* 14.1.4? char-upcase, char-downcase */
 /* TODO */
diff --git a/src/kgchars.h b/src/kgchars.h
@@ -38,7 +38,10 @@ bool kchar_upper_casep(TValue ch);
 bool kchar_lower_casep(TValue ch);
 
 /* 14.1.4? char->integer, integer->char */
-/* TODO */
+void kchar_to_integer(klisp_State *K, TValue *xparams, TValue ptree, 
+		      TValue denv);
+void kinteger_to_char(klisp_State *K, TValue *xparams, TValue ptree, 
+		      TValue denv);
 
 /* 14.1.4? char-upcase, char-downcase */
 /* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -511,7 +511,8 @@ void kinit_ground_env(klisp_State *K)
     
 
     /* 14.1.4? char->integer, integer->char */
-    /* TODO */
+    add_applicative(K, ground_env, "char->integer", kchar_to_integer, 0);
+    add_applicative(K, ground_env, "integer->char", kinteger_to_char, 0);
 
     /* 14.1.4? char-upcase, char-downcase */
     /* TODO */
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -436,7 +436,11 @@ TValue ktok_read_string(klisp_State *K)
 	    /* avoid warning */
 	    return KINERT;
 	}
-	if (ch == '"') {
+	if (ch < 0 || ch > 127) {
+	    ktok_error(K, "Non ASCII char found while reading a string");
+	    /* avoid warning */
+	    return KINERT;
+	} else if (ch == '"') {
 	    ks_tbadd(K, '\0');
 	    done = true;
 	} else {
@@ -545,7 +549,6 @@ TValue ktok_read_special(klisp_State *K)
 	** For now we follow the scheme report 
 	*/
 	chi = ktok_getc(K);
-	ch = (char) chi;
 
 	if (chi == EOF) {
 	    ktok_error(K, "EOF found while reading a char constant");
@@ -553,6 +556,14 @@ TValue ktok_read_special(klisp_State *K)
 	    return KINERT;
 	}
 
+	ch = (char) chi;
+
+	if (ch < 0 || ch > 127) {
+	    ktok_error(K, "Non ASCII char found as character constant");
+	    /* avoid warning */
+	    return KINERT;
+	} 
+
 	if (!ktok_is_alphabetic(ch) || ktok_check_delimiter(K))
 	    return ch2tv(ch);