diff --git a/cgen.scm b/cgen.scm index 08b15bba..a0712d21 100644 --- a/cgen.scm +++ b/cgen.scm @@ -435,6 +435,7 @@ ((eq? p 'list->string) "Cyc_list2string") ((eq? p 'string->list) "string2list") ((eq? p 'string-append) "Cyc_string_append") + ((eq? p 'string-cmp) "Cyc_string_cmp") ((eq? p 'string->symbol) "Cyc_string2symbol") ((eq? p 'symbol->string) "Cyc_symbol2string") ((eq? p 'number->string) "Cyc_number2string") @@ -486,6 +487,7 @@ ((eq? p 'string->number) "common_type") ((eq? p 'list->string) "string_type") ; ((eq? p 'string->list) "object") + ((eq? p 'string-cmp) "integer_type") ((eq? p 'string-append) "string_type") ((eq? p 'symbol->string) "string_type") ((eq? p 'number->string) "string_type") @@ -497,7 +499,8 @@ (and (prim? exp) (member exp '( current-input-port open-input-file - char->integer system string->number string-append list->string string->list + char->integer system string->number + string-append string-cmp list->string string->list symbol->string number->string + - * / apply cons length cell)))) diff --git a/eval.scm b/eval.scm index a044da0b..d1effaf0 100644 --- a/eval.scm +++ b/eval.scm @@ -255,6 +255,7 @@ (list 'char->integer char->integer) (list 'integer->char integer->char) (list 'string->number string->number) + (list 'string-cmp string-cmp) (list 'string-append string-append) (list 'string->list string->list) (list 'list->string list->string) diff --git a/runtime.c b/runtime.c index 2f1b4b57..b7ba836c 100644 --- a/runtime.c +++ b/runtime.c @@ -639,6 +639,13 @@ common_type Cyc_string2number(object str){ return result; } +integer_type Cyc_string_cmp(object str1, object str2) { + // TODO: check types of str1, str2 + make_int(cmp, strcmp(((string_type *)str1)->str, + ((string_type *)str2)->str)); + return cmp; +} + void dispatch_string_91append(int argc, object clo, object cont, object str1, ...) { string_type result; va_list ap; @@ -1063,6 +1070,9 @@ void _Cyc_91default_91exception_91handler(object cont, object args) { // TODO: this is a quick-and-dirty implementation, may be a better way to write this Cyc_default_exception_handler(1, args, car(args)); } +void _string_91cmp(object cont, object args) { + integer_type cmp = Cyc_string_cmp(car(args), cadr(args)); + return_funcall1(cont, &cmp);} void _string_91append(object cont, object args) { integer_type argc = Cyc_length(args); dispatch(argc.value, (function_type)dispatch_string_91append, cont, cont, args); } @@ -1723,6 +1733,7 @@ static primitive_type char_91_125integer_primitive = {primitive_tag, "char->inte 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 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}; static primitive_type string_91_125list_primitive = {primitive_tag, "string->list", &_string_91_125list}; static primitive_type list_91_125string_primitive = {primitive_tag, "list->string", &_list_91_125string}; @@ -1819,6 +1830,7 @@ 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_system = &system_primitive; +const object primitive_string_91cmp = &string_91cmp_primitive; const object primitive_string_91append = &string_91append_primitive; const object primitive_string_91_125list = &string_91_125list_primitive; const object primitive_list_91_125string = &list_91_125string_primitive; diff --git a/runtime.h b/runtime.h index b3e44655..c205acbf 100644 --- a/runtime.h +++ b/runtime.h @@ -61,6 +61,7 @@ object Cyc_get_cvar(object var); object Cyc_set_cvar(object var, object value); object apply(object cont, object func, object args); void Cyc_apply(int argc, closure cont, object prim, ...); +integer_type Cyc_string_cmp(object str1, object str2); 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, object, va_list); @@ -256,6 +257,7 @@ extern const object primitive_cddddr; extern const object primitive_char_91_125integer; extern const object primitive_integer_91_125char; extern const object primitive_string_91_125number; +extern const object primitive_string_91cmp; extern const object primitive_string_91append; extern const object primitive_string_91_125list; extern const object primitive_list_91_125string; diff --git a/trans.scm b/trans.scm index d8051284..0ca18ab3 100644 --- a/trans.scm +++ b/trans.scm @@ -510,6 +510,7 @@ integer->char string->number string-append + string-cmp string->list list->string string->symbol