1#lang racket/base
2
3(require (for-template racket/base))
4
5(provide flatten-begin
6         flatten-all-begins)
7
8(define (flatten-begin stx)
9  (let ([l (syntax->list stx)])
10    (if l
11        (map (lambda (e)
12               (syntax-track-origin e stx (car l)))
13             (cdr l))
14        (raise-syntax-error
15         #f
16         "bad syntax"
17         stx))))
18
19;; flatten-all-begins : Syntax -> (Listof Syntax)
20;; Flatten `begin` expressions recursively
21(define (flatten-all-begins orig-stx)
22  (define val (syntax-e orig-stx))
23  (unless (and (pair? val)
24               (not (null? val))
25               (identifier? (car val))
26               (free-identifier=? (car val) #'begin))
27    (raise-syntax-error
28     #f
29     "not a begin expression"
30     orig-stx))
31  (let loop ([stx orig-stx])
32    (define lst (syntax->list stx))
33    (if (and lst
34             (not (null? lst))
35             (free-identifier=? (car lst) #'begin))
36        (apply append (map loop (cdr lst)))
37        (list (syntax-track-origin stx orig-stx #'begin)))))
38