From bfccea77180e4e73271f1e25c5ffb713cc2dd520 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Thu, 22 Nov 2007 15:54:10 -0500
Subject: [PATCH] Added get-string-n

---
 scheme/ikarus.io-primitives.ss | 30 ++++++++++++++++++++++++++++--
 scheme/last-revision           |  2 +-
 scheme/makefile.ss             |  2 +-
 scheme/todo-r6rs.ss            |  2 +-
 4 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/scheme/ikarus.io-primitives.ss b/scheme/ikarus.io-primitives.ss
index 796bedb..bd85098 100644
--- a/scheme/ikarus.io-primitives.ss
+++ b/scheme/ikarus.io-primitives.ss
@@ -16,7 +16,8 @@
 
 (library (ikarus io-primitives)
   (export read-char unread-char peek-char write-char write-byte
-          put-u8 put-char put-string put-bytevector get-char get-u8
+          put-u8 put-char put-string put-bytevector 
+          get-char get-u8 get-string-n
           newline port-name input-port-name output-port-name
           close-input-port reset-input-port! 
           flush-output-port close-output-port get-line)
@@ -25,7 +26,8 @@
     (ikarus system $fx)
     (ikarus system $ports)
     (except (ikarus) read-char unread-char peek-char write-char write-byte 
-            put-u8 put-char put-string put-bytevector get-char get-u8
+            put-u8 put-char put-string put-bytevector
+            get-char get-u8 get-string-n
             newline port-name input-port-name output-port-name
             close-input-port reset-input-port!  flush-output-port
             close-output-port get-line))
@@ -293,5 +295,29 @@
                  c))
              ($put-bytevector p s i j)))])))
 
+  (define (get-string-n p n) 
+    (import (ikarus system $fx) (ikarus system $strings))
+    (unless (input-port? p) 
+      (error 'get-string-n "not an input port" p))
+    (unless (fixnum? n) 
+      (error 'get-string-n "count is not a fixnum" n))
+    (cond
+      [($fx> n 0) 
+       (let ([s ($make-string n)])
+         (let f ([p p] [n n] [s s] [i 0])
+           (let ([x ($read-char p)])
+             (cond
+               [(eof-object? x) 
+                (if ($fx= i 0) 
+                    (eof-object)
+                    (substring s 0 i))]
+               [else
+                ($string-set! s i x) 
+                (let ([i ($fxadd1 i)])
+                  (if ($fx= i n) 
+                      s
+                      (f p n s i)))]))))]
+      [($fx= n 0) ""]
+      [else (error 'get-string-n "count is negative" n)]))
   )
 
diff --git a/scheme/last-revision b/scheme/last-revision
index 0a75ff7..5f2f16b 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1110
+1111
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index 297e837..784f7c5 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -1065,7 +1065,7 @@
     [get-datum                                   i r ip]
     [get-line                                    i r ip]
     [get-string-all                              r ip]
-    [get-string-n                                r ip]
+    [get-string-n                                i r ip]
     [get-string-n!                               r ip]
     [get-u8                                      i r ip]
     [$get-u8                                     $io]
diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss
index 193cf34..2a21740 100755
--- a/scheme/todo-r6rs.ss
+++ b/scheme/todo-r6rs.ss
@@ -571,7 +571,7 @@
     [get-datum                                  C ip]
     [get-line                                   C ip]
     [get-string-all                             S ip]
-    [get-string-n                               S ip]
+    [get-string-n                               C ip]
     [get-string-n!                              S ip]
     [get-u8                                     C ip]
     [&i/o                                       C ip is fi]