collects/syntax/toplevel.rkt

7            expand-top-level-with-compile-time-evals
8            expand-syntax-top-level-with-compile-time-evals
9            expand-syntax-top-level-with-compile-time-evals/flatten)
11   ;; eval-compile-time-part-of-top-level/compile : syntax -> (listof compiled-expression)
20   (define (expand-top-level-with-compile-time-evals stx)
21     (expand-syntax-top-level-with-compile-time-evals
22      (namespace-syntax-introduce stx)))
24   ;; expand-syntax-top-level-with-compile-time-evals/flatten : syntax -> (listof syntax)
25   (define (expand-syntax-top-level-with-compile-time-evals/flatten stx)
27       (let ([e (expand-syntax-to-top-form stx)])
28         (syntax-case e (begin)
30            (apply append (map loop (syntax->list (syntax (expr ...)))))]
32            (let ([e (expand-syntax e)])
36   (define (expand-syntax-top-level-with-compile-time-evals stx)
37     (let ([e (expand-syntax-to-top-form stx)])
38       (syntax-case e (begin)
40          (with-syntax ([(expr ...)
42                         (map expand-syntax-top-level-with-compile-time-evals
43                              (syntax->list (syntax (expr ...))))]
45            (datum->syntax e (syntax-e (syntax (beg expr ...))) e e))]
47          (let ([e (expand-syntax e)])
51   ;; compile-and-eval-compile-time-part : syntax boolean -> (union syntax compiled-expression)
52   ;; compiles the syntax it receives as an argument and evaluates the compile-time part of it.
58                           (let ([compiled (compile-syntax stx)])
62       (kernel-syntax-case stx #f
65 	  (when compile? (compile-syntax stx))
66 	  (for-each (lambda (req) (namespace-require/expansion-time (syntax->datum req)))
67 		    (syntax->list (syntax (req ...)))))]
72         [(begin-for-syntax . _)
76 	  (when compile? (compile-syntax stx))
78 		      (with-syntax ([id id])
79 			(eval-syntax (syntax (define-values (id) undefined)))))
80 		    (syntax->list (syntax (id ...)))))]
82          (when compile? (compile-syntax stx))])))
84   ;; flatten-out-begins : syntax -> (listof syntax)
89       (let ([expr (expand-syntax-to-top-form expr)])
90 	(syntax-case expr (begin)
92 	   (apply append (map loop (syntax->list (syntax (expr ...)))))]