<commit_before>#lang racket/base
(require (for-syntax racket/base
                     racket/list)
         racket/list
         racket/contract
         racket/undefined)

(provide define-type type-case)

(define-for-syntax (plai-syntax-error id stx-loc format-string . args)
  (raise-syntax-error
   id (apply format (cons format-string args)) stx-loc))

(define bug:fallthru-no-else
  (string-append
   "You have encountered a bug in the PLAI code.  (Error: type-case "
   "fallthru on cond without an else clause.)"))
(define-for-syntax bound-id
  (string-append
   "identifier is already bound in this scope (If you didn't define it, "
   "it was defined by the PLAI language.)"))
(define-for-syntax type-case:generic
  (string-append
   "syntax error in type-case; search the Help Desk for `type-case' for "
   "assistance."))
(define-for-syntax define-type:duplicate-variant
  "this identifier has already been used")
(define-for-syntax type-case:not-a-type
  "this must be a type defined with define-type")
(define-for-syntax type-case:not-a-variant
  "this is not a variant of the specified type")
(define-for-syntax type-case:argument-count
  "this variant has ~a fields, but you provided bindings for ~a fields")
(define-for-syntax type-case:missing-variant
  "syntax error; probable cause: you did not include a case for the ~a variant, or no else-branch was present")
(define-for-syntax type-case:unreachable-else
  "the else branch of this type-case is unreachable; you have matched all variants")
(define-for-syntax define-type:zero-variants
  "you must specify a sequence of variants after the type, ~a")

(define-for-syntax ((assert-unbound stx-symbol) id-stx)
  (when (identifier-binding id-stx)
    (plai-syntax-error stx-symbol id-stx bound-id)))

(define-for-syntax (assert-unique variant-stx)
  (let ([dup-id (check-duplicate-identifier (syntax->list variant-stx))])
    (when dup-id
      (plai-syntax-error 'define-type dup-id
                         define-type:duplicate-variant))))

(define-for-syntax type-symbol (gensym))

