diff --git a/cgen.scm b/cgen.scm index a3846ef8..da7db4e7 100644 --- a/cgen.scm +++ b/cgen.scm @@ -465,7 +465,9 @@ ((eq? p 'symbol->string) "Cyc_symbol2string") ((eq? p 'number->string) "Cyc_number2string") ((eq? p 'string-length) "Cyc_string_length") + ((eq? p 'string-ref) "Cyc_string_ref") ((eq? p 'substring) "Cyc_substring") + ((eq? p 'command-line-arguments) "Cyc_command_line_arguments") ((eq? p 'system) "Cyc_system") ((eq? p 'assq) "assq") ((eq? p 'assv) "assq") diff --git a/eval.scm b/eval.scm index 1d61347f..4f4982c1 100644 --- a/eval.scm +++ b/eval.scm @@ -210,6 +210,7 @@ (list '%halt %halt) (list 'exit exit) (list 'system system) + (list 'command-line-arguments command-line-arguments) (list 'error error) (list 'cons cons) (list 'cell-get cell-get) @@ -269,6 +270,7 @@ (list 'symbol->string symbol->string) (list 'number->string number->string) (list 'string-length string-length) + (list 'string-ref string-ref) (list 'substring substring) (list 'make-vector make-vector) (list 'list->vector list->vector) diff --git a/runtime.c b/runtime.c index eecbb169..c0d0e69d 100644 --- a/runtime.c +++ b/runtime.c @@ -857,6 +857,18 @@ integer_type Cyc_string_length(object str) { return len; } +object Cyc_string_ref(object str, object k) { + const char *raw = string_str(str); + int idx = integer_value(k), + len = strlen(raw); + + if (idx < 0 || idx >= len) { + Cyc_rt_raise2("string-ref - invalid index", k); + } + + return obj_char2obj(raw[idx]); +} + string_type Cyc_substring(object str, object start, object end) { const char *raw = string_str(str); int s = integer_value(start), @@ -879,6 +891,11 @@ string_type Cyc_substring(object str, object start, object end) { } } +object Cyc_command_line_arguments() { + Cyc_rt_raise_msg("not implemented yet"); + return boolean_f; +} + integer_type Cyc_system(object cmd) { if (nullp(cmd) || is_value_type(cmd) || type_of(cmd) != string_tag) { make_int(n, -1); @@ -1291,6 +1308,12 @@ void _string_91length(object cont, object args) { void _cyc_substring(object cont, object args) { string_type s = Cyc_substring(car(args), cadr(args), caddr(args)); return_funcall1(cont, &s);} +void _cyc_string_91ref(object cont, object args) { + object c = Cyc_string_ref(car(args), cadr(args)); + return_funcall1(cont, c); } +void _command_91line_91arguments(object cont, object args) { + object cmdline = Cyc_command_line_arguments(); + return_funcall1(cont, cmdline); } void _cyc_system(object cont, object args) { integer_type i = Cyc_system(car(args)); return_funcall1(cont, &i);} @@ -2028,6 +2051,8 @@ static primitive_type integer_91_125char_primitive = {primitive_tag, "integer->c 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 string_91ref_primitive = {primitive_tag, "string-ref", &_cyc_string_91ref}; +static primitive_type command_91line_91arguments_primitive = {primitive_tag, "command-line-arguments", &_command_91line_91arguments}; 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}; @@ -2141,6 +2166,8 @@ 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_string_91ref = &string_91ref_primitive; +const object primitive_command_91line_91arguments = &command_91line_91arguments_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 36d59c62..688d6acc 100644 --- a/runtime.h +++ b/runtime.h @@ -102,6 +102,8 @@ 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); +object Cyc_string_ref(object str, object k); +object Cyc_command_line_arguments(); integer_type Cyc_system(object cmd); integer_type Cyc_char2integer(object chr); object Cyc_integer2char(object n); @@ -318,6 +320,8 @@ extern const object primitive_make_91vector; extern const object primitive_list_91_125vector; extern const object primitive_vector_91ref; extern const object primitive_vector_91set_67; +extern const object primitive_string_91ref; +extern const object primitive_command_91line_91arguments; extern const object primitive_system; extern const object primitive_boolean_127; extern const object primitive_char_127; diff --git a/transforms.scm b/transforms.scm index 342f4e26..de7bba40 100644 --- a/transforms.scm +++ b/transforms.scm @@ -536,6 +536,7 @@ %halt exit system + command-line-arguments Cyc-default-exception-handler Cyc-current-exception-handler cons @@ -572,6 +573,7 @@ symbol->string number->string string-length + string-ref substring make-vector list->vector @@ -621,6 +623,7 @@ %halt exit system + command-line-arguments Cyc-default-exception-handler Cyc-current-exception-handler cell-get