<commit_before>#lang racket/base

#|
This file is for utilities that are only useful for Typed Racket, but
don't depend on any other portion of the system
|#

(provide (all-defined-out) (all-from-out "disappeared-use.rkt"))
(require "syntax-traversal.rkt" racket/dict "disappeared-use.rkt" racket/promise
	 syntax/parse (for-syntax racket/base syntax/parse) racket/match)

;; a parameter representing the original location of the syntax being
;; currently checked
(define current-orig-stx (make-parameter #'here))
(define orig-module-stx (make-parameter #f))
(define expanded-module-stx (make-parameter #f))

(define (stringify l [between " "])
  (define (intersperse v l)
    (cond [(null? l) null]
          [(null? (cdr l)) l]
          [else (cons (car l) (cons v (intersperse v (cdr l))))]))
  (apply string-append
         (intersperse between (map (lambda (s) (format "~a" s)) l))))

;; helper function, not currently used
(define (find-origin stx)
  (cond [(syntax-property stx 'origin)
         => (lambda (orig)
              (let ([r (reverse orig)])
                (let loop ([r (reverse orig)])
                  (if (null? r) #f
                      (if (syntax-source (car r)) (car r)
                          (loop (cdr r)))))))]
        [else #f]))

;; do we print the fully-expanded syntax in error messages?
(define print-syntax? (make-parameter #f))


(define check-unreachable-code? (make-parameter #f))

(define warn-unreachable? (make-parameter #t))

(define (warn-unreachable e)
  (let ([l (current-logger)]
        [stx (locate-stx e)])
    (when (and (warn-unreachable?)
               (log-level? l 'warning)
               (and (syntax-transforming?)
                    (syntax-original? (syntax-local-introduce e)))
               #;(and (orig-module-stx)
                      (eq? (debugf syntax-source-module e)
                           (debugf syntax-source-module (orig-module-stx))))
               #;(syntax-source-module stx))
      (log-message l 'warning
                   (format "Typed Racket has detected unreachable code: ~.s"
                           (syntax->datum (locate-stx e)))
                   e))))

(define (locate-stx stx)
  (define omodule (orig-module-stx))
  (define emodule (expanded-module-stx))
  ;(printf "orig: ~a\n" (syntax-object->datum omodule))
  ;(printf "exp: ~a\n" (syntax-object->datum emodule))
  ;(printf "stx (locate): ~a\n" (syntax-object->datum stx))
  (if (and (not (print-syntax?)) omodule emodule stx)
      (or (look-for-in-orig omodule emodule stx) stx)
      stx))

(define (raise-typecheck-error msg stxs)
  (if (null? (cdr stxs))
      (raise-syntax-error (string->symbol "Type Checker") msg (car stxs))
      (raise-syntax-error (string->symbol "Type Checker") msg #f #f stxs)))

(define delayed-errors null)

(define-struct err (msg stx) #:prefab)

(define-values (save-errors! restore-errors!)
  (let ([v (box #f)])
    (values (lambda () (set-box! v delayed-errors))
            (lambda () (set! delayed-errors (unbox v))))))

(define (report-all-errors)
  (define (reset!) (set! delayed-errors null))
  (match (reverse delayed-errors)
    [(list) (void)]
    ;; if there's only one, we don't need multiple-error handling<commit_msg>Avoid stripping location information from syntax object in warning message.<commit_after>#lang racket/base

#|
This file is for utilities that are only useful for Typed Racket, but
don't depend on any other portion of the system
|#

(provide (all-defined-out) (all-from-out "disappeared-use.rkt"))
(require "syntax-traversal.rkt" racket/dict "disappeared-use.rkt" racket/promise
	 syntax/parse (for-syntax racket/base syntax/parse) racket/match)

;; a parameter representing the original location of the syntax being
;; currently checked
(define current-orig-stx (make-parameter #'here))
(define orig-module-stx (make-parameter #f))
(define expanded-module-stx (make-parameter #f))

(define (stringify l [between " "])
  (define (intersperse v l)
    (cond [(null? l) null]
          [(null? (cdr l)) l]
          [else (cons (car l) (cons v (intersperse v (cdr l))))]))
  (apply string-append
         (intersperse between (map (lambda (s) (format "~a" s)) l))))

;; helper function, not currently used
(define (find-origin stx)
  (cond [(syntax-property stx 'origin)
         => (lambda (orig)
              (let ([r (reverse orig)])
                (let loop ([r (reverse orig)])
                  (if (null? r) #f
                      (if (syntax-source (car r)) (car r)
                          (loop (cdr r)))))))]
        [else #f]))

;; do we print the fully-expanded syntax in error messages?
(define print-syntax? (make-parameter #f))


(define check-unreachable-code? (make-parameter #f))

(define warn-unreachable? (make-parameter #t))

(define (warn-unreachable e)
  (let ([l (current-logger)]
        [stx (locate-stx e)])
    (when (and (warn-unreachable?)
               (log-level? l 'warning)
               (and (syntax-transforming?)
                    (syntax-original? (syntax-local-introduce e)))
               #;(and (orig-module-stx)
                      (eq? (debugf syntax-source-module e)
                           (debugf syntax-source-module (orig-module-stx))))
               #;(syntax-source-module stx))
      (log-message l 'warning
                   (format "Typed Racket has detected unreachable code: ~.s"
                           (locate-stx e))
                   e))))

(define (locate-stx stx)
  (define omodule (orig-module-stx))
  (define emodule (expanded-module-stx))
  ;(printf "orig: ~a\n" (syntax-object->datum omodule))
  ;(printf "exp: ~a\n" (syntax-object->datum emodule))
  ;(printf "stx (locate): ~a\n" (syntax-object->datum stx))
  (if (and (not (print-syntax?)) omodule emodule stx)
      (or (look-for-in-orig omodule emodule stx) stx)
      stx))

(define (raise-typecheck-error msg stxs)
  (if (null? (cdr stxs))
      (raise-syntax-error (string->symbol "Type Checker") msg (car stxs))
      (raise-syntax-error (string->symbol "Type Checker") msg #f #f stxs)))

(define delayed-errors null)

(define-struct err (msg stx) #:prefab)

(define-values (save-errors! restore-errors!)
  (let ([v (box #f)])
    (values (lambda () (set-box! v delayed-errors))
            (lambda () (set! delayed-errors (unbox v))))))

(define (report-all-errors)
  (define (reset!) (set! delayed-errors null))
  (match (reverse delayed-errors)
    [(list) (void)]
    ;; if there's only one, we don't need multiple-error handling
{'fraction_non_alphanumeric': 0.15324316015985245, 'fraction_numerical': 0.0, 'mean_word_length': 2.6950596252129473, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 16, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6706341', 'n_tokens_mistral': 2202, 'n_tokens_neox': 2103, 'n_words': 631}