<commit_before>
(module trace mzscheme
  (require (lib "lex.ss" "parser-tools")
           (lib "class.ss"))
  (require "deriv.ss"
           "deriv-parser.ss"
           "deriv-tokens.ss"
           "reductions.ss"
           "hide.ss"
           "hiding-policies.ss")
  
  (provide trace-verbose?
           trace
           trace/result
           trace+reductions
           current-expand-observe
           (all-from "reductions.ss"))

  (define current-expand-observe
    (dynamic-require '#%expobs 'current-expand-observe))

  (define trace-verbose? (make-parameter #f))

  ;; trace : syntax -> Derivation
  (define (trace stx)
    (let-values ([(result tracer) (expand+tracer stx expand)])
      (parse-derivation tracer)))

  ;; trace/result : syntax -> (values syntax/exn Derivation)
  (define (trace/result stx)
    (let-values ([(result tracer) (expand+tracer stx expand)])
      (values result
              (parse-derivation tracer))))

  ;; trace+reductions : syntax -> ReductionSequence
  (define (trace+reductions stx)
    (reductions (trace stx)))

  ;; expand+tracer : syntax/sexpr (syntax -> A) -> (values A/exn (-> event))
  (define (expand+tracer sexpr expander)
    (let* ([s (make-semaphore 1)]
           [head (cons #f #f)]
           [tail head]
           [pos 0])
      (define (add! x)
        (semaphore-wait s)
        (set-car! tail x) 
        (set-cdr! tail (cons #f #f))
        (set! tail (cdr tail))
        (semaphore-post s))
      (define get
        (let ([head head])
          (lambda ()
            (semaphore-wait s)
            (let ([result (car head)])
              (set! head (cdr head))
              (semaphore-post s)
              result))))
      (parameterize ((current-expand-observe
                      (lambda (sig val)
                        (add! (cons sig val)))))
        (let ([result
               (with-handlers ([(lambda (exn) #t)
                                (lambda (exn)
                                  (add! (cons 'error exn))
                                  exn)])
                 (expander sexpr))])
          (add! (cons 'EOF pos))
          (values result
                  (lambda ()
                    (let* ([sig+val (get)]
                           [sig (car sig+val)]
                           [val (cdr sig+val)]
                           [t (tokenize sig val pos)])
                      (when (trace-verbose?)
                            (printf "~s: ~s~n" pos (token-name (position-token-token t))))
                      (set! pos (add1 pos))
                      t)))))))

  )
<commit_msg>Macro stepper: eliminated (unneeded) synchronization from tracing<commit_after>
(module trace mzscheme
  (require (lib "lex.ss" "parser-tools")
           (lib "class.ss"))
  (require "deriv.ss"
           "deriv-parser.ss"
           "deriv-tokens.ss"
           "reductions.ss"
           "hide.ss"
           "hiding-policies.ss")
  
  (provide trace-verbose?
           trace
           trace/result
           trace+reductions
           current-expand-observe
           (all-from "reductions.ss"))

  (define current-expand-observe
    (dynamic-require '#%expobs 'current-expand-observe))

  (define trace-verbose? (make-parameter #f))

  ;; trace : syntax -> Derivation
  (define (trace stx)
    (let-values ([(result tracer) (expand+tracer stx expand)])
      (parse-derivation tracer)))

  ;; trace/result : syntax -> (values syntax/exn Derivation)
  (define (trace/result stx)
    (let-values ([(result tracer) (expand+tracer stx expand)])
      (values result
              (parse-derivation tracer))))

  ;; trace+reductions : syntax -> ReductionSequence
  (define (trace+reductions stx)
    (reductions (trace stx)))

  ;; expand+tracer : syntax/sexpr (syntax -> A) -> (values A/exn (-> event))
  (define (expand+tracer sexpr expander)
    (let* ([events null]
           [pos 0])
      (define (add! x)
        (set! events (cons x events)))
      (parameterize ((current-expand-observe
                      (let ([c 0])
                        (lambda (sig val)
                          (set! c (add1 c))
                          (add! (cons sig val))))))
        (let ([result
               (with-handlers ([(lambda (exn) #t)
                                (lambda (exn)
                                  (add! (cons 'error exn))
                                  exn)])
                 (expander sexpr))])
          (add! (cons 'EOF pos))
          (values result
                  (let ([events (reverse events)])
                    (lambda ()
                      (define sig+val (car events))
                      (set! events (cdr events))
                      (let* ([sig (car sig+val)]
                             [val (cdr sig+val)]
                             [t (tokenize sig val pos)])
                        (when (trace-verbose?)
                          (printf "~s: ~s~n" pos
                                  (token-name (position-token-token t))))
                        (set! pos (add1 pos))
                        t))))))))

  )

{'fraction_non_alphanumeric': 0.13497536945812807, 'fraction_numerical': 0.001379310344827586, 'mean_word_length': 1.4182944259171033, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 15, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 5, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5092934', 'n_tokens_mistral': 1529, 'n_tokens_neox': 1449, 'n_words': 376}