add string functions

src/string.c

@@ -32,8 +32,103 @@ pic_str_string_p(pic_state *pic)
   return pic_bool_value(pic_str_p(v));
 }
 
+static pic_value
+pic_str_make_string(pic_state *pic)
+{
+  int k, i;
+  char c = ' ', *cstr;
+
+  pic_get_args(pic, "i|c", &k, &c);
+
+  cstr = (char *)pic_alloc(pic, k + 1);
+  for (i = 0; i < k; ++i) {
+    cstr[i] = c;
+  }
+  cstr[k] = '\0';
+
+  return pic_obj_value(pic_str_new(pic, cstr, k));
+}
+
+static pic_value
+pic_str_string_length(pic_state *pic)
+{
+  char *str;
+  size_t len;
+
+  pic_get_args(pic, "s", &str, &len);
+
+  return pic_int_value(len);
+}
+
+static pic_value
+pic_str_string_ref(pic_state *pic)
+{
+  char *str;
+  size_t len;
+  int k;
+
+  pic_get_args(pic, "si", &str, &len, &k);
+
+  return pic_char_value(str[k]);
+}
+
+static pic_value
+pic_str_string_set(pic_state *pic)
+{
+  char *str, c;
+  size_t len;
+  int k;
+
+  pic_get_args(pic, "sic", &str, &len, &k, &c);
+
+  str[k] = c;
+  return pic_false_value();
+}
+
+#define DEFINE_STRING_CMP(name, op)			\
+  static pic_value					\
+  pic_str_string_##name(pic_state *pic)			\
+  {							\
+    size_t argc;					\
+    pic_value *argv;					\
+    int i;						\
+							\
+    pic_get_args(pic, "*", &argc, &argv);		\
+							\
+    if (argc < 1 || ! pic_str_p(argv[0])) {		\
+      return pic_false_value();				\
+    }							\
+							\
+    for (i = 1; i < argc; ++i) {			\
+      if (! pic_str_p(argv[i])) {			\
+	return pic_false_value();			\
+      }							\
+      if (! (strcmp(pic_str_ptr(argv[i-1])->str,	\
+		    pic_str_ptr(argv[i])->str)		\
+	     op 0)) {					\
+	return pic_false_value();			\
+      }							\
+    }							\
+    return pic_true_value();				\
+  }
+
+DEFINE_STRING_CMP(eq, ==)
+DEFINE_STRING_CMP(lt, <)
+DEFINE_STRING_CMP(gt, >)
+DEFINE_STRING_CMP(le, <=)
+DEFINE_STRING_CMP(ge, >=)
+
 void
 pic_init_str(pic_state *pic)
 {
   pic_defun(pic, "string?", pic_str_string_p);
+  pic_defun(pic, "make-string", pic_str_make_string);
+  pic_defun(pic, "string-length", pic_str_string_length);
+  pic_defun(pic, "string-ref", pic_str_string_ref);
+  pic_defun(pic, "string-set!", pic_str_string_set);
+  pic_defun(pic, "string=?", pic_str_string_eq);
+  pic_defun(pic, "string<?", pic_str_string_lt);
+  pic_defun(pic, "string>?", pic_str_string_gt);
+  pic_defun(pic, "string<=?", pic_str_string_le);
+  pic_defun(pic, "string>=?", pic_str_string_ge);
 }