WIP

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

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;

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;

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)

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")

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

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)

test2.scm

@@ -1,7 +1,8 @@
 (import (scheme base)
         (scheme file)
         (scheme write))
-(write (make-vector 4 #t))
+  (apply make-vector '())
+  1
 ;
 ;(map
 ;  (lambda (_)