klisp

commit 3252fd5b22b628648de4d716bdaf33c7447bd5b4
parent 788e2373b2136145a57e67854fd0ab7b842294fe
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 02:40:34 -0300

Added list->string to the ground environment.

Diffstat:
M
src/kground.c
 | 
1
+
M
src/kgstrings.c
 | 
38
+++++++++++++++++++++++++++++---------
M
src/kgstrings.h
 | 
2
++

3 files changed, 32 insertions(+), 9 deletions(-)
diff --git a/src/kground.c b/src/kground.c
@@ -618,6 +618,7 @@ void kinit_ground_env(klisp_State *K)
 
     /* 13.2.7? string->list, list->string */
     /* TODO */
+    add_applicative(K, ground_env, "list->string", list_to_string, 0);
 
     /* 13.2.8? string-copy */
     add_applicative(K, ground_env, "string-copy", string_copy, 0);
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -101,30 +101,37 @@ void string_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     kapply_cc(K, KINERT);
 }
 
-/* 13.2.1? string */
-void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+/* Helper for string and list->string */
+inline TValue list_to_string_h(klisp_State *K, char *name, TValue ls)
 {
-    UNUSED(xparams);
-    UNUSED(denv);
-
     int32_t dummy;
     /* don't allow cycles */
-    int32_t pairs = check_typed_list(K, "string", "char", kcharp, false,
-				     ptree, &dummy);
+    int32_t pairs = check_typed_list(K, name, "char", kcharp, false,
+				     ls, &dummy);
 
     TValue new_str;
     /* the if isn't strictly necessary but it's clearer this way */
     if (pairs == 0) {
-	new_str = K->empty_string; 
+	return K->empty_string; 
     } else {
 	new_str = kstring_new_g(K, pairs);
 	char *buf = kstring_buf(new_str);
-	TValue tail = ptree;
+	TValue tail = ls;
 	while(pairs--) {
 	    *buf++ = chvalue(kcar(tail));
 	    tail = kcdr(tail);
 	}
+	return new_str;
     }
+}
+
+/* 13.2.1? string */
+void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    
+    TValue new_str = list_to_string_h(K, "string", ptree);
     kapply_cc(K, new_str);
 }
 
@@ -180,6 +187,19 @@ void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 /* 13.2.7? string->list, list->string */
 /* TODO */
 
+void list_to_string(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    
+    /* check later in list_to_string_h */
+    bind_1p(K, "list->string", ptree, ls);
+
+    TValue new_str = list_to_string_h(K, "list->string", ls);
+    kapply_cc(K, new_str);
+}
+
 /* 13.2.8? string-copy */
 void string_copy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 {
diff --git a/src/kgstrings.h b/src/kgstrings.h
@@ -54,6 +54,8 @@ void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 13.2.7? string->list, list->string */
 /* TODO */
+void list_to_string(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv);
 
 /* 13.2.8? string-copy */
 void string_copy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);