functional streams

parent 4dc79cb9
...@@ -39,6 +39,7 @@ Version 0.5, ...@@ -39,6 +39,7 @@ Version 0.5,
* fast math and guile featured operators for numerics added. * fast math and guile featured operators for numerics added.
Version 0.6, TODO Version 0.6, TODO
* Functional Streams DONE
* SWI Prolog namespacing * SWI Prolog namespacing
* if directives * if directives
* swi compability * swi compability
......
...@@ -3,13 +3,27 @@ ...@@ -3,13 +3,27 @@
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:export (finsert finsert-l fwrite fwrite-l feof? feof-l? #:export (finsert finsert-l fwrite fwrite-l feof? feof-l?
fread fread-l fseek fseek-l fread fread-l fseek fseek-l
rw-fstream-from-file rw-fstream-from-string fpeek fpeek-l
r-fstream-from-file r-fstream-from-string rw-fstream-from-file
w-fstream-from-file-append w-fstream-from-string-append 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 feof freadline freadline-l
make-empty-rw-fstream make-empty-rw-fstream
make-empty-r-fstream make-empty-r-fstream
make-empty-w-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 ;; Functional port or stream
...@@ -37,13 +51,28 @@ ...@@ -37,13 +51,28 @@
(l w-fstream-l set-w-fstream-l) (l w-fstream-l set-w-fstream-l)
(meta w-fstream-meta set-w-fstream-meta)) (meta w-fstream-meta set-w-fstream-meta))
(define (make-empty-rw-fstream) (define make-empty-rw-fstream
(make-fstream-rw 0 0 '() '() '())) (case-lambda
(define (make-empty-r-fstream) (()
(make-fstream-r 0 '() '())) (make-fstream-rw 0 0 '() '() '((#:open . #t) (#:file-name . #f))))
(define (make-empty-w-fstream) ((str)
(make-fstream-r 0 '() '())) (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) (define (finsert stream x)
(cond (cond
((fstream-rw? stream) ((fstream-rw? stream)
...@@ -282,30 +311,53 @@ ...@@ -282,30 +311,53 @@
(define (rw-fstream-from-file str) (define (rw-fstream-from-file str)
(with-input-from-file str (with-input-from-file str
(lambda () (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) (if (eof-object? ch)
(fseek s 0) (fseek s 0)
(lp (read-char) (fwrite s ch))))))) (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) (define (r-fstream-from-file str)
(rw->r (rw-fstream-from-file str))) (rw->r (rw-fstream-from-file str)))
(define (w-fstream-from-file-append 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) (define (rw-fstream-from-string str)
(with-input-from-string str (with-input-from-string str
(lambda () (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) (if (eof-object? ch)
(fseek s 0) (fseek s 0)
(lp (read-char) (fwrite s ch))))))) (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) (define (r-fstream-from-string str)
(rw->r (rw-fstream-from-string str))) (rw->r (rw-fstream-from-string str)))
(define (w-fstream-from-string-append 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) (define (freadline stream)
(cond (cond
...@@ -386,3 +438,38 @@ ...@@ -386,3 +438,38 @@
(else (else
(error "no rw/w fstream in freadline-l" stream)))) (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 @@ ...@@ -53,6 +53,7 @@
ensure_loaded ensure_loaded
;; io ;; io
functional
current_input current_output standard_input standard_output current_input current_output standard_input standard_output
set_input set_output set_input set_output
current_char_conversion char_conversion current_char_conversion char_conversion
......
This diff is collapsed.
...@@ -76,6 +76,7 @@ ...@@ -76,6 +76,7 @@
ignore_ops ignore_ops
numbervars numbervars
write_option write_option
functional
read read
write write
...@@ -275,7 +276,7 @@ ...@@ -275,7 +276,7 @@
(mk-sym ignore_ops) (mk-sym ignore_ops)
(mk-sym numbervars) (mk-sym numbervars)
(mk-sym write_option) (mk-sym write_option)
(mk-sym functional)
(mk-sym char_conversion) (mk-sym char_conversion)
(mk-sym char-convert) (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