<commit_before>(module debug-tool mzscheme
  (require mzlib/etc
           mzlib/list
           mzlib/string
           ;mzlib/math
           mzlib/class
           mzlib/unit
           mzlib/contract
           mred
           mzlib/match
           (prefix drscheme:arrow: (lib "arrow.ss" "drscheme"))
           (lib "tool.ss" "drscheme")
           "marks.ss"
           syntax/boundmap
           (lib "bitmap-label.ss" "mrlib")
           "annotator.ss"
           "load-sandbox.ss"
           framework
           string-constants
           (lib "debugger-language-interface.ss" "lang"))
  
  (provide tool@)
  
  ; QUESTIONS/IDEAS
  ; what is the right way to deal with macros?
  ; how can the three tool classes communicate with each other safely
  
  (define tool@
    (unit 
      (import drscheme:tool^)
      (export drscheme:tool-exports^) 

      (define (phase1)
	(drscheme:language:extend-language-interface
         debugger-language<%>
         (lambda (superclass)
           (class* superclass (debugger-language<%>)
	           (public debugger:supported?)
		   (define (debugger:supported?) #t)
                   (super-instantiate ())))))
      (define phase2 void)
      
      (define (extract-language-level settings)
	(drscheme:language-configuration:language-settings-language settings))
      
      (define (debugger-does-not-work-for? lang)
	(not (send lang debugger:supported?)))
      
      (define (robust-syntax-source stx)
        (and (syntax? stx) (syntax-source stx)))
      
      (define (robust-vector-ref vec idx)
        (if (< idx (vector-length vec))
            (vector-ref vec idx)
            #f))
      
      (define (safe-vector-set! vec idx val)
        (when (< idx (vector-length vec))
          (vector-set! vec idx val))
        (void))
      
      (define (truncate str n)
        (if (< (string-length str) n)
            str
            (if (>= n 3)
                (string-append
                 (substring str 0 (- n 3))
                 "...")
                (substring str 0 (min n (string-length str))))))
      
      (define (clean-status s)
	(truncate (regexp-replace* #rx"\n" s " ") 200))
      
      (define (index-of chr str)
        (let loop ([i 0])
          (if (< i (string-length str))
              (if (char=? chr (string-ref str i))
                  i
                  (loop (add1 i)))
              #f)))
      
      ;; trim-expr-str: string -> string
      ;; examples:
      ;; short-id                   => short-id
      ;; really-long-identifier     => really-lon...
      ;; (<form>)                   => (<form>)
      ;; (<form> <arg1> ... <argn>) => (<form> ...)
      (define (trim-expr-str str)
        (let ([starts-with-paren (and (> (string-length str) 0))])
          (cond
            [(and starts-with-paren
                  (or (index-of #\space str)
                      (index-of #\newline str)
                      (and (> (string-length str) 14) 10)))
             ;; non-atomic expr: truncate to (form-name ...)
             => (lambda (i)
                  (string-append
                   (substring str 0 i)
                   (if starts-with-paren
                       " ...)"
                       " ...")))]
            [str])))
      
      (define (average . values)
        (/ (apply + values) (length values)))
      
      (define (truncate-value v size depth)
        (cond
          [(zero? depth) "..."]
          [(and (string? v)
                (> (string-length v) size))
           (string-append (substring v 0 size) "...")]
          [(list? v)
           (let* ([len (length v)]
                  [res (build-list (min size len)
                                   (lambda (i) (truncate-value (list-ref v i) size (sub1 depth))))])
             (if (> len size) (append res (list '...)) res))]
          [(vector? v)
           (build-vector (min size (vector-length v))
                         (lambda (i)
                           (if (and (= i (sub1 size))
                                    (> size (vector-length v)))
                               "..."
                               (truncate-value (vector-ref v i) size (sub1 depth)))))]
          [else v]))
      
      (define filename->defs
        (opt-lambda (source [default #f])
          (cond
            [(is-a? source editor<%>) source]
            [(or (not source) (symbol? source)) #f]
            [(send (group:get-the-frame-group) locate-file source)
             =>
             (lambda (frame)
               (let ([defss (map (lambda (t) (send t get-defs)) (send frame get-tabs))])
                 (findf (lambda (d) (equal? (send d get-filename) source)) defss)))]
            [else default])))
      
      (define (debug-definitions-text-mixin super%)
        (class super%
          
          (inherit dc-location-to-editor-location
                   editor-location-to-dc-location
                   invalidate-bitmap-cache<commit_msg>replace (equal? (send d get-filename) source) with (send d port-name-matches? source) and use for-each-frame instead of locate-file<commit_after>(module debug-tool mzscheme
  (require mzlib/etc
           mzlib/list
           mzlib/string
           ;mzlib/math
           mzlib/class
           mzlib/unit
           mzlib/contract
           mred
           mzlib/match
           (prefix drscheme:arrow: (lib "arrow.ss" "drscheme"))
           (lib "tool.ss" "drscheme")
           "marks.ss"
           syntax/boundmap
           (lib "bitmap-label.ss" "mrlib")
           "annotator.ss"
           "load-sandbox.ss"
           framework
           string-constants
           (lib "debugger-language-interface.ss" "lang"))
  
  (provide tool@)
  
  ; QUESTIONS/IDEAS
  ; what is the right way to deal with macros?
  ; how can the three tool classes communicate with each other safely
  
  (define tool@
    (unit 
      (import drscheme:tool^)
      (export drscheme:tool-exports^) 

      (define (phase1)
	(drscheme:language:extend-language-interface
         debugger-language<%>
         (lambda (superclass)
           (class* superclass (debugger-language<%>)
	           (public debugger:supported?)
		   (define (debugger:supported?) #t)
                   (super-instantiate ())))))
      (define phase2 void)
      
      (define (extract-language-level settings)
	(drscheme:language-configuration:language-settings-language settings))
      
      (define (debugger-does-not-work-for? lang)
	(not (send lang debugger:supported?)))
      
      (define (robust-syntax-source stx)
        (and (syntax? stx) (syntax-source stx)))
      
      (define (robust-vector-ref vec idx)
        (if (< idx (vector-length vec))
            (vector-ref vec idx)
            #f))
      
      (define (safe-vector-set! vec idx val)
        (when (< idx (vector-length vec))
          (vector-set! vec idx val))
        (void))
      
      (define (truncate str n)
        (if (< (string-length str) n)
            str
            (if (>= n 3)
                (string-append
                 (substring str 0 (- n 3))
                 "...")
                (substring str 0 (min n (string-length str))))))
      
      (define (clean-status s)
	(truncate (regexp-replace* #rx"\n" s " ") 200))
      
      (define (index-of chr str)
        (let loop ([i 0])
          (if (< i (string-length str))
              (if (char=? chr (string-ref str i))
                  i
                  (loop (add1 i)))
              #f)))
      
      ;; trim-expr-str: string -> string
      ;; examples:
      ;; short-id                   => short-id
      ;; really-long-identifier     => really-lon...
      ;; (<form>)                   => (<form>)
      ;; (<form> <arg1> ... <argn>) => (<form> ...)
      (define (trim-expr-str str)
        (let ([starts-with-paren (and (> (string-length str) 0))])
          (cond
            [(and starts-with-paren
                  (or (index-of #\space str)
                      (index-of #\newline str)
                      (and (> (string-length str) 14) 10)))
             ;; non-atomic expr: truncate to (form-name ...)
             => (lambda (i)
                  (string-append
                   (substring str 0 i)
                   (if starts-with-paren
                       " ...)"
                       " ...")))]
            [str])))
      
      (define (average . values)
        (/ (apply + values) (length values)))
      
      (define (truncate-value v size depth)
        (cond
          [(zero? depth) "..."]
          [(and (string? v)
                (> (string-length v) size))
           (string-append (substring v 0 size) "...")]
          [(list? v)
           (let* ([len (length v)]
                  [res (build-list (min size len)
                                   (lambda (i) (truncate-value (list-ref v i) size (sub1 depth))))])
             (if (> len size) (append res (list '...)) res))]
          [(vector? v)
           (build-vector (min size (vector-length v))
                         (lambda (i)
                           (if (and (= i (sub1 size))
                                    (> size (vector-length v)))
                               "..."
                               (truncate-value (vector-ref v i) size (sub1 depth)))))]
          [else v]))
      
      (define filename->defs
        (opt-lambda (source [default #f])
          (let/cc k
            (cond
              [(is-a? source editor<%>) source]
              [else
               (send (group:get-the-frame-group) for-each-frame
                     (lambda (frame)
                       (let* ([defss (map (lambda (t) (send t get-defs)) (send frame get-tabs))]
                              [defs (findf (lambda (d) (send d port-name-matches? source)) defss)])
                         (and defs (k defs)))))
               default]))))
      
      (define (debug-definitions-text-mixin super%)
        (class super%
          
          (inherit dc-location-to-editor-location
                   editor-location-to-dc-location
                   invalidate-bitmap-cache
{'fraction_non_alphanumeric': 0.13810842896715472, 'fraction_numerical': 0.004352987732489117, 'mean_word_length': 1.323373937025971, 'pattern_counts': {'":': 0, '<': 29, '<?xml version=': 0, '>': 48, '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': '911166', 'n_tokens_mistral': 3034, 'n_tokens_neox': 2848, 'n_words': 752}