www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

first-line-utils.rkt (2088B)


      1 #lang racket/base
      2 
      3 (require racket/port)
      4 
      5 (provide read-whole-first-line
      6          read-syntax-whole-first-line
      7          narrow-to-one-line
      8          read-line-length)
      9 
     10 (define (read-line-length port)
     11   (let* ([peeking (peeking-input-port port)]
     12          [start (file-position peeking)]
     13          [_ (read-line peeking)]
     14          [end (file-position peeking)])
     15     (- end start)))
     16 
     17 (define (narrow-to-one-line port)
     18   (make-limited-input-port port (read-line-length port)))
     19 
     20 (define (read-*-whole-first-line rec-read in)
     21   (define in1 (peeking-input-port (narrow-to-one-line in)))
     22   
     23   (define start-pos (file-position in1))
     24 
     25   (let loop ([last-good-pos start-pos])
     26     (define res+
     27       ;; Try to read (may fail if the last object to read spills onto the next
     28       ;; lines. We read from the peeking-input-port, so that we can retry the
     29       ;; last read on the full, non-narrowed port.
     30       (with-handlers ([exn:fail:read? (λ (_) 'read-error)])
     31         (list (rec-read in1))))
     32     (cond
     33       [(eq? res+ 'read-error)
     34        ;; Last read was unsuccessful, only consume the bytes from the original
     35        ;; input port up to the last successful read. Then, re-try one last read
     36        ;; on the whole file (i.e. the last read object may span several lines).
     37        (read-bytes (- last-good-pos start-pos) in)
     38        (list (rec-read in))]
     39       [(eof-object? (car res+))
     40        ;; Last successful read, actually consume the bytes from the original
     41        ;; input port. Technically, last-good-pos and (file-position pk) should
     42        ;; be the same, since the last read returned #<eof> (and therefore did
     43        ;; not advance the read pointer.
     44        (read-bytes (- (file-position in1) start-pos) in)
     45        '()]
     46       [else
     47        ;; One successful read. Prepend it, and continue reading some more.
     48        (cons (car res+)
     49              (loop (file-position in1)))])))
     50 
     51 (define (read-whole-first-line in)
     52   (read-*-whole-first-line (λ (in1) (read in1)) in))
     53 
     54 (define (read-syntax-whole-first-line source-name in)
     55   (read-*-whole-first-line (λ (in1) (read-syntax source-name in1)) in))