Welcome to the CHICKEN Scheme pasting service

#!/usr/bin/csi -s

(define (nntp:multi-line)
  (call-with-input-file "samples/nntp.body.raw"
    (lambda (nntp-in)
      (with-input-from-port nntp-in
        (lambda ()

          (print "\t- just read")
          (time (read-all))

          (set-file-position! nntp-in 0)

          (print "\t- string:read-line")
          (time (nntp:multi-line:string:read-line))
          
          (set-file-position! nntp-in 0)

          (print "\t- port:list-buffered")
          (time (nntp:multi-line:port:list-buffered))

          (set-file-position! nntp-in 0)

          (print "\t- port:vector-buffered")
          (time (nntp:multi-line:port-vector-buffered)))))))

(use srfi-13)
(define (nntp:multi-line:string:read-line)
  (let loop ((body "")
             (current-line (read-line)))
    (if (string= "." current-line)
        body
        (loop (string-append body current-line "\r\n") (read-line)))))

(use ports utils)
(use srfi-1)
(define (nntp:multi-line:port:list-buffered)
  (read-all
   (let ((buffer '())
         (eof? #f))

     (define (buffered-read)
       (if (> (length buffer) 0)
           (let ((bufferd-byte (car buffer)))
             (set! buffer (drop buffer 1))
             bufferd-byte)
           (read-byte)))

     (define (buffered-peek n)
       (if (>= (length buffer) n)
           (list-ref buffer (- n 1))
           (begin
             (set! n (- n (length buffer)))
             (let loop ((i 1))
               (if (> n i)
                   (begin
                     (set! buffer (append buffer (list (read-byte))))
                     (loop (+ i 1))))
               (let ((peeked-byte (read-byte)))
                 (set! buffer (append buffer (list peeked-byte)))
                 peeked-byte)))))

     (make-input-port 
      (lambda ()
        (if eof?
            #!eof
            (let ((current-byte (buffered-read)))
              (if (= current-byte 13)
                  (if (= (buffered-peek 1) 10)
                      (if (= (buffered-peek 2) 46)
                          (if (= (buffered-peek 3) 13)
                              (if (= (buffered-peek 4) 10)
                                  (begin
                                    (set! eof? #t)
                                    #!eof)
                                  current-byte)
                              current-byte)
                          current-byte)
                      current-byte)
                  current-byte))))
      char-ready?
      void))))

(define (nntp:multi-line:port-vector-buffered)
  (read-all
   (let ((buffer (make-vector 4))
         (read-position -1)
         (write-position 0)
         (eof? #f))

     (define (buffered-read)
       (if (= read-position -1)
           (begin
             ;(print "read native")
             (read-byte))
           (begin 
             ;(print (format "read buffered from position ~A" read-position))
             (let ((buffered-byte (vector-ref buffer read-position)))
               (if (= read-position write-position)
                   (begin
                     ;(print "reset buffer")
                     (set! write-position 0)
                     (set! read-position -1)
                     (set! buffered-byte (read-byte)))
                   (begin
                     ;(print (format "moving cursor to ~A" (+ read-position 1)))
                     (set! read-position (+ read-position 1))))
               buffered-byte))))

     (define (buffered-peek n)
       ;(print (format "peek ~A" n))
       
       (if (= read-position -1)
           (set! read-position 0))

       (let ((offset (- n 0)))
         (if (>= write-position offset)
             (begin
               ;(print (format "read buffered at ~A" offset))
               (vector-ref buffer (- offset 1)))
             (let ((bytes-count (- offset write-position)))
               ;(print (format "write ~Abytes at ~A" bytes-count write-position))
               
               (let loop ((buffered-byte (read-byte)))
                 ;(print (format "write ~A to buffer at ~A" buffered-byte write-position))
                 
                 (vector-set! buffer write-position buffered-byte)
                 (set! write-position (+ write-position 1))
                 
                 (if (= write-position offset)
                     (let ((buffer-offset (- offset 1)))
                       ;(print (format "read buffered2 from ~A" buffer-offset))
                       (vector-ref buffer buffer-offset))
                     (loop)))))))

     (make-input-port
      (lambda ()
        (if eof?
           #!eof
            (let ((current-byte (buffered-read)))
              (if (= current-byte 13)
                  (if (= (buffered-peek 1) 10)
                      (if (= (buffered-peek 2) 46)
                          (if (= (buffered-peek 3) 13)
                              (if (= (buffered-peek 4) 10)
                                  (begin
                                    (set! eof? #t)
                                    #!eof)
                                  current-byte)
                              current-byte)
                          current-byte)
                      current-byte)
                  current-byte))))
      char-ready?
      void))))

(print "Testing multi-line parser")
(nntp:multi-line)