Parser, which consumes input partially.

partial.rkt

#lang racket

; await (s -> (s, parser))
; yield (result, parser)
; stop  (error)
(define (await state-transform) `(await ,state-transform))
(define (yield result next)     `(yield ,result ,next))
(define (stop  error)           `(stop  ,error))

; tee :: (s, parser) -> (`ok result s parser) | (`error reason s)
(define (tee input parser)
    (match parser
        [(list `await consume)      (apply tee (consume input))]
        [(list `yield result next) `(ok    ,result ,input ,next)]
        [(list `stop  error)       `(error ,error  ,input)]
        [thunk                      (tee input (thunk))]
    ))

(define-syntax-rule (thunk . body) (λ () body))

(define (just value)
    (yield value (thunk (just value))))

(define (x . -> . context)
    (apply context x))

(define (let . args)
    ((reverse args) . -> . (λ (consumer . args)
    ((reverse args) . -> . (λ args
    (apply consumer args))))))

(define (display-format f . args)
    (display (apply format (string-append f "~%") args)))

(define (parser . once-then . replacement)
    (parser . map-next . (λ _ replacement)))

(define (parser . map-next . f)
    (await (λ (input)
    (match (tee input parser)
        [(list `ok res rem next)
            (list rem (yield res (f next)))]

        [(list `error reason where)
            (list where (stop reason))]))))

(define (input . push-to . parser)
    (match parser
        [(list `await consume)
            (consume input)]))

; parses an occurence of "str"
(define (string str)
    (await                       (λ (input)
    (let (string-length str)     (λ (str-len)
    (let (string-length input)   (λ (input-len)
    
    (if (input-len . < . str-len)
        ; (string "abcd") <- "ab"
        (-> (break-string input-len str) (λ (before after)
        (input . push-to . 
            ((string before) . once-then . ; parse existing part         ("ab")
            ((string after)  . once-then . ; parse remaining part        ("cd")
             (string str))))))             ; become initial parser again ("abcd")
    ; else
        (-> (break-string str-len input) (λ (before after)

        (if (str . equal? . before)
           (list after (yield `() (thunk (string str))))
           (list input (stop   str)))))))))))))

(define (break-string at str)
    (list
        (substring str 0 at)
        (substring str   at)))

; input "123" & "456789" to (string "123456") parser
(match (tee "123" (string "123456"))
    [(list `ok _ _ cont)
        (tee "456789" cont)])
; => `(ok () "789" <cont>)

; input "123" & "457789" to (string "123456") parser
(match (tee "123" (string "123456"))
    [(list `ok _ _ cont)
        (tee "457789" cont)])
; => `(error "456" "457789" <cont>)