(define-for-syntax (validate-and-remove-type-symbol stx-loc lst)
  (if (and (list? lst) (eq? type-symbol (first lst)))
    (rest lst)
    (plai-syntax-error 'type-case stx-loc type-case:not-a-type)))

(require (for-syntax syntax/parse
                     syntax/stx
                     racket/string
                     racket/match
                     (only-in racket/function curry)))

(begin-for-syntax
  (define SRBS null)
  (define (CLEAR-SRBS!)
    (set! SRBS null))
  (define (GRAB-SRBS)
    SRBS)

  (define (format-id lctx fmt #:source src . v)
    (define-values
      (fmt+vs-strs final-make-srbs)
      (let loop ([l (string->list fmt)]
                 [v v]
                 [here 0]
                 [ss empty]
                 [make-srbs (λ () null)])
        (match l
          [(list* #\~ #\a more)
           (define first-v (first v))
           (define first-s (format "~a" (syntax->datum first-v)))
           (define first-len (string-length first-s))
           (loop more (rest v) (+ here first-len)
                 (cons first-s ss)
                 (if (syntax-source first-v)
                   (λ ()
                     (cons (vector (syntax-local-introduce this-id)
                                   here first-len
                                   (syntax-local-introduce first-v)
                                   0 first-len)
                           (make-srbs)))
                   make-srbs))]
          [(list* other more)
           (loop more v (+ here 1)
                 (cons (string other) ss)
                 make-srbs)]
          [(list)
           (values (reverse ss) make-srbs)])))
    (define fmt+vs-str
      (string-append* fmt+vs-strs))
    (define fmt+vs-sym
      (string->symbol fmt+vs-str))
    (define this-id
      (datum->syntax lctx fmt+vs-sym src))
    (define srbs
      (final-make-srbs))
    (printf "~v -> ~v\n"
            this-id srbs)<commit_msg>Fix PR 14614 without printf<commit_after>#lang racket/base
(require (for-syntax racket/base
                     racket/list)
         racket/list
         racket/contract
         racket/undefined)

(provide define-type type-case)

(define-for-syntax (plai-syntax-error id stx-loc format-string . args)
  (raise-syntax-error
   id (apply format (cons format-string args)) stx-loc))

(define bug:fallthru-no-else
  (string-append
   "You have encountered a bug in the PLAI code.  (Error: type-case "
   "fallthru on cond without an else clause.)"))
(define-for-syntax bound-id
  (string-append
   "identifier is already bound in this scope (If you didn't define it, "
   "it was defined by the PLAI language.)"))
(define-for-syntax type-case:generic
  (string-append
   "syntax error in type-case; search the Help Desk for `type-case' for "
   "assistance."))
(define-for-syntax define-type:duplicate-variant
  "this identifier has already been used")
(define-for-syntax type-case:not-a-type
  "this must be a type defined with define-type")
(define-for-syntax type-case:not-a-variant
  "this is not a variant of the specified type")
(define-for-syntax type-case:argument-count
  "this variant has ~a fields, but you provided bindings for ~a fields")
(define-for-syntax type-case:missing-variant
  "syntax error; probable cause: you did not include a case for the ~a variant, or no else-branch was present")
(define-for-syntax type-case:unreachable-else
  "the else branch of this type-case is unreachable; you have matched all variants")
(define-for-syntax define-type:zero-variants
  "you must specify a sequence of variants after the type, ~a")

(define-for-syntax ((assert-unbound stx-symbol) id-stx)
  (when (identifier-binding id-stx)
    (plai-syntax-error stx-symbol id-stx bound-id)))

(define-for-syntax (assert-unique variant-stx)
  (let ([dup-id (check-duplicate-identifier (syntax->list variant-stx))])
    (when dup-id
      (plai-syntax-error 'define-type dup-id
                         define-type:duplicate-variant))))

(define-for-syntax type-symbol (gensym))

(define-for-syntax (validate-and-remove-type-symbol stx-loc lst)
  (if (and (list? lst) (eq? type-symbol (first lst)))
    (rest lst)
    (plai-syntax-error 'type-case stx-loc type-case:not-a-type)))

(require (for-syntax syntax/parse
                     syntax/stx
                     racket/string
                     racket/match
                     (only-in racket/function curry)))

(begin-for-syntax
  (define SRBS null)
  (define (CLEAR-SRBS!)
    (set! SRBS null))
  (define (GRAB-SRBS)
    SRBS)

  (define (format-id lctx fmt #:source src . v)
    (define-values
      (fmt+vs-strs final-make-srbs)
      (let loop ([l (string->list fmt)]
                 [v v]
                 [here 0]
                 [ss empty]
                 [make-srbs (λ () null)])
        (match l
          [(list* #\~ #\a more)
           (define first-v (first v))
           (define first-s (format "~a" (syntax->datum first-v)))
           (define first-len (string-length first-s))
           (loop more (rest v) (+ here first-len)
                 (cons first-s ss)
                 (if (syntax-source first-v)
                   (λ ()
                     (cons (vector (syntax-local-introduce this-id)
                                   here first-len
                                   (syntax-local-introduce first-v)
                                   0 first-len)
                           (make-srbs)))
                   make-srbs))]
          [(list* other more)
           (loop more v (+ here 1)
                 (cons (string other) ss)
                 make-srbs)]
          [(list)
           (values (reverse ss) make-srbs)])))
    (define fmt+vs-str
      (string-append* fmt+vs-strs))
    (define fmt+vs-sym
      (string->symbol fmt+vs-str))
    (define this-id
      (datum->syntax lctx fmt+vs-sym src))
    (define srbs
      (final-make-srbs))
{'fraction_non_alphanumeric': 0.12369052126719676, 'fraction_numerical': 0.001388362993815474, 'mean_word_length': 2.0856697819314642, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 14, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6575447', 'n_tokens_mistral': 2572, 'n_tokens_neox': 2432, 'n_words': 700}