conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Added file-options macro

This commit is contained in:
Abdulaziz Ghuloum 2007-10-11 23:43:25 -04:00
parent 4649598a7e
commit fdc0132573
6 changed files with 43 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

31
src/ikarus.codecs.ss
View File

@ -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])))
)

4
src/makefile.ss
View File

@ -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)

3
src/psyntax.compat.ss
View File

@ -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)))

8
src/psyntax.expander.ss
View File

@ -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)

2
src/todo-r6rs.ss
View File

@ -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]