source annotations for r6rs-script and r6rs-libraries are now in
chars instead of bytes.
This commit is contained in:
parent
b5fc5624ec
commit
5c21f9995e
|
@ -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,14 +532,16 @@
|
|||
(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
|
||||
|
@ -546,6 +549,8 @@
|
|||
#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)
|
||||
|
|
|
@ -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)]
|
||||
|
|
|
@ -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))]))))))))
|
||||
)
|
||||
|
||||
|
|
|
@ -1 +1 @@
|
|||
1469
|
||||
1470
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue