Permute regular patterns

perx.scm

(define (constant c)
  (lambda (state)
    (map (lambda (x) (cons c x)) state)))

(define (sequence first . rest)
  (if (null? rest)
      first
      (lambda (state)
        ((apply sequence rest) (first state)))))

(define (alternation first second . rest)
  (lambda (state)
    (append (first state)
            (if (null? rest)
                (second state)
                ((apply alternation (cons second rest)) state)))))

(define-syntax perx
  (syntax-rules ::: ()
    ((_ . expr)
     (letrec-syntax ((p (syntax-rules (or)
                          ((_ (or a ...)) (alternation (p a) ...))
                          ((_ (x ...))    (sequence (p x) ...))
                          ((_ x)          (constant x)))))
       (map (lambda (l) (apply string-append l))
            (map reverse ((p expr) '(()))))))))

;; (perx (or ("a" (or "b" "c") "d") "e")) => ("abd" "acd" "e")