klisp

commit 4f47f6e74de8f5d6957f855727b66767cc672442
parent e75fed6da1649fa472cce34f6e36634de0d75bab
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 03:04:56 -0300

Added string-append to the ground environment.

Diffstat:
M
src/kground.c
 | 
2
+-
M
src/kgstrings.c
 | 
55
++++++++++++++++++++++++++++++++++++++++++++++++++++++-
M
src/kgstrings.h
 | 
6
+++++-

3 files changed, 60 insertions(+), 3 deletions(-)
diff --git a/src/kground.c b/src/kground.c
@@ -614,7 +614,7 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "substring", substring, 0);
 
     /* 13.2.6? string-append */
-    /* TODO */
+    add_applicative(K, ground_env, "string-append", string_append, 0);
 
     /* 13.2.7? string->list, list->string */
     add_applicative(K, ground_env, "string->list", string_to_list, 0);
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -182,7 +182,54 @@ void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 /* 13.2.6? string-append */
-/* TODO */
+/* TEMP: this does 3 passes over the list */
+void string_append(klisp_State *K, TValue *xparams, TValue ptree, 
+		   TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    int32_t dummy;
+    /* don't allow cycles */
+    int32_t pairs = check_typed_list(K, "string-append", "string", kstringp, 
+				     false, ptree, &dummy);
+
+    TValue new_str;
+    int64_t total_size = 0; /* use int64 to check for overflow */
+    /* the if isn't strictly necessary but it's clearer this way */
+    int32_t saved_pairs = pairs; /* save pairs for next loop */
+    TValue tail = ptree;
+    while(pairs--) {
+	total_size += kstring_size(kcar(tail));
+	if (total_size > INT32_MAX) {
+	    klispE_throw(K, "string-append: resulting string is too big");
+	    return;
+	}
+	tail = kcdr(tail);
+    }
+    /* this is safe */
+    int32_t size = (int32_t) total_size;
+
+    if (size == 0) {
+	new_str = K->empty_string; 
+    } else {
+	new_str = kstring_new_g(K, size);
+	char *buf = kstring_buf(new_str);
+	/* loop again to copy the chars of each string */
+	tail = ptree;
+	pairs = saved_pairs;
+
+	while(pairs--) {
+	    TValue first = kcar(tail);
+	    int32_t first_size = kstring_size(first);
+	    memcpy(buf, kstring_buf(first), first_size);
+	    buf += first_size;
+	    tail = kcdr(tail);
+	}
+    }
+
+    kapply_cc(K, new_str);
+}
+
 
 /* 13.2.7? string->list, list->string */
 void string_to_list(klisp_State *K, TValue *xparams, TValue ptree, 
@@ -265,3 +312,9 @@ void string_fillS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
    again must be equal? which happens here 
 */
 /* TODO */
+
+/* Helpers */
+bool kstringp(TValue obj)
+{
+    return ttisstring(obj);
+}
diff --git a/src/kgstrings.h b/src/kgstrings.h
@@ -50,7 +50,8 @@ void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 13.2.6? string-append */
-/* TODO */
+void string_append(klisp_State *K, TValue *xparams, TValue ptree, 
+		   TValue denv);
 
 /* 13.2.7? string->list, list->string */
 void list_to_string(klisp_State *K, TValue *xparams, TValue ptree, 
@@ -81,4 +82,7 @@ void string_fillS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 */
 /* TODO */
 
+/* Helpers */
+bool kstringp(TValue obj);
+
 #endif