diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss index edfd2a9..96c4a5c 100644 --- a/scheme/ikarus.io.ss +++ b/scheme/ikarus.io.ss @@ -22,7 +22,8 @@ call-with-input-file with-input-from-file standard-input-port current-input-port open-bytevector-input-port - open-string-input-port with-input-from-string + open-string-input-port open-string-input-port/id + with-input-from-string make-custom-binary-input-port make-custom-binary-output-port make-custom-textual-input-port @@ -531,21 +532,25 @@ (die 'get-output-string "not an output-string port" p)])) (die 'get-output-string "not a port" p))) - (define (open-string-input-port str) + + + (define (open-string-input-port/id str id) (unless (string? str) (die 'open-string-input-port "not a string" str)) ($make-port (fxior textual-input-port-bits fast-char-text-tag) 0 (string-length str) str #t ;;; transcoder - "*string-input-port*" + id (lambda (str i c) 0) ;;; read! #f ;;; write! #f ;;; FIXME: get-position #f ;;; FIXME: set-position! #f ;;; close #f)) - + + (define (open-string-input-port str) + (open-string-input-port/id str "*string-input-port*")) (define (transcoded-port p transcoder) (define who 'transcoded-port) diff --git a/scheme/ikarus.load.ss b/scheme/ikarus.load.ss index bfef0f5..46eae70 100644 --- a/scheme/ikarus.load.ss +++ b/scheme/ikarus.load.ss @@ -22,7 +22,7 @@ (only (psyntax library-manager) serialize-all current-precompiled-library-loader) (only (psyntax expander) compile-r6rs-top-level) - (only (ikarus reader) read-initial)) + (only (ikarus reader) read-initial read-script-source-file)) (define-struct serialized-library (contents)) @@ -89,20 +89,7 @@ (close-input-port p))])) (define load-r6rs-top-level (lambda (x how) - (define (read-file) - (let ([p (open-input-file x)]) - (let ([x (read-script-annotated p)]) - (if (eof-object? x) - (begin (close-input-port p) '()) - (cons x - (let f () - (let ([x (read-annotated p)]) - (cond - [(eof-object? x) - (close-input-port p) - '()] - [else (cons x (f))])))))))) - (let ([prog (read-file)]) + (let ([prog (read-script-source-file x)]) (let ([thunk (compile-r6rs-top-level prog)]) (case how [(run) (thunk)] diff --git a/scheme/ikarus.reader.ss b/scheme/ikarus.reader.ss index 19372fe..ca4fb0d 100644 --- a/scheme/ikarus.reader.ss +++ b/scheme/ikarus.reader.ss @@ -18,12 +18,14 @@ (export read read-initial read-token comment-handler get-datum read-annotated read-script-annotated annotation? annotation-expression annotation-source - annotation-stripped) + annotation-stripped + read-library-source-file read-script-source-file) (import (ikarus system $chars) (ikarus system $fx) (ikarus system $pairs) (ikarus system $bytevectors) + (only (io-spec) open-string-input-port/id) (only (ikarus unicode-data) unicode-printable-char?) (except (ikarus) read-char read read-token comment-handler get-datum read-annotated read-script-annotated annotation? @@ -1426,5 +1428,27 @@ (die 'comment-handler "not a procedure" x)) x))) + (define (annotated-port file-name) + (open-string-input-port/id + (with-input-from-file file-name + (lambda () (get-string-all (current-input-port)))) + file-name)) + + (define (read-library-source-file file-name) + (read-annotated (annotated-port file-name))) + + (define (read-script-source-file file-name) + (let ([p (annotated-port file-name)]) + (let ([x (read-script-annotated p)]) + (if (eof-object? x) + (begin (close-input-port p) '()) + (cons x + (let f () + (let ([x (read-annotated p)]) + (cond + [(eof-object? x) + (close-input-port p) + '()] + [else (cons x (f))])))))))) ) diff --git a/scheme/last-revision b/scheme/last-revision index 6d36565..a84d4e6 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1469 +1470 diff --git a/scheme/psyntax.compat.ss b/scheme/psyntax.compat.ss index 616fd03..2940731 100644 --- a/scheme/psyntax.compat.ss +++ b/scheme/psyntax.compat.ss @@ -19,12 +19,13 @@ eval-core symbol-value set-symbol-value! file-options-spec make-struct-type read-annotated annotation? annotation-expression annotation-source - annotation-stripped load-precompiled-library) + annotation-stripped + read-library-source-file) (import (only (ikarus.compiler) eval-core) + (only (ikarus reader) read-library-source-file) (ikarus)) - (define (load-precompiled-library filename sk) #f) (define-syntax define-record (syntax-rules () diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss index 4f4051d..5ec91b7 100644 --- a/scheme/psyntax.expander.ss +++ b/scheme/psyntax.expander.ss @@ -265,7 +265,7 @@ (when (annotation? expr) (let ([src (annotation-source expr)]) (when (pair? src) - (display " [byte " p) + (display " [char " p) (display (cdr src) p) (display " of " p) (display (car src) p) diff --git a/scheme/psyntax.library-manager.ss b/scheme/psyntax.library-manager.ss index 78a59f1..c6e5251 100644 --- a/scheme/psyntax.library-manager.ss +++ b/scheme/psyntax.library-manager.ss @@ -225,7 +225,7 @@ [(try-load-from-file file-name)] [else ((current-library-expander) - (with-input-from-file file-name read-annotated) + (read-library-source-file file-name) file-name)]))) (lambda (f) (if (procedure? f)