add a contract on the interaction between the module-lexer and the

lexers it defers to

also, remove the checks in color.rkt in the framework (they are not
all covered by the added contract, but they mostly are and when they
aren't, most of those times are using the heavily tested racket-lexer)

collects/framework/private/color.rkt

@@ -337,16 +337,6 @@ added get-regions
             (set-lexer-state-up-to-date?! ls #t)
             (re-tokenize-move-to-next-ls start-time #t)]
            [else
-            (unless (exact-positive-integer? new-token-start)
-              (error 'color:text<%> "expected an exact nonnegative integer for the token start, got ~e" new-token-start))
-            (unless (exact-positive-integer? new-token-end)
-              (error 'color:text<%> "expected an exact nonnegative integer for the token end, got ~e" new-token-end))
-            (unless (exact-nonnegative-integer? backup-delta)
-              (error 'color:text<%> "expected an exact nonnegative integer for the backup delta, got ~e" backup-delta))
-            (unless (new-token-start . < . new-token-end)
-              (error 'color:text<%>
-                     "expected the distance between the start and end position for each token to be positive, but start was ~e and end was ~e"
-                     new-token-start new-token-end))
             (unless (<= pos-before new-token-start pos-after)
               (error 'color:text<%>
                      "expected the token start to be between ~s and ~s, got ~s" pos-before pos-after new-token-start))

collects/syntax-color/module-lexer.rkt

@@ -1,6 +1,7 @@
-#lang scheme/base
+#lang racket/base
-(require scheme/port
+(require racket/port
-         "scheme-lexer.rkt")
+         "racket-lexer.rkt"
+         racket/contract)
 (provide module-lexer)
 
 #|
@@ -22,6 +23,32 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
 
 |#
 
+(define lexer/c
+  (or/c (->i ([in input-port?])
+             (values [txt any/c]
+                     [type symbol?]
+                     [paren (or/c symbol? #f)]
+                     [start (or/c exact-positive-integer? #f)]
+                     [end (start) 
+                          (if start
+                              (and/c exact-positive-integer?
+                                     (>=/c start))
+                              #f)]))
+        (->i ([in input-port?]
+              [offset exact-nonnegative-integer?]
+              [mode any/c])
+            (values [txt any/c]
+                    [type symbol?]
+                    [paren (or/c symbol? #f)]
+                    [start (or/c exact-positive-integer? #f)]
+                    [end (start) 
+                         (if start
+                             (and/c exact-positive-integer?
+                                    (>=/c start))
+                             #f)]
+                    [backup exact-nonnegative-integer?]
+                    [new-mode any/c]))))
+
 (define (module-lexer in offset mode)
   (cond
     [(or (not mode) (eq? mode 'before-lang-line))
@@ -30,7 +57,7 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
        (when line 
          (port-count-lines! lexer-port)))
      (set-port-next-location-from in lexer-port)
-     (define-values (lexeme type data new-token-start new-token-end) (scheme-lexer lexer-port))
+     (define-values (lexeme type data new-token-start new-token-end) (racket-lexer lexer-port))
      (cond
        [(or (eq? type 'comment) (eq? type 'white-space))
         (define lexer-end (file-position lexer-port))
@@ -41,32 +68,51 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
        [else
         ;; look for #lang:
         (define p (peeking-input-port in #:init-position (+ 1 (file-position in))))
+        (define name-p (peeking-input-port in #:init-position (+ 1 (file-position in))))
         (let-values ([(line col pos) (port-next-location in)])
           (when line 
-            (port-count-lines! p)))
+            (port-count-lines! p)
+            (port-count-lines! name-p)))
         (set-port-next-location-from in p)
+        (set-port-next-location-from in name-p)
         (define-values (_1 _2 start-pos) (port-next-location p))
         (define get-info (with-handlers ([exn:fail? values]) (read-language p (λ () 'fail))))
         (define-values (_3 _4 end-pos) (port-next-location p))
         (cond
           [(procedure? get-info)
+           (define lang-name 
+             (apply string
+                    (filter
+                     char?
+                     (for/list ([i (in-range (file-position in) (file-position p))])
+                       (read-char name-p)))))
+          
            ;; sync ports
            (for ([i (in-range (file-position in) (file-position p))])
              (read-byte-or-special in))
+           
+           (define no-ctc-lexer (or (get-info 'color-lexer #f)
+                                    racket-lexer))
+           ;; add the lexer contract
+           (define the-lexer (contract lexer/c
+                                       no-ctc-lexer
+                                       lang-name
+                                       'syntax-color/module-lexer
+                                       (or (object-name no-ctc-lexer)
+                                           (format "~a's lexer" lang-name))
+                                       #'here))
+           
            ;; Produce language as first token:
            (values
-            "#lang"
+            lang-name
             'other
             #f
             start-pos
             end-pos
             0
-            (or (let ([v (get-info 'color-lexer #f)])
+            (if (procedure-arity-includes? the-lexer 3)
-                  (and v
+                (cons the-lexer #f)
-                       (if (procedure-arity-includes? v 3)
+                the-lexer))]
-                           (cons v #f)
-                           v)))
-                scheme-lexer))]
          
           [(and (eq? type 'other)
                 (string? lexeme)
@@ -82,7 +128,7 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
            (values lexeme type data new-token-start new-token-end 0 'no-lang-line)])])]
     [(eq? mode 'no-lang-line)
      (let-values ([(lexeme type data new-token-start new-token-end) 
-                   (scheme-lexer in)])
+                   (racket-lexer in)])
        (values lexeme type data new-token-start new-token-end 0 'no-lang-line))]
     [(pair? mode)
      ;; #lang-selected language consumes and produces a mode: