cherrying

private/format-utils.rkt

@@ -8,6 +8,7 @@
          racket/set
          racket/bool
          syntax-color/racket-lexer
+         syntax-color/lexer-contract
          syntax/modread
          syntax/parse
          "shared.rkt")
@@ -61,6 +62,16 @@
                        [else (raw-covered? i c)]))))
      cache)))
 
+<<<<<<< HEAD
+=======
+(define (maybe-wrap-lexer lexer)
+  (if (procedure-arity-includes? lexer 3)
+      lexer
+      (λ (in offset mode)
+        (define-values (a b c d e) (lexer in))
+        (values a b c d e 0 #f))))
+
+>>>>>>> e051103... fixing lexer
 ;; Lexer(in the sence of color:text<%>) InputPort (Maybe (Listof Symbol)) -> (Natural -> Boolean)
 ;; builds a function that determines if a given location in that port is irrelivent.
 (define (make-irrelevant? lexer f submods)
@@ -72,15 +83,20 @@
 
   (define offset (make-byte->str-offset str))
 
-  (let loop ()
-    (define-values (v type _m start end) (lexer for-lex))
+  
+  (let loop ([mode #f])
+    (define-values (v type _m start end backup-dist new-mode/ds)
+      (lexer for-lex 0 mode))
+    (define new-mode (if (dont-stop? new-mode/ds)
+                         (dont-stop-val new-mode/ds)
+                         new-mode/ds))
     (case type
       [(eof) (void)]
       [(comment sexp-comment no-color white-space)
        (for ([i (in-range (- start (offset start)) (- end (offset end)))])
          (set-add! s (+ init-offset i)))
-       (loop)]
-      [else (loop)]))
+       (loop new-mode)]
+      [else (loop new-mode)]))
   (define stx
     (with-input-from-file f
       (thunk (with-module-reading-parameterization read-syntax))))

tests/main.rkt

@@ -27,6 +27,7 @@
       (define-values (expected-coverage expected-uncoverage)
         (with-input-from-file cover (lambda () (values (ranges->numbers (read))
                                                        (ranges->numbers (read))))))
+      (define covered? (make-covered? actual-coverage program))
       (test-begin
        (for ([i expected-coverage])
          (check-true (covered? i actual-coverage)