diff --git a/scheme/base.sld b/scheme/base.sld index 3f7c0b53..a87be74c 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -109,6 +109,10 @@ write-string flush-output-port read-line + input-port? + output-port? + input-port-open? + output-port-open? features any every @@ -177,12 +181,6 @@ ; open-input-string ; open-output-string ; -; ; it seems like these should be very do-able?? -; input-port-open? -; input-port? -; output-port-open? -; output-port? -; ; for a lot of the following, need begin-splicing, or syntax-rules ; binary-port? ; define-values @@ -937,4 +935,36 @@ (define-c eof-object "(void *data, int argc, closure _, object k)" " return_closcall1(data, k, Cyc_EOF); ") + (define-c input-port? + "(void *data, int argc, closure _, object k, object port)" + " port_type *p = (port_type *)port; + Cyc_check_port(data, port); + return_closcall1( + data, + k, + (p->mode == 1) ? boolean_t : boolean_f); ") + (define-c output-port? + "(void *data, int argc, closure _, object k, object port)" + " port_type *p = (port_type *)port; + Cyc_check_port(data, port); + return_closcall1( + data, + k, + (p->mode == 0) ? boolean_t : boolean_f); ") + (define-c input-port-open? + "(void *data, int argc, closure _, object k, object port)" + " port_type *p = (port_type *)port; + Cyc_check_port(data, port); + return_closcall1( + data, + k, + (p->mode == 1 && p->fp != NULL) ? boolean_t : boolean_f); ") + (define-c output-port-open? + "(void *data, int argc, closure _, object k, object port)" + " port_type *p = (port_type *)port; + Cyc_check_port(data, port); + return_closcall1( + data, + k, + (p->mode == 0 && p->fp != NULL) ? boolean_t : boolean_f); ") ))