From c6395521324b43a77fbf1a171fdfb4d49d0152bc Mon Sep 17 00:00:00 2001
From: Spencer Florence <florence@ccs.neu.edu>
Date: Sun, 28 Dec 2014 21:01:17 -0600
Subject: [PATCH] now ignoring submodules in coverage reports.

---
 format.rkt | 39 ++++++++++++++++++++++++++-------------
 1 file changed, 26 insertions(+), 13 deletions(-)

diff --git a/format.rkt b/format.rkt
index d76cd85..3ab9503 100644
--- a/format.rkt
+++ b/format.rkt
@@ -258,20 +258,33 @@
                 cache)
      cache)))
 
-;; TODO things in submods should be irrelevant too
+;; TODO should we only ignore test (and main) submodules?
 (define (make-irrelevant? lexer f)
-  (define s
-    (let ([s (mutable-set)])
-      (let loop ()
-        (define-values (_v type _m start end) (lexer (current-input-port)))
-        (case type
-          [(eof) (void)]
-          [(comment sexp-comment no-color)
-           (for ([i (in-range start end)])
-             (set-add! s i))
-           (loop)]
-          [else (loop)]))
-      s))
+  (define s (mutable-set))
+  (let loop ()
+    (define-values (_v type _m start end) (lexer (current-input-port)))
+    (case type
+      [(eof) (void)]
+      [(comment sexp-comment no-color)
+       (for ([i (in-range start end)])
+         (set-add! s i))
+       (loop)]
+      [else (loop)]))
+  (define stx
+    (with-input-from-file f
+      (thunk (with-module-reading-parameterization read-syntax))))
+  (let loop ([stx stx] [first? #t])
+    (define (loop* stx) (loop stx #f))
+    (syntax-parse stx
+      #:datum-literals (module module* module+)
+      [((~or module module* module+) e ...)
+       #:when (not first?)
+       (define pos (syntax-position stx))
+       (when pos
+         (for ([i (in-range pos (+ pos (syntax-span stx)))])
+           (set-add! s i)))]
+      [(e ...) (for-each loop* (syntax->list #'(e ...)))]
+      [_else (void)]))
   (lambda (i) (set-member? s i)))
 
 (define (in-syntax-object? i stx)