<commit_before>#lang racket/base

(require redex/private/search
         racket/cmdline
         racket/list
         racket/set
         racket/match
         racket/path
         racket/system
         (only-in redex/reduction-semantics caching-enabled?)
         math/statistics)

(define minutes 1)
(define verbose #f)
(define output-file #f)
(define n-procs #f)
(define first-only #f)

(define all-types '(search grammar search-gen search-gen-ref 
                           search-gen-enum search-gen-enum-ref
                           enum ordered fixed))
(define types '())

(define timeout-time (* 5 60 1000)) ;; 5 mins in ms

(define (set-type! arg)
  (define t (string->symbol arg))
  (unless (list? (member t all-types))
    (error "Expected a generation type, got" t))
  (set! types (cons t types)))
(define filename
  (command-line
   #:once-each
   [("-m" "--minutes") mins "Minutes to run each instance for"
                       (set! minutes (string->number mins))]
   [("-v" "--verbose") "Report test information during the run"
                       (set! verbose #t)]
   [("-o" "--output") out-file "Output file name"
                      (set! output-file out-file)]
   [("-n" "--num-processes") nps "Number of parallel processes to use"
                                  (set! n-procs (string->number nps))]
   [("-f" "--first-only") "Find the first counterexample only"
                          (set! first-only #t)]
   #:multi
   [("-t" "--type") t "Generation type to run, one of: search, grammar, search-gen, search-gen-ref, search-gen-enum, search-gen-enum-ref, enum, ordered, fixed"
                    (set-type! t)]
   #:args filenames
   (match filenames
     [`()
      (exit)]
     [(list name)
      name]
     [else
      (error "Expected a single file as an argument")])))

(when (empty? types)
  (set! types all-types))

(define results (for/hash ([t (in-list types)])
                  (values t '())))
(define stats (for/hash ([t (in-list types)])
                (values t empty-statistics)))

(unless output-file
  (set! output-file (string-append 
                     (first 
                      (regexp-split #rx"\\."
                                    (last (regexp-split #rx"/" filename))))
                     "-results.rktd")))

(define (with-timeout time thunk fail-thunk)
  (define res-chan (make-channel))
  (define exn-chan (make-channel))
  (define thd (thread (λ () 
                        (with-handlers ([exn:fail? (λ (exn) (channel-put exn-chan exn))])
                          (channel-put res-chan (thunk))))))
  (sync
   (handle-evt (alarm-evt (+ (current-inexact-milliseconds) time))
               (λ (_) 
                 (break-thread thd)
                 (fail-thunk)))
   (handle-evt exn-chan
               (λ (exn) (raise exn)))
   (handle-evt res-chan
               (λ (result-of-thunk) result-of-thunk))))

(define (run/spawn-generations fname verbose? no-errs? get-gen check seconds type)
  (if n-procs
      (spawn-parallel fname verbose? no-errs? get-gen check seconds type)
      (run-generations fname verbose? no-errs? get-gen check seconds type)))

(define (spawn-parallel fname verbose? no-errs? get-gen check seconds type)
  (define (make-cmd n)
    (define oname (string-append
                   (first 
                      (regexp-split #rx"\\."
                                    (last (regexp-split #rx"/" (path->string fname)))))
                   "-"
                   (symbol->string type)
                   "-results-" (number->string n) ".rktd"))
    (format "racket test-file.rkt -m ~s -t ~s -o ~s ~a"
            (/ seconds 60)
            type
            oname
            fname))
  (map thread-wait
       (for/list ([n n-procs])
         (thread 
          (λ () (system (make-cmd n)))))))

(struct timeout ())
(struct reached-limit (tries))

(define (run-generations fname verbose? no-errs? get-gen check seconds type)
  (collect-garbage)
  (define s-time (current-process-milliseconds))
  (define time-limit (+ s-time (* 1000 seconds)))
  (define terms 0)
  (define counterexamples 0)
  (define (tot-time) (- (current-process-milliseconds) s-time))
  (let trials-loop ([t 0]
                    [g (get-gen)])
    (define trial-start-time (current-process-milliseconds))
    (define (me-time) (- (current-process-milliseconds) trial-start-time))
    (match (one-counterexample trial-start-time time-limit 
                               g check fname type)
      [(timeout)
       (trials-loop t g)]
      [(reached-limit tries)
       (exit-message fname type (+ tries terms) (tot-time) counterexamples)]
      [(list tries term)
       (define continue? (update-results (me-time) fname type verbose?))
       (set! counterexamples (add1 counterexamples))
       (when verbose?
         (printf "~a: counterexample: ~s\n  ~s iterations and ~s milliseconds\n"
                 fname term tries (me-time)))
       (when no-errs?
         (printf "!---------------------------------------------------!\n")
         (error 'run-generations "~a: unexpected error on ~s" 
                fname term))
       (if (and (not first-only)
                (or continue?
                    (t . < . 5)))
           (begin
             (set! terms (+ tries terms))
             (trials-loop (add1 t) (get-gen)))
           (exit-message fname type (+ tries terms) (tot-time) counterexamples))])))

(define (one-counterexample s-time time-limit generator check fname type)
  (let/ec break
    (let loop ([tries 0])
      (when ((current-process-milliseconds) . > . time-limit)
        (break (reached-limit tries))) 
      (define term (with-timeout (* 5 1000) generator
                                 (λ () (printf "\nTimed out generating a test term in: ~a, ~a\n"
                                               fname type)
                                   (break (timeout)))))
      (define ok? (with-timeout (* 5 1000) (λ () (check term))
                                (λ () (printf "\nIn ~a, ~a, timed out checking the term: ~s\n"
                                              fname type term)
                                  (break (timeout)))))
      (cond
        [(not ok?)
         (list tries term)]
        [else
         (loop (add1 tries))]))))

(define (exit-message file type terms time countxmps)
  (printf "----------\n~a, ~s\n" file type)
  (printf "Quitting after ~s iterations and ~s milliseconds\n ~s terms/sec\n"
          terms time (exact->inexact (/ terms (/ time 1000))))
  (printf "~s counterexamples, ~s tries... ratio: ~s\n-----------------\n"<commit_msg>print out check's input on exceptions<commit_after>#lang racket/base

(require redex/private/search
         racket/cmdline
         racket/list
         racket/set
         racket/match
         racket/path
         racket/system
         (only-in redex/reduction-semantics caching-enabled?)
         math/statistics)

(define minutes 1)
(define verbose #f)
(define output-file #f)
(define n-procs #f)
(define first-only #f)

(define all-types '(search grammar search-gen search-gen-ref 
                           search-gen-enum search-gen-enum-ref
                           enum ordered fixed))
(define types '())

(define timeout-time (* 5 60 1000)) ;; 5 mins in ms

(define (set-type! arg)
  (define t (string->symbol arg))
  (unless (list? (member t all-types))
    (error "Expected a generation type, got" t))
  (set! types (cons t types)))
(define filename
  (command-line
   #:once-each
   [("-m" "--minutes") mins "Minutes to run each instance for"
                       (set! minutes (string->number mins))]
   [("-v" "--verbose") "Report test information during the run"
                       (set! verbose #t)]
   [("-o" "--output") out-file "Output file name"
                      (set! output-file out-file)]
   [("-n" "--num-processes") nps "Number of parallel processes to use"
                                  (set! n-procs (string->number nps))]
   [("-f" "--first-only") "Find the first counterexample only"
                          (set! first-only #t)]
   #:multi
   [("-t" "--type") t "Generation type to run, one of: search, grammar, search-gen, search-gen-ref, search-gen-enum, search-gen-enum-ref, enum, ordered, fixed"
                    (set-type! t)]
   #:args filenames
   (match filenames
     [`()
      (exit)]
     [(list name)
      name]
     [else
      (error "Expected a single file as an argument")])))

(when (empty? types)
  (set! types all-types))

(define results (for/hash ([t (in-list types)])
                  (values t '())))
(define stats (for/hash ([t (in-list types)])
                (values t empty-statistics)))

(unless output-file
  (set! output-file (string-append 
                     (first 
                      (regexp-split #rx"\\."
                                    (last (regexp-split #rx"/" filename))))
                     "-results.rktd")))

(define (with-timeout time thunk fail-thunk [on-exn raise])
  (define res-chan (make-channel))
  (define exn-chan (make-channel))
  (define thd (thread (λ () 
                        (with-handlers ([exn:fail? (λ (exn) (channel-put exn-chan exn))])
                          (channel-put res-chan (thunk))))))
  (sync
   (handle-evt (alarm-evt (+ (current-inexact-milliseconds) time))
               (λ (_) 
                 (break-thread thd)
                 (fail-thunk)))
   (handle-evt exn-chan
               (λ (exn) (on-exn exn)))
   (handle-evt res-chan
               (λ (result-of-thunk) result-of-thunk))))

(define (run/spawn-generations fname verbose? no-errs? get-gen check seconds type)
  (if n-procs
      (spawn-parallel fname verbose? no-errs? get-gen check seconds type)
      (run-generations fname verbose? no-errs? get-gen check seconds type)))

(define (spawn-parallel fname verbose? no-errs? get-gen check seconds type)
  (define (make-cmd n)
    (define oname (string-append
                   (first 
                      (regexp-split #rx"\\."
                                    (last (regexp-split #rx"/" (path->string fname)))))
                   "-"
                   (symbol->string type)
                   "-results-" (number->string n) ".rktd"))
    (format "racket test-file.rkt -m ~s -t ~s -o ~s ~a"
            (/ seconds 60)
            type
            oname
            fname))
  (map thread-wait
       (for/list ([n n-procs])
         (thread 
          (λ () (system (make-cmd n)))))))

(struct timeout ())
(struct reached-limit (tries))

(define (run-generations fname verbose? no-errs? get-gen check seconds type)
  (collect-garbage)
  (define s-time (current-process-milliseconds))
  (define time-limit (+ s-time (* 1000 seconds)))
  (define terms 0)
  (define counterexamples 0)
  (define (tot-time) (- (current-process-milliseconds) s-time))
  (let trials-loop ([t 0]
                    [g (get-gen)])
    (define trial-start-time (current-process-milliseconds))
    (define (me-time) (- (current-process-milliseconds) trial-start-time))
    (match (one-counterexample trial-start-time time-limit 
                               g check fname type)
      [(timeout)
       (trials-loop t g)]
      [(reached-limit tries)
       (exit-message fname type (+ tries terms) (tot-time) counterexamples)]
      [(list tries term)
       (define continue? (update-results (me-time) fname type verbose?))
       (set! counterexamples (add1 counterexamples))
       (when verbose?
         (printf "~a: counterexample: ~s\n  ~s iterations and ~s milliseconds\n"
                 fname term tries (me-time)))
       (when no-errs?
         (printf "!---------------------------------------------------!\n")
         (error 'run-generations "~a: unexpected error on ~s" 
                fname term))
       (if (and (not first-only)
                (or continue?
                    (t . < . 5)))
           (begin
             (set! terms (+ tries terms))
             (trials-loop (add1 t) (get-gen)))
           (exit-message fname type (+ tries terms) (tot-time) counterexamples))])))

(define (one-counterexample s-time time-limit generator check fname type)
  (let/ec break
    (let loop ([tries 0])
      (when ((current-process-milliseconds) . > . time-limit)
        (break (reached-limit tries))) 
      (define term (with-timeout (* 5 1000) generator
                                 (λ () (printf "\nTimed out generating a test term in: ~a, ~a\n"
                                               fname type)
                                   (break (timeout)))))
      (define ok? (with-timeout (* 5 1000) (λ () (check term))
                                (λ () (printf "\nIn ~a, ~a, timed out checking the term: ~s\n"
                                              fname type term)
                                  (break (timeout)))
                                (λ (exn)
                                  (printf "\nException when calling check with:\n~s\n" term)
                                  (raise exn))))
      (cond
        [(not ok?)
         (list tries term)]
        [else
         (loop (add1 tries))]))))

(define (exit-message file type terms time countxmps)
  (printf "----------\n~a, ~s\n" file type)
  (printf "Quitting after ~s iterations and ~s milliseconds\n ~s terms/sec\n"
          terms time (exact->inexact (/ terms (/ time 1000))))
  (printf "~s counterexamples, ~s tries... ratio: ~s\n-----------------\n"
{'fraction_non_alphanumeric': 0.15134570938641617, 'fraction_numerical': 0.005517035711623052, 'mean_word_length': 1.7109943411479385, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 27, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2654353', 'n_tokens_mistral': 4157, 'n_tokens_neox': 3962, 'n_words': 1173}