WIP - optional argument for (display)

cgen.scm

@@ -443,7 +443,7 @@
      ((eq? p 'close-input-port)      "Cyc_io_close_input_port")
      ((eq? p 'read-char)             "Cyc_io_read_char")
      ((eq? p 'peek-char)             "Cyc_io_peek_char")
-     ((eq? p 'display)               "Cyc_display_va")
+     ((eq? p 'Cyc-display)           "Cyc_display_va")
      ((eq? p 'Cyc-write)             "Cyc_write_va")
      ((eq? p 'car)           "car")
      ((eq? p 'cdr)           "cdr")
@@ -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 Cyc-write display string-append + - * /))))
+         (member exp '(error Cyc-write Cyc-display string-append + - * /))))
 
 ;; Does primitive allocate an object?
 (define (prim:allocates-object? exp)

eval.scm

@@ -290,7 +290,7 @@
       (list 'read-char read-char)
       (list 'peek-char peek-char)
       (list 'Cyc-write Cyc-write)
-      (list 'display display)))
+      (list 'Cyc-display Cyc-display)))
 
 (define (primitive-procedure-names)
   (map car

runtime.c

@@ -1948,7 +1948,7 @@ static primitive_type close_91input_91port_primitive = {primitive_tag, "close-in
 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 Cyc_91write_primitive = {primitive_tag, "Cyc-write", &_Cyc_91write};
-static primitive_type display_primitive = {primitive_tag, "display", &_display};
+static primitive_type Cyc_91display_primitive = {primitive_tag, "Cyc-display", &_display};
 static primitive_type call_95cc_primitive = {primitive_tag, "call/cc", &_call_95cc};
 
 const object primitive_Cyc_91global_91vars = &Cyc_91global_91vars_primitive;
@@ -2051,6 +2051,6 @@ 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_Cyc_91write = &Cyc_91write_primitive;
-const object primitive_display = &display_primitive;
+const object primitive_Cyc_91display = &Cyc_91display_primitive;
 const object primitive_call_95cc = &call_95cc_primitive;
 

runtime.h

@@ -325,7 +325,7 @@ extern const object primitive_close_91input_91port;
 extern const object primitive_read_91char;
 extern const object primitive_peek_91char;
 extern const object primitive_Cyc_91write;
-extern const object primitive_display;
+extern const object primitive_Cyc_91display;
 extern const object primitive_call_95cc;
 /* -------------------------------------------- */
 

scheme/base.sld

@@ -63,6 +63,7 @@
     Cyc-add-exception-handler
     Cyc-remove-exception-handler
     newline
+    write-char
   )
   (include "common.scm")
   (begin
@@ -119,6 +120,10 @@
         end
         (func (car lst) (foldr func end (cdr lst)))))
     (define (newline) (display "\n"))
+    (define (write-char char . port)
+      (if (null? port)
+        (Cyc-write-char char (current-output-port))
+        (Cyc-write-char char (car port))))
     (define (not x) (if x #f #t))
     (define (list? o)
       (define (_list? obj)

scheme/write.sld

@@ -1,9 +1,14 @@
 (define-library (scheme write)
   (export
+    display
     write
   )
   (import (scheme base))
   (begin
+    (define (display obj . port)
+      (if (null? port)
+          (Cyc-display obj (current-output-port))
+          (Cyc-display obj (car port))))
     (define (write obj . port)
       (if (null? port)
           (Cyc-write obj (current-output-port))

transforms.scm

@@ -556,7 +556,7 @@
      read-char
      peek-char
      Cyc-write
-     display))
+     Cyc-display))
 
 ;; Constant Folding
 ;; Is a primitive being applied in such a way that it can be