klisp

commit 788e2373b2136145a57e67854fd0ab7b842294fe
parent e1508acb17079f241b5fe54eeaf0f55c99cc8c3d
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 02:35:00 -0300

Added string to the ground environment.

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

4 files changed, 29 insertions(+), 3 deletions(-)
diff --git a/src/kground.c b/src/kground.c
@@ -599,7 +599,7 @@ void kinit_ground_env(klisp_State *K)
     */
 
     /* 13.2.1? string */
-    /* TODO */
+    add_applicative(K, ground_env, "string", string, 0);
 
     /* 13.2.2? string=?, string-ci=? */
     /* TODO */
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -22,6 +22,7 @@
 #include "kstring.h"
 
 #include "kghelpers.h"
+#include "kgchars.h" /* for kcharp */
 #include "kgstrings.h"
 
 /* 13.1.1? string? */
@@ -101,7 +102,31 @@ void string_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 /* 13.2.1? string */
-/* TODO */
+void string(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", "char", kcharp, false,
+				     ptree, &dummy);
+
+    TValue new_str;
+    /* the if isn't strictly necessary but it's clearer this way */
+    if (pairs == 0) {
+	new_str = K->empty_string; 
+    } else {
+	new_str = kstring_new_g(K, pairs);
+	char *buf = kstring_buf(new_str);
+	TValue tail = ptree;
+	while(pairs--) {
+	    *buf++ = chvalue(kcar(tail));
+	    tail = kcdr(tail);
+	}
+    }
+    kapply_cc(K, new_str);
+}
 
 /* 13.2.2? string=?, string-ci=? */
 /* TODO */
diff --git a/src/kgstrings.h b/src/kgstrings.h
@@ -35,7 +35,7 @@ void string_ref (klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void string_setS (klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 13.2.1? string */
-/* TODO */
+void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 13.2.2? string=?, string-ci=? */
 /* TODO */
diff --git a/src/kstring.h b/src/kstring.h
@@ -16,6 +16,7 @@
 
 TValue kstring_new_empty(klisp_State *K);
 TValue kstring_new(klisp_State *K, const char *buf, uint32_t size);
+TValue kstring_new_g(klisp_State *K, uint32_t size);
 TValue kstring_new_sc(klisp_State *K, uint32_t size, char fill);
 
 #define kstring_buf(tv_) (((String *) ((tv_).tv.v.gc))->b)