diff --git a/cgen.scm b/cgen.scm index 3c9074d3..824d9613 100644 --- a/cgen.scm +++ b/cgen.scm @@ -441,6 +441,7 @@ ((eq? p 'Cyc-default-exception-handler) "Cyc_default_exception_handler") ((eq? p 'Cyc-current-exception-handler) "Cyc_current_exception_handler") ((eq? p 'open-input-file) "Cyc_io_open_input_file") + ((eq? p 'open-output-file) "Cyc_io_open_output_file") ((eq? p 'close-port) "Cyc_io_close_port") ((eq? p 'close-input-port) "Cyc_io_close_input_port") ((eq? p 'close-output-port) "Cyc_io_close_output_port") @@ -536,6 +537,7 @@ ((eq? p 'Cyc-stdin) "port_type") ((eq? p 'Cyc-stderr) "port_type") ((eq? p 'open-input-file) "port_type") + ((eq? p 'open-output-file) "port_type") ((eq? p 'length) "integer_type") ((eq? p 'vector-length) "integer_type") ((eq? p 'char->integer) "integer_type") @@ -562,6 +564,7 @@ Cyc-stdin Cyc-stderr open-input-file + open-output-file char->integer system string->number string-append string-cmp list->string string->list make-vector list->vector diff --git a/eval.scm b/eval.scm index 5656eecf..d9f3cc84 100644 --- a/eval.scm +++ b/eval.scm @@ -286,6 +286,7 @@ (list 'string? string?) (list 'symbol? symbol?) (list 'open-input-file open-input-file) + (list 'open-output-file open-output-file) (list 'close-port close-port) (list 'close-input-port close-input-port) (list 'close-output-port close-output-port) diff --git a/runtime.c b/runtime.c index 865f0e87..eb3d91cf 100644 --- a/runtime.c +++ b/runtime.c @@ -1002,6 +1002,13 @@ port_type Cyc_io_open_input_file(object str) { return p; } +port_type Cyc_io_open_output_file(object str) { + const char *fname = ((string_type *)str)->str; + make_port(p, NULL, 0); + p.fp = fopen(fname, "w"); + return p; +} + object Cyc_io_close_input_port(object port) { return Cyc_io_close_port(port); } @@ -1286,6 +1293,9 @@ void _number_91_125string(object cont, object args) { void _open_91input_91file(object cont, object args) { port_type p = Cyc_io_open_input_file(car(args)); return_funcall1(cont, &p);} +void _open_91output_91file(object cont, object args) { + port_type p = Cyc_io_open_output_file(car(args)); + return_funcall1(cont, &p);} void _close_91port(object cont, object args) { return_funcall1(cont, Cyc_io_close_port(car(args)));} void _close_91input_91port(object cont, object args) { @@ -1984,6 +1994,7 @@ static primitive_type vector_127_primitive = {primitive_tag, "vector?", &_vector static primitive_type string_127_primitive = {primitive_tag, "string?", &_string_127}; static primitive_type symbol_127_primitive = {primitive_tag, "symbol?", &_symbol_127}; static primitive_type open_91input_91file_primitive = {primitive_tag, "open-input-file", &_open_91input_91file}; +static primitive_type open_91output_91file_primitive = {primitive_tag, "open-output-file", &_open_91output_91file}; static primitive_type close_91port_primitive = {primitive_tag, "close-port", &_close_91port}; static primitive_type close_91input_91port_primitive = {primitive_tag, "close-input-port", &_close_91input_91port}; static primitive_type close_91output_91port_primitive = {primitive_tag, "close-output-port", &_close_91output_91port}; @@ -2090,6 +2101,7 @@ const object primitive_port_127 = &port_127_primitive; const object primitive_vector_127 = &vector_127_primitive; const object primitive_symbol_127 = &symbol_127_primitive; const object primitive_open_91input_91file = &open_91input_91file_primitive; +const object primitive_open_91output_91file = &open_91output_91file_primitive; const object primitive_close_91port = &close_91port_primitive; const object primitive_close_91input_91port = &close_91input_91port_primitive; const object primitive_close_91output_91port = &close_91output_91port_primitive; diff --git a/runtime.h b/runtime.h index e8831e61..5373dea6 100644 --- a/runtime.h +++ b/runtime.h @@ -109,6 +109,7 @@ port_type Cyc_stdout(void); port_type Cyc_stdin(void); port_type Cyc_stderr(void); port_type Cyc_io_open_input_file(object str); +port_type Cyc_io_open_output_file(object str); object Cyc_io_close_port(object port); object Cyc_io_close_input_port(object port); object Cyc_io_close_output_port(object port); @@ -326,6 +327,7 @@ extern const object primitive_vector_127; extern const object primitive_string_127; extern const object primitive_symbol_127; extern const object primitive_open_91input_91file; +extern const object primitive_open_91output_91file; extern const object primitive_close_91port; extern const object primitive_close_91input_91port; extern const object primitive_close_91output_91port; diff --git a/scheme/base.sld b/scheme/base.sld index 22185f2f..b7f6ca83 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -56,10 +56,8 @@ current-input-port current-error-port call-with-port - ; TODO: call-with-input-file - ; TODO: call-with-output-file - ; TODO: close-input-port - ; TODO: close-output-port + call-with-input-file + call-with-output-file error raise raise-continuable @@ -93,6 +91,10 @@ (let ((result (proc port))) (close-port port) result)) + (define (call-with-input-file string proc) + (call-with-port (open-input-file string) proc)) + (define (call-with-output-file string proc) + (call-with-port (open-output-file string) proc)) (define (Cyc-bin-op cmp x lst) (cond ((null? lst) #t) diff --git a/transforms.scm b/transforms.scm index d0fdfc73..3751e002 100644 --- a/transforms.scm +++ b/transforms.scm @@ -554,6 +554,7 @@ string? symbol? open-input-file + open-output-file close-port close-input-port close-output-port @@ -596,6 +597,7 @@ Cyc-stdin Cyc-stderr open-input-file + open-output-file close-port close-input-port close-output-port