Fixes bug 172734: lookahead-u8: primitive not supported yet

This commit is contained in:
Abdulaziz Ghuloum 2007-11-30 06:19:59 -05:00
parent 5f638cc722
commit 51c8d1c0ed
6 changed files with 39 additions and 5 deletions

Binary file not shown.

View File

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

View File

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

View File

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

View File

@ -1 +1 @@
1147
1148

View File

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