source annotations for r6rs-script and r6rs-libraries are now in

chars instead of bytes.
This commit is contained in:
Abdulaziz Ghuloum 2008-05-06 15:38:05 -04:00
parent b5fc5624ec
commit 5c21f9995e
7 changed files with 42 additions and 25 deletions

View File

@ -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)

View File

@ -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)]

View File

@ -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))]))))))))
)

View File

@ -1 +1 @@
1469
1470

View File

@ -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 ()

View File

@ -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)

View File

@ -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)