Fixes bug 172734: lookahead-u8: primitive not supported yet
This commit is contained in:
parent
5f638cc722
commit
51c8d1c0ed
Binary file not shown.
|
@ -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))]
|
||||
|
|
|
@ -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)])
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -1 +1 @@
|
|||
1147
|
||||
1148
|
||||
|
|
|
@ -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]
|
||||
|
|
Loading…
Reference in New Issue