[racket] match-loop

Another looping macro.

(define-syntax-rule (do-match-loop
    (sym ...) (pat ...) (lst ...) (expr ...))
  (let loop ((sym lst) ...)
    (when (andmap cons? (list sym ...))
      (match-let ((pat sym) ...)
        (call-with-values (lambda () expr ...) loop)))))

(define-syntax match-loop-aux
  (syntax-rules ()
    [(_ () (sym ...) pats lsts form)
     (do-match-loop (sym ...) pats lsts form)]
    [(_ (x x* ...) (sym ...) pats lsts form)
     (match-loop-aux (x* ...) (tmp sym ...) pats lsts form)]))

(define-syntax-rule (match-loop (pat lst) ... form)
  (match-loop-aux (pat ...) () (pat ...) (lst ...) form))


;; Testing:

(match-loop
  ((list a a* ...) '(2 3 4))
  ((displayln a)
   a*))

2
3
4


;; Early exit
(match-loop
  ((list a a* ...) '(3 5 8))
  ((if (odd? a)
     (begin (displayln a)
            a*)
     null)))

3
5


;; Destructuring
(match-loop
  (`((,a ,b) ,more ...) '((2 3) (8 9)))
  ((printf "~A -- ~A\n" a b)
   more))

2 -- 3
8 -- 9


;; Parallel
(match-loop
  ((list a a* ...) '(5 6 7))
  ((list b b* ...) '(m n o))
  ((displayln (list a b))
   (values a* b*)))

(5 m)
(6 n)
(7 o)


;; Parallel, criss-crossing
(match-loop
  ((list a a* ...) '(5 6 7 8))
  ((list b b* ...) '(m n o p))
  ((displayln (list a b))
   (values b* a*)))

(5 m)
(n 6)
(7 o)
(p 8)


;; Move through list 2 items at a time
(match-loop
  ((list p v more ...) '(e 3 f 6 g 9))
  ((printf "~A ~A\n" p v)
   more))

e 3
f 6
g 9


;; Nested loops
(match-loop
  ((list a a* ...) '(2 3 4))
  ((match-loop
     ((list b b* ...) '(x y))
     ((printf "~a ~a\n" a b)
      b*))
   a*))

2 x
2 y
3 x
3 y
4 x
4 y