macro_stepper.rkt

#lang racket

(require (for-syntax racket/syntax)
         (for-syntax racket/base)
         (for-syntax racket/match))

(begin-for-syntax
  (define (aux pat-stx trie-exp outer-stx)
    (match-define (list temp1 temp2) (generate-temporaries #'(tmp1 tmp2)))
    (datum->syntax
     outer-stx
     (list temp1 temp2 #'pat #'match-pat trie-exp))))

(define-syntax (for-trie/fold stx)
  (syntax-case stx ()
    [(_ ([acc-id acc-init] ...)
        ((pat_0 trie_0)
         (pat_n trie_n) ...
         #:where pred)
        body)
       (with-syntax* ([(set-tmp loop-tmp proj-stx match-pat trie-exp)
                       (aux #'pat_0 #'trie_0 #'body)]
                      [new-acc (generate-temporary 'acc)])
         #;(printf "match-pat: ~v\n" (syntax-debug-info #'match-pat))
         #`(let ([set-tmp '()])
             (for/fold ([acc-id acc-init]
                        ...)
                       ([loop-tmp (in-list set-tmp)])
               (match-define (list match-pat) loop-tmp)
               (for-trie/fold ([acc-id acc-id]
                               ...)
                              ([pat_n trie_n]
                               ...
                               #:where pred)
                 body))))]
    [(_ ([acc-id acc-init] ...)
        (#:where pred)
        body)
       #'(if pred body (values acc-id ...))]
    [(_ ([acc-id acc-init] ...) ([pat exp] ...) body)
     #'(for-trie/fold ([acc-id acc-init] ...) ([pat exp] ... #:where #t) body)]))

(define-syntax (make-fold stx)
  (syntax-case stx ()
    [(_ name folder initial)
     #'(define-syntax (name stx)
         (syntax-case stx ()
           [(_ ([pat exp] (... ...) #:where pred) body)
            #'(for-trie/fold ([acc initial])
                             ([pat exp]
                              (... ...)
                              #:where pred)
                (folder body acc))]))]))

(make-fold for-trie/list cons empty)

(for-trie/list ([1 1]
                #:where #t)
               0)