diff --git a/src/ikarus.boot b/src/ikarus.boot index 0ebdb36..8577b43 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.io.input-strings.ss b/src/ikarus.io.input-strings.ss index 2cc2a43..4e9bf76 100644 --- a/src/ikarus.io.input-strings.ss +++ b/src/ikarus.io.input-strings.ss @@ -1,5 +1,35 @@ -#error not yet +(library (ikarus io input-strings) + (export open-input-string) + (import + (ikarus system $strings) + (ikarus system $fx) + (ikarus system $pairs) + (ikarus system $ports) + (ikarus system $io) + (except (ikarus) open-input-string)) + + (define-syntax message-case + (syntax-rules (else) + [(_ msg args + [(msg-name msg-arg* ...) b b* ...] ... + [else else1 else2 ...]) + (let ([tmsg msg] [targs args]) + (define-syntax match-and-bind + (syntax-rules () + [(__ y () body) + (if (null? y) + body + (error 'message-case "unmatched ~s" (cons tmsg targs)))] + [(__ y (a a* (... ...)) body) + (if (pair? y) + (let ([a (car y)] [d (cdr y)]) + (match-and-bind d (a* (... ...)) body)) + (error 'message-case "unmatched ~s" (cons tmsg targs)))])) + (case tmsg + [(msg-name) + (match-and-bind targs (msg-arg* ...) (begin b b* ...))] ... + [else else1 else2 ...]))])) (define make-input-string-handler (lambda (str) @@ -55,4 +85,5 @@ (make-input-string-handler str) str)]) port))) + ) diff --git a/src/makefile.ss b/src/makefile.ss index e6f2dcc..44255f4 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -43,6 +43,7 @@ "ikarus.io-primitives.ss" "ikarus.io.input-files.ss" "ikarus.io.output-files.ss" + "ikarus.io.input-strings.ss" "ikarus.io.output-strings.ss" "ikarus.hash-tables.ss" "ikarus.writer.ss" @@ -334,6 +335,7 @@ [with-output-to-file i r] [open-output-file i r] [open-output-string i] + [open-input-string i] [get-output-string i] [with-output-to-string i] [close-input-port i r]