From cb44b8f4fe3a4ceb341e3edb470856d1785d1938 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Thu, 31 Dec 2009 01:20:09 +0900
Subject: [PATCH] adding port folding utils

---
 lib/chibi/io.module  |  4 +++-
 lib/chibi/io/io.scm  | 49 ++++++++++++++++++++++++++++++++++++++++++++
 lib/chibi/io/io.stub |  6 +++---
 3 files changed, 55 insertions(+), 4 deletions(-)

diff --git a/lib/chibi/io.module b/lib/chibi/io.module
index f20b5b31..f9d531f3 100644
--- a/lib/chibi/io.module
+++ b/lib/chibi/io.module
@@ -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"))
diff --git a/lib/chibi/io/io.scm b/lib/chibi/io/io.scm
index 3ffa8a98..a6e0f8d2 100644
--- a/lib/chibi/io/io.scm
+++ b/lib/chibi/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)))
diff --git a/lib/chibi/io/io.stub b/lib/chibi/io/io.stub
index 665d1bb5..685e1832 100644
--- a/lib/chibi/io/io.stub
+++ b/lib/chibi/io/io.stub
@@ -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)))