<commit_before>#lang racket/base
(require racket/contract/base
         unstable/options)
(provide lexer/c (struct-out dont-stop))

(struct dont-stop (val) #:transparent)

(define lexer/c
  (option/c
   (or/c (->i ([in (and/c input-port? port-counts-lines?)])
              (values [txt any/c]
                      [type symbol?]
                      [paren (or/c symbol? #f)]
                      [start (or/c exact-positive-integer? #f)]
                      [end (start type) (end/c start type)]))
         (->i ([in (and/c input-port? port-counts-lines?)]
               [offset exact-nonnegative-integer?]
               [mode (not/c dont-stop?)])
              (values [txt any/c]
                      [type symbol?]
                      [paren (or/c symbol? #f)]
                      [start (or/c exact-positive-integer? #f)]
                      [end (start type) (end/c start type)]
                      [backup exact-nonnegative-integer?]
                      [new-mode any/c])))
   #:tester (λ (lexer) (try-some-random-streams lexer))))

(define (try-some-random-streams lexer)
  (define 3ary-lexer
    (cond
      [(procedure-arity-includes? lexer 1)
       (λ (in offset mode)
         (define-values (txt type paren start end) (lexer in))
         (values txt type paren start end 0 #f))]
      [else lexer]))
  (for ([x (in-range 10)])
    (define size (random 100))
    (define (quash-backslash-r c)
      ;; it isn't clear the spec is right in
      ;; the case of \r\n combinations, so we
      ;; punt for now
      (if (equal? c #\return) #\newline c))
    (define s (build-string
               size
               (λ (c) 
                 (quash-backslash-r
                  (case (random 3)
                    [(0)
                     (define s " ()@{}\"λΣ\0")
                     (string-ref s (random (string-length s)))]
                    [(1 2)
                     (integer->char (random 255))])))))
    (define in (open-input-string s))
    (port-count-lines! in)
    (let loop ([mode #f][offset 0])
      (define-values (txt type paren start end backup new-mode)
        (3ary-lexer in offset mode))
      (cond
        [(equal? type 'eof) #t]
        [(< end size) (loop new-mode end)]
        [else #f]))))

(define (end/c start type)
  (cond
    [(equal? 'eof type) 
     (or/c exact-positive-integer? #f)]
    [start
     (and/c exact-positive-integer?
            (>/c start))]
    [else
     #f]))<commit_msg>syntax-color/lexer-contract: make random-test failure declare itself<commit_after>#lang racket/base
(require racket/contract/base
         unstable/options)
(provide lexer/c (struct-out dont-stop))

(struct dont-stop (val) #:transparent)

(define lexer/c
  (option/c
   (or/c (->i ([in (and/c input-port? port-counts-lines?)])
              (values [txt any/c]
                      [type symbol?]
                      [paren (or/c symbol? #f)]
                      [start (or/c exact-positive-integer? #f)]
                      [end (start type) (end/c start type)]))
         (->i ([in (and/c input-port? port-counts-lines?)]
               [offset exact-nonnegative-integer?]
               [mode (not/c dont-stop?)])
              (values [txt any/c]
                      [type symbol?]
                      [paren (or/c symbol? #f)]
                      [start (or/c exact-positive-integer? #f)]
                      [end (start type) (end/c start type)]
                      [backup exact-nonnegative-integer?]
                      [new-mode any/c])))
   #:tester (λ (lexer) (try-some-random-streams lexer))))

(define (try-some-random-streams lexer)
  (define 3ary-lexer
    (cond
      [(procedure-arity-includes? lexer 1)
       (λ (in offset mode)
         (define-values (txt type paren start end) (lexer in))
         (values txt type paren start end 0 #f))]
      [else lexer]))
  (define initial-state (pseudo-random-generator->vector
                         (current-pseudo-random-generator)))
  (with-handlers ([exn:fail?
                   (lambda (exn)
                     (raise
                      (make-exn
                       (format (string-append "try-some-random-streams:"
                                              " random testing of lexer failed\n"
                                              "  lexer: ~e\n"
                                              "  pseudo-random state: ~s\n"
                                              "  error message: ~s")
                               lexer
                               initial-state
                               (exn-message exn))
                       (exn-continuation-marks exn))))])
    (for ([x (in-range 10)])
      (define size (random 100))
      (define (quash-backslash-r c)
        ;; it isn't clear the spec is right in
        ;; the case of \r\n combinations, so we
        ;; punt for now
        (if (equal? c #\return) #\newline c))
      (define s (build-string
                 size
                 (λ (c) 
                   (quash-backslash-r
                    (case (random 3)
                      [(0)
                       (define s " ()@{}\"λΣ\0")
                       (string-ref s (random (string-length s)))]
                      [(1 2)
                       (integer->char (random 255))])))))
      (define in (open-input-string s))
      (port-count-lines! in)
      (let loop ([mode #f][offset 0])
        (define-values (txt type paren start end backup new-mode)
          (3ary-lexer in offset mode))
        (cond
         [(equal? type 'eof) #t]
         [(< end size) (loop new-mode end)]
         [else #f])))))

(define (end/c start type)
  (cond
    [(equal? 'eof type) 
     (or/c exact-positive-integer? #f)]
    [start
     (and/c exact-positive-integer?
            (>/c start))]
    [else
     #f]))
{'fraction_non_alphanumeric': 0.13887933997937435, 'fraction_numerical': 0.006187693365417669, 'mean_word_length': 1.3644859813084111, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 12, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6890740', 'n_tokens_mistral': 1840, 'n_tokens_neox': 1706, 'n_words': 480}