Added string-length and substring

substring still needs more error handling though, before it is complete.

cgen.scm

@@ -464,6 +464,8 @@
      ((eq? p 'string->symbol) "Cyc_string2symbol")
      ((eq? p 'symbol->string) "Cyc_symbol2string")
      ((eq? p 'number->string) "Cyc_number2string")
+     ((eq? p 'string-length)  "Cyc_string_length")
+     ((eq? p 'substring)      "Cyc_substring")
      ((eq? p 'system)         "Cyc_system")
      ((eq? p 'assq)          "assq")
      ((eq? p 'assv)          "assq")
@@ -522,6 +524,8 @@
     ((eq? p 'string-append) "string_type")
     ((eq? p 'symbol->string) "string_type")
     ((eq? p 'number->string) "string_type")
+    ((eq? p 'string-length) "integer_type")
+    ((eq? p 'substring) "string_type")
     ((eq? p 'apply)  "object")
     (else #f)))
 
@@ -537,7 +541,8 @@
              char->integer system string->number 
              string-append string-cmp list->string string->list
              make-vector list->vector
-             symbol->string number->string
+             symbol->string number->string 
+             string-length substring
              + - * / apply cons length vector-length cell))))
 
 ;; Pass an integer arg count as the function's first parameter?

cyclone.h

@@ -154,6 +154,9 @@ typedef struct {tag_type tag; int value;} integer_type;
 typedef struct {tag_type tag; double value;} double_type;
 #define make_double(n,v) double_type n; n.tag = double_tag; n.value = v;
 
+#define integer_value(x) (((integer_type *) x)->value)
+#define double_value(x) (((double_type *) x)->value)
+
 /* Define string type */
 typedef struct {tag_type tag; char *str;} string_type;
 #define make_string(cv,s) string_type cv; cv.tag = string_tag; \
@@ -161,6 +164,14 @@ typedef struct {tag_type tag; char *str;} string_type;
   if ((dhallocp + len + 1) >= dhbottom + global_heap_size) { \
       printf("Fatal error: data heap overflow\n"); exit(1); } \
   memcpy(dhallocp, s, len + 1); dhallocp += len + 1; }
+#define make_stringn(cv,s,len) string_type cv; cv.tag = string_tag; \
+{ cv.str = dhallocp; \
+  if ((dhallocp + len + 1) >= dhbottom + global_heap_size) { \
+      printf("Fatal error: data heap overflow\n"); exit(1); } \
+  memcpy(dhallocp, s, len); dhallocp += len; \
+  *dhallocp = '\0'; dhallocp += 1;}
+
+#define string_str(x) (((string_type *) x)->str)
 
 /* I/O types */
 

eval.scm

@@ -268,6 +268,8 @@
       (list 'string->symbol string->symbol)
       (list 'symbol->string symbol->string)
       (list 'number->string number->string)
+      (list 'string-length string-length)
+      (list 'substring substring)
       (list 'make-vector make-vector)
       (list 'list->vector list->vector)
       (list 'vector-length vector-length)

runtime.c

@@ -852,6 +852,20 @@ string_type Cyc_string_append_va_list(int argc, object str1, va_list ap) {
     return result;
 }
 
+integer_type Cyc_string_length(object str) {
+  make_int(len, strlen(string_str(str)));
+  return len;
+}
+
+// TODO: need error checking below, this is much too dangerous without!
+string_type Cyc_substring(object str, object start, object end) {
+  int s = integer_value(start),
+      e = integer_value(end);
+  const char *raw = string_str(str);
+  make_stringn(sub, raw + s, e - s);
+  return sub;
+}
+
 integer_type Cyc_system(object cmd) {
   if (nullp(cmd) || is_value_type(cmd) || type_of(cmd) != string_tag) {
     make_int(n, -1);
@@ -1258,6 +1272,12 @@ void _integer_91_125char(object cont, object args) {
 void _string_91_125number(object cont, object args) {  
     common_type i = Cyc_string2number(car(args));
     return_funcall1(cont, &i);}
+void _string_91length(object cont, object args) {
+    integer_type i = Cyc_string_length(car(args));
+    return_funcall1(cont, &i);}
+void _cyc_substring(object cont, object args) {
+    string_type s = Cyc_substring(car(args), cadr(args), caddr(args));
+    return_funcall1(cont, &s);}
 void _cyc_system(object cont, object args) {
     integer_type i = Cyc_system(car(args));
     return_funcall1(cont, &i);}
@@ -1993,6 +2013,8 @@ static primitive_type cddddr_primitive = {primitive_tag, "cddddr", &_cddddr};
 static primitive_type char_91_125integer_primitive = {primitive_tag, "char->integer", &_char_91_125integer};
 static primitive_type integer_91_125char_primitive = {primitive_tag, "integer->char", &_integer_91_125char};
 static primitive_type string_91_125number_primitive = {primitive_tag, "string->number", &_string_91_125number};
+static primitive_type string_91length_primitive = {primitive_tag, "string-length", &_string_91length};
+static primitive_type substring_primitive = {primitive_tag, "substring", &_cyc_substring};
 static primitive_type system_primitive = {primitive_tag, "system", &_cyc_system};
 static primitive_type string_91cmp_primitive = {primitive_tag, "string-cmp", &_string_91cmp};
 static primitive_type string_91append_primitive = {primitive_tag, "string-append", &_string_91append};
@@ -2104,6 +2126,8 @@ const object primitive_cddddr = &cddddr_primitive;
 const object primitive_char_91_125integer = &char_91_125integer_primitive;
 const object primitive_integer_91_125char = &integer_91_125char_primitive;
 const object primitive_string_91_125number = &string_91_125number_primitive;
+const object primitive_string_91length = &string_91length_primitive;
+const object primitive_substring = &substring_primitive;
 const object primitive_system = &system_primitive;
 const object primitive_string_91cmp = &string_91cmp_primitive;
 const object primitive_string_91append = &string_91append_primitive;

runtime.h

@@ -100,6 +100,8 @@ common_type Cyc_string2number(object str);
 void dispatch_string_91append(int argc, object clo, object cont, object str1, ...);
 string_type Cyc_string_append(int argc, object str1, ...);
 string_type Cyc_string_append_va_list(int argc, object str1, va_list ap);
+integer_type Cyc_string_length(object str);
+string_type Cyc_substring(object str, object start, object end);
 integer_type Cyc_system(object cmd);
 integer_type Cyc_char2integer(object chr);
 object Cyc_integer2char(object n);
@@ -310,6 +312,8 @@ extern const object primitive_list_91_125string;
 extern const object primitive_string_91_125symbol;
 extern const object primitive_symbol_91_125string;
 extern const object primitive_number_91_125string;
+extern const object primitive_string_91length;
+extern const object primitive_substring;
 extern const object primitive_make_91vector;
 extern const object primitive_list_91_125vector;
 extern const object primitive_vector_91ref;

transforms.scm

@@ -506,6 +506,8 @@
      string->symbol
      symbol->string
      number->string
+     string-length
+     substring
      make-vector
      list->vector
      vector-length