From 5bac0ad7669e2f91042bc32316b1ccef22ea724d Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Thu, 22 Nov 2007 16:27:55 -0500
Subject: [PATCH] Added get-string-n!

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

diff --git a/scheme/ikarus.io-primitives.ss b/scheme/ikarus.io-primitives.ss
index 6c2311c..e922cb9 100644
--- a/scheme/ikarus.io-primitives.ss
+++ b/scheme/ikarus.io-primitives.ss
@@ -17,7 +17,7 @@
 (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 get-string-n get-bytevector-n
+          get-char get-u8 get-string-n get-string-n! get-bytevector-n
           newline port-name input-port-name output-port-name
           close-input-port reset-input-port! 
           flush-output-port close-output-port get-line)
@@ -27,7 +27,7 @@
     (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 get-string-n get-bytevector-n
+            get-char get-u8 get-string-n get-string-n! get-bytevector-n
             newline port-name input-port-name output-port-name
             close-input-port reset-input-port!  flush-output-port
             close-output-port get-line))
@@ -321,6 +321,45 @@
       [($fx= n 0) ""]
       [else (error 'get-string-n "count is negative" n)]))
 
+  (define (get-string-n! p s i c) 
+    (import (ikarus system $fx) (ikarus system $strings))
+    (unless (input-port? p) 
+      (error 'get-string-n! "not an input port" p))
+    (unless (string? s) 
+      (error 'get-string-n! "not a string" s))
+    (let ([len ($string-length s)])
+      (unless (fixnum? i) 
+        (error 'get-string-n! "starting index is not a fixnum" i))
+      (when (or ($fx< i 0) ($fx> i len))
+        (error 'get-string-n! 
+          (format "starting index is out of range 0..~a" len)
+          i))
+      (unless (fixnum? c) 
+        (error 'get-string-n! "count is not a fixnum" c))
+      (cond
+        [($fx> c 0)
+         (let ([j (+ i c)])
+           (when (> j len)
+             (error 'get-string-n! 
+               (format "count is out of range 0..~a" (- len i))
+               c))
+           (let ([x ($read-char p)])
+             (cond
+               [(eof-object? x) x]
+               [else
+                ($string-set! s i x)
+                (let f ([p p] [s s] [start i] [i 1] [c c])
+                  (let ([x ($read-char p)])
+                    (cond
+                      [(eof-object? x) i]
+                      [else
+                       ($string-set! s ($fx+ start i) x)
+                       (let ([i ($fxadd1 i)])
+                         (if ($fx= i c)
+                             i
+                             (f p s start i c)))])))])))]
+        [($fx= c 0) 0]
+        [else (error 'get-string-n! "count is negative" c)])))
 
   (define (get-bytevector-n p n) 
     (import (ikarus system $fx) (ikarus system $bytevectors))
diff --git a/scheme/last-revision b/scheme/last-revision
index ecdb865..09e35ab 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1112
+1113
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index deaff4b..276d565 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -1066,7 +1066,7 @@
     [get-line                                    i r ip]
     [get-string-all                              r ip]
     [get-string-n                                i r ip]
-    [get-string-n!                               r ip]
+    [get-string-n!                               i r ip]
     [get-u8                                      i r ip]
     [$get-u8                                     $io]
     [&i/o                                        i r ip is fi]
diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss
index 099cba6..25bccbe 100755
--- a/scheme/todo-r6rs.ss
+++ b/scheme/todo-r6rs.ss
@@ -572,7 +572,7 @@
     [get-line                                   C ip]
     [get-string-all                             S ip]
     [get-string-n                               C ip]
-    [get-string-n!                              S ip]
+    [get-string-n!                              C ip]
     [get-u8                                     C ip]
     [&i/o                                       C ip is fi]
     [&i/o-decoding                              C ip]