<commit_before>#lang racket/base
(require racket/contract/base
         (for-template racket/base
                       racket/contract/base
                       syntax/location)
         syntax/srcloc
         racket/syntax)

(provide/contract
 [wrap-expr/c
  (->* (syntax? syntax?)
       (#:positive (or/c syntax? string? module-path-index?
                         'from-macro 'use-site 'unknown)
        #:negative (or/c syntax? string? module-path-index?
                         'from-macro 'use-site 'unknown)
        #:name (or/c identifier? symbol? string? #f)
        #:macro (or/c identifier? symbol? string? #f)
        #:context (or/c syntax? #f))
       syntax?)])

(define (wrap-expr/c ctc-expr expr
                     #:positive [pos-source 'use-site]
                     #:negative [neg-source 'from-macro]
                     #:name [expr-name #f]
                     #:macro [macro-name #f]
                     #:context [ctx (current-syntax-context)])
  (let* ([pos-source-expr
          (get-source-expr pos-source
                           (if (identifier? macro-name) macro-name ctx))]
         [neg-source-expr
          (get-source-expr neg-source
                           (if (identifier? macro-name) macro-name ctx))]
         [macro-name
          (cond [(identifier? macro-name) (syntax-e macro-name)]
                [(or (string? macro-name) (symbol? macro-name)) macro-name]
                [(syntax? ctx)
                 (syntax-case ctx ()
                   [(x . _) (identifier? #'x) (syntax-e #'x)]
                   [x (identifier? #'#'x)]
                   [_ #f])]
                [else #f])])
    (base-wrap-expr/c expr ctc-expr
                      #:positive #'(quote-module-name)
                      #:negative neg-source-expr
                      #:expr-name (cond [(and expr-name macro-name)
                                          (format "~a of ~a" expr-name macro-name)]
                                         [expr-name expr-name]
                                         [else #f])
                      #:source #`(quote-syntax #,expr))))

(define (base-wrap-expr/c expr ctc-expr
                          #:positive positive
                          #:negative negative
                          #:expr-name [expr-name #f]
                          #:source [source #f])
  (let ([expr-name (or expr-name #'#f)]
        [source (or source #'#f)])
    #`(contract #,ctc-expr
                #,expr
                #,positive
                #,negative
                #,expr-name
                #,source)))

(define (get-source-expr source ctx)
  (cond [(eq? source 'use-site)
         #'(quote-module-name)]
        [(eq? source 'unknown)
         #'(quote "unknown")]
        [(eq? source 'from-macro)
         (if (syntax? ctx)
             (get-source-expr (extract-source ctx) #f)
             (get-source-expr 'unknown #f))]
        [else
         (let ([source-string
                (cond [(string? source) source]
                      [(syntax? source) (source-location->string source)]
                      [(module-path-index? source)
                       ;; FIXME: share with syntax/location ??
                       (let ([name (resolved-module-path-name
                                    (module-path-index-resolve source))])
                         (cond [(path? name) (format "(file ~s)" (path->string name))]
                               [(symbol? name) (format "(quote ~s)" name)]))])])
           #`(quote #,source-string))]))

(define (extract-source stx)
  (let ([id (syntax-case stx ()
              [(x . _) (identifier? #'x) #'x]
              [x (identifier? #'x) #'x]
              [_ #f])])
    (if id
        (let ([b (identifier-binding id)])
          (cond [(list? b) (car b)] ;; module-path-index
                [else 'use-site]))
        'unknown)))<commit_msg>avoid resolving module-path-index (current-directory may not be set right)<commit_after>#lang racket/base
(require racket/contract/base
         (for-template racket/base
                       racket/contract/base
                       syntax/location)
         syntax/srcloc
         syntax/modcollapse
         racket/syntax)

(provide/contract
 [wrap-expr/c
  (->* (syntax? syntax?)
       (#:positive (or/c syntax? string? module-path-index?
                         'from-macro 'use-site 'unknown)
        #:negative (or/c syntax? string? module-path-index?
                         'from-macro 'use-site 'unknown)
        #:name (or/c identifier? symbol? string? #f)
        #:macro (or/c identifier? symbol? string? #f)
        #:context (or/c syntax? #f))
       syntax?)])

(define (wrap-expr/c ctc-expr expr
                     #:positive [pos-source 'use-site]
                     #:negative [neg-source 'from-macro]
                     #:name [expr-name #f]
                     #:macro [macro-name #f]
                     #:context [ctx (current-syntax-context)])
  (let* ([pos-source-expr
          (get-source-expr pos-source
                           (if (identifier? macro-name) macro-name ctx))]
         [neg-source-expr
          (get-source-expr neg-source
                           (if (identifier? macro-name) macro-name ctx))]
         [macro-name
          (cond [(identifier? macro-name) (syntax-e macro-name)]
                [(or (string? macro-name) (symbol? macro-name)) macro-name]
                [(syntax? ctx)
                 (syntax-case ctx ()
                   [(x . _) (identifier? #'x) (syntax-e #'x)]
                   [x (identifier? #'#'x)]
                   [_ #f])]
                [else #f])])
    (base-wrap-expr/c expr ctc-expr
                      #:positive #'(quote-module-name)
                      #:negative neg-source-expr
                      #:expr-name (cond [(and expr-name macro-name)
                                          (format "~a of ~a" expr-name macro-name)]
                                         [expr-name expr-name]
                                         [else #f])
                      #:source #`(quote-syntax #,expr))))

(define (base-wrap-expr/c expr ctc-expr
                          #:positive positive
                          #:negative negative
                          #:expr-name [expr-name #f]
                          #:source [source #f])
  (let ([expr-name (or expr-name #'#f)]
        [source (or source #'#f)])
    #`(contract #,ctc-expr
                #,expr
                #,positive
                #,negative
                #,expr-name
                #,source)))

(define (get-source-expr source ctx)
  (cond [(eq? source 'use-site)
         #'(quote-module-name)]
        [(eq? source 'unknown)
         #'(quote "unknown")]
        [(eq? source 'from-macro)
         (if (syntax? ctx)
             (get-source-expr (extract-source ctx) #f)
             (get-source-expr 'unknown #f))]
        [(string? source) #`(quote #,source)]
        [(syntax? source) #`(quote #,(source-location->string source))]
        [(module-path-index? source)
         ;; FIXME: extend collapse-module-path-index to accept #f, return rel mod path
         (let* ([here (current-load-relative-directory)]
                [collapsed
                 (collapse-module-path-index source (or here (build-path 'same)))])
           (cond [(and (path? collapsed) here)
                  #`(quote #,(path->string collapsed))]
                 [(path? collapsed)
                  (let-values ([(rel base) (module-path-index-split source)])
                    #`(quote #,rel))]
                 [else
                  #`(quote #,(format "~s" collapsed))]))]))

(define (extract-source stx)
  (let ([id (syntax-case stx ()
              [(x . _) (identifier? #'x) #'x]
              [x (identifier? #'x) #'x]
              [_ #f])])
    (if id
        (let ([b (identifier-binding id)])
          (cond [(list? b) (car b)] ;; module-path-index
                [else 'use-site]))
        'unknown)))
{'fraction_non_alphanumeric': 0.14844533600802406, 'fraction_numerical': 0.0, 'mean_word_length': 1.3379249706916765, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 13, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6482205', 'n_tokens_mistral': 2380, 'n_tokens_neox': 2160, 'n_words': 545}