Source

scheme-random / chunk.scm

Full commit
;;; Try doing
;;;  > (define hello (string-chunk "hello world!"))
;;; and doing stuff like
;;;  > (hello)
;;;  > (hello)
;;;  > (hello 'rewind)
;;;  > (hello 5)
;;;  > (hello 'peek)
;;;  > (hello 'back 2)
;;;  > (hello 'peek)
;;; etc.

;;; Get the character at position POS in STR or return
;;; EOF.
(define (string-ref* str pos . eof)
  (let ((eof-ind (if (null? eof)
                     '()
                     (car eof)))) ;; optional eof
    (if (>= pos (string-length str))
        eof
        (string-ref str pos))))

;;; Get N chars from STR starting at START.
(define (get-char-run str n . start)
  (let ((pos (if (null? start)
                 0
                 (car start))))
    (let LOOP ((total 0)
               (collected '()))
      (if (>= total n)
          collected
          (LOOP (+ 1 total)
                (cons
                 (string-ref* str
                               (+ pos total))
                 collected))))))

;;; Pop off the elements of the list LST satisfying F
;;; while they exist in the CAR of the LST.
(define (remove-while f lst)
  (if (null? lst)
      '()
      (if (f (car lst))
          (remove-while f (cdr lst))
          lst)))

;;; A heavyweight str-chunk.
(define (string-chunk str)
  (let ((pos 0))
    (lambda args
      (if (null? args)
          ;; null arguments, just pop a char
          (let ((popped-char (string-ref* str pos)))
            (if (null? popped-char)
                popped-char
                (begin
                  (set! pos (+ 1 pos))
                  popped-char)))

          ;; process special argument
          (let ((cmd (car args))
                (rst (cdr args)))
            (case cmd
              ;; Peek a char
              ((peek) (string-ref* str pos))
              ;; Back up by one char by default, or by N chars as
              ;; specified by the following arguments to BACK.
              ((back) (let* ((rewind-by
                              (if (null? rst) 1 (car rst)))
                             (rewind-to
                              (if (<= pos rewind-by)
                                  0
                                  (- pos rewind-by))))
                        (set! pos rewind-to)))
              ;; Rewind completely.
              ((rewind) (set! pos 0))
              ;; Other cases...
              (else
               ;; If we are provided an integer for a command,
               ;; then collect the number of chars as specified.
               (if (integer? cmd)
                        (begin
                          (let ((got-chars (get-char-run str cmd pos)))
                            (set! pos
                                  (if (member '() got-chars)
                                      (string-length str)
                                      (+ pos cmd)))
                            (list->string
                             (reverse (remove-while null? got-chars)))))
                        ;;unknown command, do NOTHING
                        #f))))))))

;;; Original from j`ey
(define (str-chunk string)
  (let ((pos 0))
    (lambda a (if (= pos (string-length string)) 'eof-indicator
                  (begin
                    (set! pos
                          (+ (if (and (not (null? a))
                                      (equal? 'unget (car a))) -1 1)
                             pos))
                    (string-ref string (- pos 1)))))))