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

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

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

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

scheme/last-revision

@@ -1 +1 @@
-1147
+1148

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]