diff --git a/cgen.scm b/cgen.scm index 964768eb..0ea35bf1 100644 --- a/cgen.scm +++ b/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? diff --git a/cyclone.h b/cyclone.h index 2d61eb68..837a770a 100644 --- a/cyclone.h +++ b/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 */ diff --git a/eval.scm b/eval.scm index bb5540fe..1d61347f 100644 --- a/eval.scm +++ b/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) diff --git a/runtime.c b/runtime.c index 4fc41859..9fc1a319 100644 --- a/runtime.c +++ b/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; diff --git a/runtime.h b/runtime.h index 9f583254..36d59c62 100644 --- a/runtime.h +++ b/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; diff --git a/transforms.scm b/transforms.scm index b414daab..42615758 100644 --- a/transforms.scm +++ b/transforms.scm @@ -506,6 +506,8 @@ string->symbol symbol->string number->string + string-length + substring make-vector list->vector vector-length