lf2-survival-stage-generator/peg-tree-utils.scm

(library (peg-tree-utils)
  ;; export all non-terminal symbols for testing and usage
  ;; elsewhere in the code
  (export get-value-from-peg-tree
          matches-up-to-position?
          exhausting-match?)

  (import
    (except (rnrs base) let-values map error)
    (only (guile)
          lambda* λ
          string=?)
    (srfi srfi-1)
    (ice-9 peg)))


(define rest cdr)


(define get-value-from-peg-tree
  (λ (peg-tree label label-equal?)
    (cond
     [(null? peg-tree) #f]
     [(pair? (first peg-tree))
      (or (get-value-from-peg-tree (first peg-tree) label label-equal?)
          (get-value-from-peg-tree (rest peg-tree) label label-equal?))]
     [(label-equal? (first peg-tree) label)
      ;;(cadadr peg-tree)
      peg-tree]
     [else
      (get-value-from-peg-tree (rest peg-tree) label label-equal?)])))


(define matches-up-to-position?
  (λ (peg-pattern the-string pos)
    (let ([match-result (match-pattern peg-pattern the-string)])
      (and (peg-record? match-result)
           (>= (peg:end match-result) pos)))))


(define exhausting-match?
  (λ (peg-pattern matched-string)
    (let ([pos (string-length matched-string)])
      (matches-up-to-position? peg-pattern matched-string pos))))