for-star-list-star.rkt (3279B)
1 #lang racket 2 3 (provide for*/list*) 4 5 (require (for-syntax syntax/parse)) 6 7 (define-syntax (for*/list* stx) 8 (define-syntax-class sequences 9 #:description "([id seq-expr] ...) or (* [id seq-expr] ...)" 10 (pattern ((~optional (~and star (~datum *))) (id:id seq-expr:expr) ...) 11 #:with for-kind (if (attribute star) #'for*/list #'for/list))) 12 13 (syntax-parse stx 14 [(_ [sequences:sequences ...] . body) 15 (foldl (λ (for-kind clauses acc) 16 #`(#,for-kind #,clauses #,acc)) 17 #'(let () . body) 18 (reverse (syntax-e #'(sequences.for-kind ...))) 19 (reverse (syntax-e #'(([sequences.id sequences.seq-expr] ...) 20 ...))))])) 21 22 ;; Test for*/list* 23 (module* test racket 24 (require rackunit) 25 (require (submod "..")) 26 (check-equal? (for*/list* [([x '(a b c)] 27 [y '(1 2 3)]) 28 (* [z '(d e f)] 29 [t '(4 5 6)])] 30 (list x y z t)) 31 '(((a 1 d 4) (a 1 d 5) (a 1 d 6) 32 (a 1 e 4) (a 1 e 5) (a 1 e 6) 33 (a 1 f 4) (a 1 f 5) (a 1 f 6)) 34 ((b 2 d 4) (b 2 d 5) (b 2 d 6) 35 (b 2 e 4) (b 2 e 5) (b 2 e 6) 36 (b 2 f 4) (b 2 f 5) (b 2 f 6)) 37 ((c 3 d 4) (c 3 d 5) (c 3 d 6) 38 (c 3 e 4) (c 3 e 5) (c 3 e 6) 39 (c 3 f 4) (c 3 f 5) (c 3 f 6)))) 40 (check-equal? (for*/list* [([x '(a b c)]) 41 ([y '(1 2 3)]) 42 (* [z '(d e f)] 43 [t '(4 5 6)])] 44 (list x y z t)) 45 '((((a 1 d 4) (a 1 d 5) (a 1 d 6) 46 (a 1 e 4) (a 1 e 5) (a 1 e 6) 47 (a 1 f 4) (a 1 f 5) (a 1 f 6)) 48 ((a 2 d 4) (a 2 d 5) (a 2 d 6) 49 (a 2 e 4) (a 2 e 5) (a 2 e 6) 50 (a 2 f 4) (a 2 f 5) (a 2 f 6)) 51 ((a 3 d 4) (a 3 d 5) (a 3 d 6) 52 (a 3 e 4) (a 3 e 5) (a 3 e 6) 53 (a 3 f 4) (a 3 f 5) (a 3 f 6))) 54 (((b 1 d 4) (b 1 d 5) (b 1 d 6) 55 (b 1 e 4) (b 1 e 5) (b 1 e 6) 56 (b 1 f 4) (b 1 f 5) (b 1 f 6)) 57 ((b 2 d 4) (b 2 d 5) (b 2 d 6) 58 (b 2 e 4) (b 2 e 5) (b 2 e 6) 59 (b 2 f 4) (b 2 f 5) (b 2 f 6)) 60 ((b 3 d 4) (b 3 d 5) (b 3 d 6) (b 3 e 4) 61 (b 3 e 5) (b 3 e 6) (b 3 f 4) 62 (b 3 f 5) (b 3 f 6))) 63 (((c 1 d 4) (c 1 d 5) (c 1 d 6) (c 1 e 4) 64 (c 1 e 5) (c 1 e 6) (c 1 f 4) 65 (c 1 f 5) (c 1 f 6)) 66 ((c 2 d 4) (c 2 d 5) (c 2 d 6) (c 2 e 4) 67 (c 2 e 5) (c 2 e 6) (c 2 f 4) 68 (c 2 f 5) (c 2 f 6)) 69 ((c 3 d 4) (c 3 d 5) (c 3 d 6) (c 3 e 4) 70 (c 3 e 5) (c 3 e 6) (c 3 f 4) 71 (c 3 f 5) (c 3 f 6))))))