From 335f3e86d58ff05f395e87b912edec947692b4da Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 11 Jun 2015 21:43:55 -0400 Subject: [PATCH] Use a scheme version of (write) --- cgen.scm | 4 ++-- eval.scm | 2 +- runtime.c | 11 +++++------ runtime.h | 2 +- scheme/base.sld | 5 +++++ trans.scm | 2 +- 6 files changed, 15 insertions(+), 11 deletions(-) diff --git a/cgen.scm b/cgen.scm index 90866e9d..1dac4074 100644 --- a/cgen.scm +++ b/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) diff --git a/eval.scm b/eval.scm index 8ec1b5e1..44f32975 100644 --- a/eval.scm +++ b/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) diff --git a/runtime.c b/runtime.c index 0adcdc46..a7f7f8b8 100644 --- a/runtime.c +++ b/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; diff --git a/runtime.h b/runtime.h index a76240c6..b8a8d468 100644 --- a/runtime.h +++ b/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; /* -------------------------------------------- */ diff --git a/scheme/base.sld b/scheme/base.sld index ff910029..203cb3fd 100644 --- a/scheme/base.sld +++ b/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) diff --git a/trans.scm b/trans.scm index 8957e785..908f0f2d 100644 --- a/trans.scm +++ b/trans.scm @@ -555,7 +555,7 @@ close-input-port read-char peek-char - write + Cyc-write display)) ;; Constant Folding