mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-21 14:49:18 +02:00
adding port folding utils
This commit is contained in:
parent
430e21417b
commit
cb44b8f4fe
3 changed files with 55 additions and 4 deletions
|
@ -1,6 +1,8 @@
|
|||
|
||||
(define-module (chibi io)
|
||||
(export read-string read-string! write-string read-line write-line)
|
||||
(export read-string read-string! write-string read-line write-line
|
||||
port-fold port-fold-right port-map
|
||||
port->list port->string-list port->sexp-list port->string)
|
||||
(import-immutable (scheme))
|
||||
(include-shared "io/io")
|
||||
(include "io/io.scm"))
|
||||
|
|
|
@ -1,6 +1,55 @@
|
|||
|
||||
(define eof
|
||||
(call-with-input-string " "
|
||||
(lambda (in) (read-char in) (read-char in))))
|
||||
|
||||
(define (write-line str . o)
|
||||
(let ((out (if (pair? o) (car o) (current-output-port))))
|
||||
(display str out)
|
||||
(newline out)))
|
||||
|
||||
(define (read-line . o)
|
||||
(let ((in (if (pair? o) (car o) (current-input-port)))
|
||||
(n (if (and (pair? o) (pair? (cdr o))) (car (cdr o)) 8192)))
|
||||
(let ((res (%read-line n in)))
|
||||
(if (not res) eof res))))
|
||||
|
||||
(define (read-string n . o)
|
||||
(let ((in (if (pair? o) (car o) (current-input-port))))
|
||||
(let ((res (%read-string n in)))
|
||||
(if (if (pair? res) (= 0 (car res)) #t)
|
||||
eof
|
||||
(cadr res)))))
|
||||
|
||||
(define (port-fold kons knil . o)
|
||||
(let ((read (if (pair? o) (car o) read))
|
||||
(in (if (and (pair? o) (pair? (cdr o)))
|
||||
(car (cdr o))
|
||||
(current-input-port))))
|
||||
(let lp ((acc knil))
|
||||
(let ((x (read in)))
|
||||
(if (eof-object? x) acc (lp (kons x acc)))))))
|
||||
|
||||
(define (port-fold-right kons knil . o)
|
||||
(let ((read (if (pair? o) (car o) read))
|
||||
(in (if (and (pair? o) (pair? (cdr o)))
|
||||
(car (cdr o))
|
||||
(current-input-port))))
|
||||
(let lp ()
|
||||
(let ((x (read in)))
|
||||
(if (eof-object? x) knil (kons x (lp)))))))
|
||||
|
||||
(define (port-map fn . o)
|
||||
(reverse (apply port-fold (lambda (x ls) (cons (fn x) ls)) '() o)))
|
||||
|
||||
(define (port->list read in)
|
||||
(port-map (lambda (x) x) read in))
|
||||
|
||||
(define (port->sexp-list in)
|
||||
(port->list read in))
|
||||
|
||||
(define (port->string-list in)
|
||||
(port->list read-line in))
|
||||
|
||||
(define (port->string in)
|
||||
(string-concatenate (port->list (lambda (in) (read-string 1024 in)) in)))
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
|
||||
(define-c non-null-string (read-line "fgets")
|
||||
(define-c non-null-string (%read-line "fgets")
|
||||
((result (array char arg1)) int (default (current-input-port) input-port)))
|
||||
|
||||
(define-c size_t (read-string "fread")
|
||||
((result (array char arg1)) size_t (value 1 size_t) (default (current-input-port) input-port)))
|
||||
(define-c size_t (%read-string "fread")
|
||||
((result (array char arg2)) (value 1 size_t) size_t (default (current-input-port) input-port)))
|
||||
|
||||
(define-c size_t (read-string! "fread")
|
||||
(string size_t (value 1 size_t) (default (current-input-port) input-port)))
|
||||
|
|
Loading…
Add table
Reference in a new issue