From 41cda2de8bc72dd334068f540c5772093f87ef8b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 27 Jul 2015 22:29:42 -0400 Subject: [PATCH] WIP --- Makefile | 4 ++-- include/cyclone/runtime.h | 2 ++ runtime.c | 26 ++++++++++++++++++++++++++ scheme/base.sld | 3 +++ scheme/cyclone/cgen.scm | 1 + scheme/cyclone/transforms.scm | 2 ++ scheme/eval.scm | 1 + test2.scm | 3 ++- 8 files changed, 39 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 706e7eed..e45e30ac 100644 --- a/Makefile +++ b/Makefile @@ -104,8 +104,6 @@ install: $(MKDIR) $(DESTDIR)$(INCDIR) $(MKDIR) $(DESTDIR)$(DATADIR) $(MKDIR) $(DESTDIR)$(DATADIR)/scheme/cyclone - $(INSTALL) -m0755 cyclone $(DESTDIR)$(BINDIR)/ - $(INSTALL) -m0755 icyc $(DESTDIR)$(BINDIR)/ $(INSTALL) -m0644 libcyclone.a $(DESTDIR)$(LIBDIR)/ $(INSTALL) -m0644 include/cyclone/*.h $(DESTDIR)$(INCDIR)/ $(INSTALL) -m0644 scheme/*.scm $(DESTDIR)$(DATADIR)/scheme @@ -114,6 +112,8 @@ install: $(INSTALL) -m0644 scheme/cyclone/*.scm $(DESTDIR)$(DATADIR)/scheme/cyclone $(INSTALL) -m0644 scheme/cyclone/*.sld $(DESTDIR)$(DATADIR)/scheme/cyclone $(INSTALL) -m0644 scheme/cyclone/*.o $(DESTDIR)$(DATADIR)/scheme/cyclone + $(INSTALL) -m0755 cyclone $(DESTDIR)$(BINDIR)/ + $(INSTALL) -m0755 icyc $(DESTDIR)$(BINDIR)/ uninstall: $(RM) $(DESTDIR)$(BINDIR)/cyclone diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index ebd8d879..f8eb3c12 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -133,6 +133,7 @@ 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_string_set(object str, object k, object chr); string_type Cyc_installation_dir(); object Cyc_command_line_arguments(object cont); integer_type Cyc_system(object cmd); @@ -350,6 +351,7 @@ 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_string_91set_67; extern const object primitive_Cyc_91installation_91dir; extern const object primitive_command_91line_91arguments; extern const object primitive_system; diff --git a/runtime.c b/runtime.c index 8da57e09..2bee7da1 100644 --- a/runtime.c +++ b/runtime.c @@ -978,6 +978,26 @@ integer_type Cyc_string_length(object str) { { make_int(len, strlen(string_str(str))); return len; }} +object Cyc_string_set(object str, object k, object chr) { + char *raw; + int idx, len; + + Cyc_check_str(str); + Cyc_check_int(k); + + if (!eq(boolean_t, Cyc_is_char(chr))) { + Cyc_rt_raise2("Expected char but received", chr); + } + + raw = string_str(str); + idx = integer_value(k), + len = strlen(raw); + + Cyc_check_bounds("string-set!", len, idx); + raw[idx] = obj_obj2char(chr); + return str; +} + object Cyc_string_ref(object str, object k) { const char *raw; int idx, len; @@ -1633,6 +1653,10 @@ void _cyc_substring(object cont, object args) { Cyc_check_num_args("substring", 3, args); { string_type s = Cyc_substring(car(args), cadr(args), caddr(args)); return_funcall1(cont, &s);}} +void _cyc_string_91set_67(object cont, object args) { + Cyc_check_num_args("string-set!", 3, args); + { object s = Cyc_string_set(car(args), cadr(args), caddr(args)); + return_funcall1(cont, s); }} void _cyc_string_91ref(object cont, object args) { Cyc_check_num_args("string-ref", 2, args); { object c = Cyc_string_ref(car(args), cadr(args)); @@ -2335,6 +2359,7 @@ static primitive_type string_91_125number_primitive = {primitive_tag, "string->n 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 string_91set_67_primitive = {primitive_tag, "string-set!", &_cyc_string_91set_67}; static primitive_type Cyc_91installation_91dir_primitive = {primitive_tag, "Cyc-installation-dir", &_Cyc_91installation_91dir}; 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}; @@ -2451,6 +2476,7 @@ 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_string_91set_67 = &string_91set_67_primitive; const object primitive_Cyc_91installation_91dir = &Cyc_91installation_91dir_primitive; const object primitive_command_91line_91arguments = &command_91line_91arguments_primitive; const object primitive_system = &system_primitive; diff --git a/scheme/base.sld b/scheme/base.sld index 3ce21c64..eac0e92d 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -41,6 +41,7 @@ symbol=? Cyc-obj=? make-string + string vector vector-append vector-copy @@ -275,6 +276,8 @@ (return #f))) objs) #t)))) + (define (string . chars) + (list->string chars)) (define (make-string k . fill) (let ((fill* (if (null? fill) '(#\space) diff --git a/scheme/cyclone/cgen.scm b/scheme/cyclone/cgen.scm index 925fd6c5..4be2d642 100644 --- a/scheme/cyclone/cgen.scm +++ b/scheme/cyclone/cgen.scm @@ -494,6 +494,7 @@ ((eq? p 'number->string) "Cyc_number2string") ((eq? p 'string-length) "Cyc_string_length") ((eq? p 'string-ref) "Cyc_string_ref") + ((eq? p 'string-set!) "Cyc_string_set") ((eq? p 'substring) "Cyc_substring") ((eq? p 'Cyc-installation-dir) "Cyc_installation_dir") ((eq? p 'command-line-arguments) "Cyc_command_line_arguments") diff --git a/scheme/cyclone/transforms.scm b/scheme/cyclone/transforms.scm index ab2a9897..a4299b9e 100644 --- a/scheme/cyclone/transforms.scm +++ b/scheme/cyclone/transforms.scm @@ -577,6 +577,7 @@ number->string string-length string-ref + string-set! substring make-vector list->vector @@ -636,6 +637,7 @@ cell set-car! set-cdr! + string-set! string->symbol ;; Could be mistaken for an identifier string->list ;; Mistaken for function call (maybe OK if it was quoted, though). same for above? make-vector diff --git a/scheme/eval.scm b/scheme/eval.scm index c6869f54..8008d1e7 100644 --- a/scheme/eval.scm +++ b/scheme/eval.scm @@ -264,6 +264,7 @@ (list 'number->string number->string) (list 'string-length string-length) (list 'string-ref string-ref) + (list 'string-set! string-set!) (list 'substring substring) (list 'make-vector make-vector) (list 'list->vector list->vector) diff --git a/test2.scm b/test2.scm index f54963e7..a00bcb5b 100644 --- a/test2.scm +++ b/test2.scm @@ -1,7 +1,8 @@ (import (scheme base) (scheme file) (scheme write)) -(write (make-vector 4 #t)) + (apply make-vector '()) + 1 ; ;(map ; (lambda (_)