#!/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)