functional streams

parent 4dc79cb9
......@@ -39,6 +39,7 @@ Version 0.5,
* fast math and guile featured operators for numerics added.
Version 0.6, TODO
* Functional Streams DONE
* SWI Prolog namespacing
* if directives
* swi compability
......
......@@ -3,13 +3,27 @@
#:use-module (srfi srfi-9 gnu)
#:export (finsert finsert-l fwrite fwrite-l feof? feof-l?
fread fread-l fseek fseek-l
rw-fstream-from-file rw-fstream-from-string
r-fstream-from-file r-fstream-from-string
w-fstream-from-file-append w-fstream-from-string-append
fpeek fpeek-l
rw-fstream-from-file
rw-fstream-from-string
r-fstream-from-file
r-fstream-from-string
rw-fstream-from-file-append
w-fstream-from-file-append
w-fstream-from-string-append
rw-fstream-from-string-append
feof freadline freadline-l
make-empty-rw-fstream
make-empty-r-fstream
make-empty-w-fstream
fstream-rw?
fstream-r?
fstream-w?
write-fstream
rw-fstream-meta
r-fstream-meta
w-fstream-meta
fposition
))
;; Functional port or stream
......@@ -37,12 +51,27 @@
(l w-fstream-l set-w-fstream-l)
(meta w-fstream-meta set-w-fstream-meta))
(define (make-empty-rw-fstream)
(make-fstream-rw 0 0 '() '() '()))
(define (make-empty-r-fstream)
(make-fstream-r 0 '() '()))
(define (make-empty-w-fstream)
(make-fstream-r 0 '() '()))
(define make-empty-rw-fstream
(case-lambda
(()
(make-fstream-rw 0 0 '() '() '((#:open . #t) (#:file-name . #f))))
((str)
(make-fstream-rw 0 0 '() '() `((#:open . #t) (#:file-name . ,str))))))
(define make-empty-r-fstream
(case-lambda
(()
(make-fstream-r 0 '() '((#:open . #t) (#:file-name . #f))))
((str)
(make-fstream-r 0 '() `((#:open . #t) (#:file-name . ,str))))))
(define make-empty-w-fstream
(case-lambda
(()
(make-fstream-w 0 '() '((#:open . #t) (#:file-name . #f))))
((str)
(make-fstream-w 0 '() `((#:open . #t) (#:file-name . ,str))))))
(define (finsert stream x)
(cond
......@@ -282,30 +311,53 @@
(define (rw-fstream-from-file str)
(with-input-from-file str
(lambda ()
(let lp ((ch (read-char)) (s (make-empty-rw-fstream)))
(let lp ((ch (read-char)) (s (make-empty-rw-fstream `((#:file-name . ,str)
(#:open . #t))
)))
(if (eof-object? ch)
(fseek s 0)
(lp (read-char) (fwrite s ch)))))))
(define (rw-fstream-from-file-append str)
(with-input-from-file str
(lambda ()
(let lp ((ch (read-char)) (s (make-empty-rw-fstream `((#:file-name . ,str)
(#:open . #t))
)))
(if (eof-object? ch)
s
(lp (read-char) (fwrite s ch)))))))
(define (r-fstream-from-file str)
(rw->r (rw-fstream-from-file str)))
(define (w-fstream-from-file-append str)
(rw->w (seek-l (rw-fstream-from-file str) 0)))
(rw->w (rw-fstream-from-file-append str)))
(define (rw-fstream-from-string str)
(with-input-from-string str
(lambda ()
(let lp ((ch (read-char)) (s (make-empty-rw-fstream)))
(let lp ((ch (read-char)) (s (make-empty-rw-fstream `((#:file-name . #f)
(#:open . #t))
)))
(if (eof-object? ch)
(fseek s 0)
(lp (read-char) (fwrite s ch)))))))
(define (rw-fstream-from-string-append str)
(with-input-from-string str
(lambda ()
(let lp ((ch (read-char)) (s (make-empty-rw-fstream `((#:file-name . #f)
(#:open . #t))
)))
(if (eof-object? ch)
(lp (read-char) (fwrite s ch)))))))
(define (r-fstream-from-string str)
(rw->r (rw-fstream-from-string str)))
(define (w-fstream-from-string-append str)
(rw->w (seek-l (rw-fstream-from-string str) 0)))
(rw->w (rw-fstream-from-string-append str)))
(define (freadline stream)
(cond
......@@ -386,3 +438,38 @@
(else
(error "no rw/w fstream in freadline-l" stream))))
(define (write-fstream s)
(cond
((fstream-rw? s)
(let ((str ((assq #:file-name (rw-fstream-meta s)))))
(if str
(with-output-to-file str
(lambda ()
(let lp ((l (rw-fstream-r (fseek s 0))))
(if (pair? l)
(begin
(format #t "~a" (car l))
(lp (cdr l)))
#t)))))))
((fstream-w? s)
(let ((str ((assq #:file-name (w-fstream-meta s)))))
(if str
(with-output-to-file str
(lambda ()
(let lp ((l (reverse (w-fstream-l s))))
(if (pair? l)
(begin
(format #t "~a" (car l))
(lp (cdr l)))
#t)))))))
(else
#t)))
(define (fposition s)
(cond
((fstream-rw? s)
(rw-fstream-n s))
((fstream-w? s)
(rw-fstream-n s))
((fstream-w? s)
0)))
......@@ -53,6 +53,7 @@
ensure_loaded
;; io
functional
current_input current_output standard_input standard_output
set_input set_output
current_char_conversion char_conversion
......
This diff is collapsed.
......@@ -76,6 +76,7 @@
ignore_ops
numbervars
write_option
functional
read
write
......@@ -275,7 +276,7 @@
(mk-sym ignore_ops)
(mk-sym numbervars)
(mk-sym write_option)
(mk-sym functional)
(mk-sym char_conversion)
(mk-sym char-convert)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment