* added open-input-string

src/libchezio.ss

@@ -471,6 +471,51 @@
               [else 
                (error 'input-file-handler
                       "message not handled ~s" (cons msg args))])))))
+    (define make-input-string-handler
+      (lambda (str)
+        (let ((open? #t))
+          (lambda (msg . args)
+            (message-case msg args
+              [(read-char p)
+               (let ([idx ($port-input-index p)])
+                 (if ($fx< idx ($port-input-size p))
+                     (begin
+                       ($set-port-input-index! p ($fxadd1 idx))
+                       ($string-ref ($port-input-buffer p) idx))
+                     (if open?
+                         (eof-object)
+                         (error 'read-char "port ~s is closed" p))))]
+              [(peek-char p)
+               (unless (input-port? p)
+                 (error 'peek-char "~s is not an input port" p))
+               (let ([idx ($port-input-index p)])
+                 (if ($fx< idx ($port-input-size p))
+                     ($string-ref ($port-input-buffer p) idx)
+                     (if open?
+                         (eof-object)
+                         (error 'peek-char "port ~s is closed" p))))]
+              [(unread-char c p)
+               (unless (input-port? p)
+                 (error 'unread-char "~s is not an input port" p))
+               (let ([idx ($fxsub1 ($port-input-index p))])
+                 (if (and ($fx>= idx 0)
+                          ($fx< idx ($port-input-size p)))
+                     (begin
+                       ($set-port-input-index! p idx)
+                       ($string-set! ($port-input-buffer p) idx c))
+                     (if open?
+                         (error 'unread-char "port ~s is closed" p)
+                         (error 'unread-char "too many unread-chars"))))]
+              [(port-name p) '*string-port*]
+              [(close-port p)
+               (unless (input-port? p)
+                 (error 'close-input-port "~s is not an input port" p))
+               (when open?
+                 ($set-port-input-size! p 0)
+                 (set! open? #f))]
+              [else 
+               (error 'input-string-handler
+                      "message not handled ~s" (cons msg args))]))))) 
     (define open-input-file
       (lambda (filename)
         (close-ports)
@@ -483,6 +528,15 @@
                 (guardian port)
                 port)
               (error 'open-input-file "cannot open ~s: ~a" filename fd/error)))))
+    (define open-input-string
+      (lambda (str)
+        (unless (string? str)
+          (error 'open-input-string "~s is not a string" str))
+        (let ([port (make-input-port
+                      (make-input-string-handler str)
+                      str)])
+          port)))
+    (primitive-set! 'open-input-string open-input-string)
     (primitive-set! '*standard-input-port* 
       (let ([p (make-input-port 
                  (make-input-file-handler 0 '*stdin*)

src/makefile.ss

@@ -81,6 +81,7 @@
     open-output-file open-input-file open-output-string
     with-output-to-string
     get-output-string with-output-to-file call-with-output-file
+    open-input-string
     with-input-from-file call-with-input-file date-string
     file-exists? delete-file + - add1 sub1 * / expt 
     quotient+remainder quotient remainder modulo number? positive?