advent-of-code/2020/day-07/peg-tree-utils.scm

(library (peg-tree-utils)
  (export find-in-tree
          find-in-tree*)
  (import
    (except (rnrs base) let-values)
    (only (guile) lambda* λ
          current-output-port
          simple-format)
    (srfi srfi-1)))


(define find-in-tree
  (λ (peg-tree label equal-test)
    (define traverse
      (λ (peg-tree label)
        (cond
         [(null? peg-tree) #f]
         [(pair? (car peg-tree))
          (or (traverse (first peg-tree) label)
              (traverse (cdr peg-tree) label))]
         [(symbol? (car peg-tree))
          (cond
           [(equal-test (car peg-tree) label)
            (cdr peg-tree)]
           [else
            (traverse (cdr peg-tree) label)])]
         [else
          (traverse (cdr peg-tree) label)])))
    (traverse peg-tree label)))


(define find-in-tree*
  (λ (peg-tree filter-proc)

    (define traverse
      (λ (subtree cont)
        ;; (simple-format (current-output-port)
        ;;                "working with subtree ~a\n"
        ;;                subtree)
        (cond
         [(null? subtree) (cont)]
         [(pair? (first subtree))
          (traverse (first subtree)
                    (λ () (traverse (cdr subtree) cont)))]
         [(filter-proc (first subtree))
          (cons subtree (cont))]
         [else
          (traverse (cdr subtree) cont)])))

    (traverse peg-tree (λ () '()))))


;; An alternative version, not using continuations,
;; submitted by Taylan Kammen on the Guile User mailing list
;; is the following:

;; (define find-in-tree*
;;   (λ (peg-tree filter-proc)

;;     (define traverse
;;       (λ (subtree rest)
;;         (simple-format (current-output-port) "working with subtree ~a\n" subtree)
;;         (cond
;;          [(null? subtree)
;;           (if (null? rest)
;;               '()
;;               (traverse (car rest) (cdr rest)))]
;;          [(pair? (first subtree))
;;           (traverse (first subtree)
;;                     (cons (cdr subtree) rest))]
;;          [(filter-proc (first subtree))
;;           (cons subtree
;;                 (if (null? rest)
;;                     '()
;;                     (traverse (car rest) (cdr rest))))]
;;          [else
;;           (traverse (cdr subtree) rest)])))

;;     (traverse peg-tree '())))