diff --git a/src/ikarus.boot b/src/ikarus.boot index 0ea64af..556b712 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.codecs.ss b/src/ikarus.codecs.ss index 84ca6a5..ddccac4 100644 --- a/src/ikarus.codecs.ss +++ b/src/ikarus.codecs.ss @@ -1,11 +1,12 @@ (library (ikarus codecs) (export latin-1-codec utf-8-codec utf-16-codec native-eol-style - make-transcoder native-transcoder buffer-mode?) + make-transcoder native-transcoder buffer-mode? + file-options-spec) (import (except (ikarus) latin-1-codec utf-8-codec utf-16-codec native-eol-style make-transcoder native-transcoder - buffer-mode?) + buffer-mode? file-options-spec) (ikarus system $transcoders)) (define (latin-1-codec) 'latin-1-codec) (define (utf-8-codec) 'utf-8-codec) @@ -65,5 +66,31 @@ (define (buffer-mode? x) (and (memq x '(none line block)) #t)) + (define file-options-vec + '#(fo:default + fo:no-create + fo:no-fail + fo:no-fail/no-create + fo:no-truncate + fo:no-truncate/no-create + fo:no-truncate/no-fail + fo:no-truncate/no-fail/no-create)) + + (define file-options-alist + '([no-create . #b001] + [no-fail . #b010] + [no-truncate . #b100])) + + (define (file-options-spec ls) + (unless (list? ls) + (error 'file-options-spec "~s is not a list" ls)) + (let f ([ls ls] [n 0]) + (cond + [(null? ls) (vector-ref file-options-vec n)] + [(assq (car ls) file-options-alist) => + (lambda (a) + (f (cdr ls) (fxlogor (cdr a) n)))] + [else #f]))) + ) diff --git a/src/makefile.ss b/src/makefile.ss index 6f1dac8..56ddf9b 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -133,6 +133,7 @@ [trace-define (macro . trace-define)] [eol-style (macro . eol-style)] [buffer-mode (macro . buffer-mode)] + [file-options (macro . file-options)] [error-handling-mode (macro . error-handling-mode)] )) @@ -969,7 +970,7 @@ [close-port r ip] [eol-style i r ip] [error-handling-mode i r ip] - [file-options r ip] + [file-options i r ip] [flush-output-port i r ip] [get-bytevector-all r ip] [get-bytevector-n r ip] @@ -1199,6 +1200,7 @@ [$transcoder? $transc] [$transcoder->data $transc] [$data->transcoder $transc] + [file-options-spec i] )) (define (macro-identifier? x) diff --git a/src/psyntax.compat.ss b/src/psyntax.compat.ss index cafed60..d6d17cf 100644 --- a/src/psyntax.compat.ss +++ b/src/psyntax.compat.ss @@ -1,7 +1,8 @@ (library (psyntax compat) (export define-record make-parameter parameterize format gensym - eval-core make-record-type symbol-value set-symbol-value!) + eval-core make-record-type symbol-value set-symbol-value! + file-options-spec) (import (only (ikarus compiler) eval-core) (rename (ikarus) (define-record sys.define-record))) diff --git a/src/psyntax.expander.ss b/src/psyntax.expander.ss index ed5afde..51c45ef 100644 --- a/src/psyntax.expander.ss +++ b/src/psyntax.expander.ss @@ -1879,6 +1879,13 @@ ((type-descriptor) type-descriptor-transformer) (else (error 'macro-transformer "cannot find ~s" name))))) + (define file-options-macro + (lambda (x) + (syntax-match x () + ((_ opt* ...) + (and (for-all id? opt*) (file-options-spec (map id->sym opt*))) + (bless `(quote ,(file-options-spec (map id->sym opt*)))))))) + (define symbol-macro (lambda (x set) (syntax-match x () @@ -1920,6 +1927,7 @@ ((buffer-mode) (lambda (x) (symbol-macro x '(none line block)))) + ((file-options) file-options-macro) ((... => _ else unquote unquote-splicing unsyntax unsyntax-splicing) incorrect-usage-macro) diff --git a/src/todo-r6rs.ss b/src/todo-r6rs.ss index 7eb6209..57aaae6 100755 --- a/src/todo-r6rs.ss +++ b/src/todo-r6rs.ss @@ -546,7 +546,7 @@ [close-port S ip] [eol-style C ip] [error-handling-mode C ip] - [file-options S ip] + [file-options C ip] [flush-output-port S ip] [get-bytevector-all S ip] [get-bytevector-n S ip]