diff --git a/scheme/ikarus.boot.prebuilt b/scheme/ikarus.boot.prebuilt index c4779a2..1a53925 100644 Binary files a/scheme/ikarus.boot.prebuilt and b/scheme/ikarus.boot.prebuilt differ diff --git a/scheme/ikarus.io-primitives.ss b/scheme/ikarus.io-primitives.ss index 86d8cab..6c13846 100644 --- a/scheme/ikarus.io-primitives.ss +++ b/scheme/ikarus.io-primitives.ss @@ -17,7 +17,7 @@ (library (ikarus io-primitives) (export read-char unread-char peek-char write-char write-byte put-u8 put-char put-string put-bytevector - get-char get-u8 + get-char get-u8 lookahead-u8 get-string-n get-string-n! get-bytevector-n get-bytevector-n! newline port-name input-port-name output-port-name @@ -29,7 +29,7 @@ (ikarus system $ports) (except (ikarus) read-char unread-char peek-char write-char write-byte put-u8 put-char put-string put-bytevector - get-char get-u8 + get-char get-u8 lookahead-u8 get-string-n get-string-n! get-bytevector-n get-bytevector-n! newline port-name input-port-name output-port-name @@ -120,6 +120,12 @@ ($get-u8 p) (error 'get-u8 "not an input-port" p)))) + (define lookahead-u8 + (lambda (p) + (if (input-port? p) + ($lookahead-u8 p) + (error 'lookahead-u8 "not an input-port" p)))) + (define read-char (case-lambda [() ($read-char (current-input-port))] diff --git a/scheme/ikarus.io-primitives.unsafe.ss b/scheme/ikarus.io-primitives.unsafe.ss index d18b1cc..248a0a4 100644 --- a/scheme/ikarus.io-primitives.unsafe.ss +++ b/scheme/ikarus.io-primitives.unsafe.ss @@ -15,7 +15,8 @@ (library (ikarus io-primitives unsafe) - (export $write-char $write-byte $read-char $get-u8 $unread-char $peek-char + (export $write-char $write-byte $read-char $get-u8 $lookahead-u8 + $unread-char $peek-char $reset-input-port! $flush-output-port $close-input-port $close-output-port) (import @@ -84,6 +85,13 @@ b) (($port-handler p) 'get-u8 p))))) + (define $lookahead-u8 + (lambda (p) + (let ([idx ($port-index p)]) + (if ($fx< idx ($port-size p)) + ($bytevector-u8-ref ($port-buffer p) idx) + (($port-handler p) 'lookahead-u8 p))))) + (define $peek-char (lambda (p) (let ([idx ($port-index p)]) diff --git a/scheme/ikarus.io.input-files.ss b/scheme/ikarus.io.input-files.ss index ac15f84..0b4bd55 100644 --- a/scheme/ikarus.io.input-files.ss +++ b/scheme/ikarus.io.input-files.ss @@ -169,6 +169,25 @@ ($set-port-size! p bytes) ($peek-char p)])) (error 'peek-char "port is closed" p))))] + [(lookahead-u8 p) + (unless (input-port? p) + (error 'lookahead-u8 "not an input port" p)) + (let ([idx ($port-index p)]) + (if ($fx< idx ($port-size p)) + ($bytevector-u8-ref ($port-buffer p) idx) + (if open? + (let ([bytes + (foreign-call "ikrt_read" fd + (port-input-buffer p))]) + (cond + [(not bytes) + (error 'lookahead-u8 + "Cannot read from file" port-name)] + [($fx= bytes 0) + (eof-object)] + [else + ($bytevector-u8-ref ($port-buffer p) 0)])) + (error 'lookahead-u8 "port is closed" p))))] [(unread-char c p) (unless (input-port? p) (error 'unread-char "not an input port" p)) diff --git a/scheme/last-revision b/scheme/last-revision index 8966a60..2a95aac 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1147 +1148 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 632d4e4..b0305a4 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1097,7 +1097,8 @@ [&i/o-write i r ip is fi] [i/o-write-error? i r ip is fi] [lookahead-char r ip] - [lookahead-u8 r ip] + [lookahead-u8 i r ip] + [$lookahead-u8 $io] [make-bytevector i r bv] [make-custom-binary-input-port r ip] [make-custom-binary-input/output-port r ip]