p.scm

(use parser.peg)

(define ($look-ahead parse)
  (lambda (s0)
    (receive (r v s) (parse s0)
      (values r v s0))))

;; #/A*B/ で A, B それぞれの開始文字列に共通部分がない場合
(define (f a b-start b)
  ($do (h ($many-till a ($look-ahead b-start)))
       (t b)
       ($return `(,@h ,t))))

;; #/A*B$/
(define (g a b)
  ($do (h ($many-till a ($look-ahead ($seq b eof))))
       (t b)
       ($return `(,@h ,t))))

;; g の b を二回パースしない版
(define (g~ a b)
  ($or ($try ($do (x b)
                  eof
                  ($return (list x))))
       ($do (h a)
            (t (g~ a b))
            ($return (cons h t)))))

(peg-parse-string
 (f ($string "ab") ($char #\b) ($string "bc"))
 "ababbca")
;; => ("ab" "ab" "bc")

(peg-parse-string
 (g ($string "ab") ($string "ac"))
 "ababac")
;; => ("ab" "ab" "ac")

(peg-parse-string
 (g~ ($string "ab") ($string "ac"))
 "ababac")
;; => ("ab" "ab" "ac")