From d23cb2435324f86d9a6870569e2665fc96fd88e5 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Wed, 28 Sep 2011 22:25:56 -0600
Subject: [PATCH] macro-debugger/emit: more flexible arguments for emit-remark

original commit: e7e990cc78be6d80f674922be267dca9a357dd4a
---
 collects/macro-debugger/emit.rkt             | 43 +++++++++++++-------
 collects/macro-debugger/macro-debugger.scrbl | 11 ++++-
 2 files changed, 37 insertions(+), 17 deletions(-)

diff --git a/collects/macro-debugger/emit.rkt b/collects/macro-debugger/emit.rkt
index e5ea883..a8b91ac 100644
--- a/collects/macro-debugger/emit.rkt
+++ b/collects/macro-debugger/emit.rkt
@@ -1,26 +1,13 @@
 #lang racket/base
 (require racket/contract/base)
 
-(provide/contract
- [emit-remark
-  (->* () (#:unmark? any/c) #:rest (listof (or/c string? syntax?))
-       any)]
- [emit-local-step
-  (-> syntax? syntax? #:id identifier? any)])
-
 (define current-expand-observe
   (dynamic-require ''#%expobs 'current-expand-observe))
 
-(define (emit-remark #:unmark? [unmark? #t] . args)
+(define (emit-remark #:unmark? [unmark? (syntax-transforming?)] . args)
   (let ([observe (current-expand-observe)])
     (when observe
-      (let ([args
-             (if unmark?
-                 (for/list ([arg (in-list args)])
-                   (if (syntax? arg)
-                       (syntax-local-introduce arg)
-                       arg))
-                 args)])
+      (let ([args (flatten-emit-args args unmark?)])
         (observe 'local-remark args)))))
 
 (define (emit-local-step before after #:id id)
@@ -30,3 +17,29 @@
                (list (list id)
                      before (syntax-local-introduce before)
                      (syntax-local-introduce after) after)))))
+
+(define emit-arg/c
+  (recursive-contract
+   (or/c string?
+         syntax?
+         (listof emit-arg/c)
+         (-> emit-arg/c))))
+
+(define (flatten-emit-args x unmark?)
+  (define (loop x onto)
+    (cond [(string? x)
+           (cons x onto)]
+          [(syntax? x)
+           (cons (if unmark? (syntax-local-introduce x) x) onto)]
+          [(list? x)
+           (foldr loop onto x)]
+          [(procedure? x)
+           (loop (x) onto)]))
+  (loop x null))
+
+(provide/contract
+ [emit-remark
+  (->* () (#:unmark? any/c) #:rest (listof emit-arg/c)
+       any)]
+ [emit-local-step
+  (-> syntax? syntax? #:id identifier? any)])
diff --git a/collects/macro-debugger/macro-debugger.scrbl b/collects/macro-debugger/macro-debugger.scrbl
index c0570c4..cf941fa 100644
--- a/collects/macro-debugger/macro-debugger.scrbl
+++ b/collects/macro-debugger/macro-debugger.scrbl
@@ -114,8 +114,15 @@ result as the original syntax.
 Macros can explicitly send information to a listening macro stepper by
 using the procedures in this module.
 
-@defproc[(emit-remark [fragment (or/c syntax? string?)] ...
-                      [#:unmark? unmark? boolean? #t])
+@defproc[(emit-remark [fragment
+                       (letrec ([emit-arg/c
+                                 (recursive-contract
+                                  (or/c string?
+                                        syntax?
+                                        (listof emit-arg/c)
+                                        (-> emit-arg/c)))])
+                         emit-arg/c)] ...
+                      [#:unmark? unmark? boolean? (syntax-transforming?)])
          void?]{
 
 Emits an event to the macro stepper (if one is listening) containing