Use a scheme version of (write)

cgen.scm

@@ -444,7 +444,7 @@
      ((eq? p 'read-char)             "Cyc_io_read_char")
      ((eq? p 'peek-char)             "Cyc_io_peek_char")
      ((eq? p 'display)               "Cyc_display_va")
-     ((eq? p 'write)                 "Cyc_write_va")
+     ((eq? p 'Cyc-write)             "Cyc_write_va")
      ((eq? p 'car)           "car")
      ((eq? p 'cdr)           "cdr")
      ((eq? p 'caar)          "caar")
@@ -563,7 +563,7 @@
 ;; Pass an integer arg count as the function's first parameter?
 (define (prim:arg-count? exp)
     (and (prim? exp)
-         (member exp '(error write display string-append + - * /))))
+         (member exp '(error Cyc-write display string-append + - * /))))
 
 ;; Does primitive allocate an object?
 (define (prim:allocates-object? exp)

eval.scm

@@ -289,7 +289,7 @@
       (list 'close-input-port close-input-port)
       (list 'read-char read-char)
       (list 'peek-char peek-char)
-      (list 'write write)
+      (list 'Cyc-write Cyc-write)
       (list 'display display)))
 
 (define (primitive-procedure-names)

runtime.c

@@ -424,7 +424,8 @@ object Cyc_write_va(int argc, object x, ...) {
 }
 
 object Cyc_write_va_list(int argc, object x, va_list ap) {
-  FILE *fp = stdout; // TODO: just a placeholder, should use current-output-port
+  FILE *fp = stdout; // OK since this is the internal version of write
+                     // Longer-term maybe we get rid of varargs for this one
   if (argc > 1) {
     object tmp;
     tmp = va_arg(ap, object);
@@ -1257,9 +1258,7 @@ void _read_91char(object cont, object args) {
     return_funcall1(cont, Cyc_io_read_char(car(args)));}
 void _peek_91char(object cont, object args) {  
     return_funcall1(cont, Cyc_io_peek_char(car(args)));}
-void _write(object cont, object args) {  
-
-//   TODO: this and _display below are broken and crashing in icyc. not sure what is going on?
+void _Cyc_91write(object cont, object args) {  
     integer_type argc = Cyc_length(args);
     dispatch(argc.value, (function_type)dispatch_write_va, cont, cont, args); }
 void _display(object cont, object args) {  
@@ -1948,7 +1947,7 @@ static primitive_type open_91input_91file_primitive = {primitive_tag, "open-inpu
 static primitive_type close_91input_91port_primitive = {primitive_tag, "close-input-port", &_close_91input_91port};
 static primitive_type read_91char_primitive = {primitive_tag, "read-char", &_read_91char};
 static primitive_type peek_91char_primitive = {primitive_tag, "peek-char", &_peek_91char};
-static primitive_type write_primitive = {primitive_tag, "write", &_write};
+static primitive_type Cyc_91write_primitive = {primitive_tag, "Cyc-write", &_Cyc_91write};
 static primitive_type display_primitive = {primitive_tag, "display", &_display};
 static primitive_type call_95cc_primitive = {primitive_tag, "call/cc", &_call_95cc};
 
@@ -2051,7 +2050,7 @@ const object primitive_open_91input_91file = &open_91input_91file_primitive;
 const object primitive_close_91input_91port = &close_91input_91port_primitive;
 const object primitive_read_91char = &read_91char_primitive;
 const object primitive_peek_91char = &peek_91char_primitive;
-const object primitive_write = &write_primitive;
+const object primitive_Cyc_91write = &Cyc_91write_primitive;
 const object primitive_display = &display_primitive;
 const object primitive_call_95cc = &call_95cc_primitive;
 

runtime.h

@@ -324,7 +324,7 @@ extern const object primitive_open_91input_91file;
 extern const object primitive_close_91input_91port;
 extern const object primitive_read_91char;
 extern const object primitive_peek_91char;
-extern const object primitive_write;
+extern const object primitive_Cyc_91write;
 extern const object primitive_display;
 extern const object primitive_call_95cc;
 /* -------------------------------------------- */

scheme/base.sld

@@ -54,6 +54,7 @@
     current-output-port
     ;current-input-port
     ;current-error-port
+    write ;; TODO: move to (scheme write) library
     error
     raise
     raise-continuable
@@ -284,6 +285,10 @@
              (error "bad parameter syntax"))))))
     (define current-output-port
       (make-parameter (Cyc-stdout)))
+    (define (write obj . port)
+      (if (null? port)
+          (Cyc-write obj (current-output-port))
+          (Cyc-write obj (car port))))
     (define (error msg . args)
       (raise (cons msg args)))
     (define (raise obj)

trans.scm

@@ -555,7 +555,7 @@
      close-input-port
      read-char
      peek-char
-     write
+     Cyc-write
      display))
 
 ;; Constant Folding