<commit_before>#lang racket/base
(provide
  apply->subst
  substitute
  )

(require
  "term.rkt"
  gregr-misc/list
  gregr-misc/sugar
  racket/function
  racket/list
  racket/match
  )

(def (substitute-lift (subst bindings k) count)
  binding-count = (length bindings)
  drop-count = (min count binding-count)
  lift-count = (max 0 (- count binding-count))
  (subst (drop bindings drop-count) (+ k lift-count)))

(def (substitute-subst outer (subst inner-bindings inner-lift))
  bindings-prefix = (map (curry substitute-value outer) inner-bindings)
  (subst bindings-suffix lift) = (substitute-lift outer inner-lift)
  (subst (append bindings-prefix bindings-suffix) lift))

(def (substitute-var (subst bindings lift) idx)
  binding-count = (length bindings)
  (if (< idx binding-count)
    (list-ref bindings idx)
    (v-var (+ lift (- idx binding-count)))))

(define v0 (v-var 0))
(define sub-lift-1 (subst '() 1))

(define (substitute-value sub val)
  (match val
    ((v-pair l r)  (apply-map* v-pair (curry substitute-value sub) l r))
    ((v-var index) (substitute-var sub index))
    ((v-lam body)
     (lets (subst bindings lift) = (substitute-subst sub-lift-1 sub)
           (v-lam (t-subst (subst (list* v0 bindings) lift) body))))
    ((? value?)    val)))

(define (apply->subst proc arg)
  (match proc
    ((v-lam body)     (subst (list arg) 0) body)))

(define (substitute sub tm)
  (define sub-value (curry substitute-value sub))
  (match tm
    ((t-subst inner tm) (t-subst (substitute-subst sub inner) tm))
    ((t-value val)      (t-value (sub-value val)))
    ((t-unpair idx pr)  (apply-map* t-unpair sub-value idx pr))
    ((t-apply proc arg) (apply-map* t-apply (curry t-subst sub) proc arg))))<commit_msg>Replace apply->subst with subst-single<commit_after>#lang racket/base
(provide
  subst-single
  substitute
  )

(require
  "term.rkt"
  gregr-misc/list
  gregr-misc/sugar
  racket/function
  racket/list
  racket/match
  )

(def (substitute-lift (subst bindings k) count)
  binding-count = (length bindings)
  drop-count = (min count binding-count)
  lift-count = (max 0 (- count binding-count))
  (subst (drop bindings drop-count) (+ k lift-count)))

(def (substitute-subst outer (subst inner-bindings inner-lift))
  bindings-prefix = (map (curry substitute-value outer) inner-bindings)
  (subst bindings-suffix lift) = (substitute-lift outer inner-lift)
  (subst (append bindings-prefix bindings-suffix) lift))

(def (substitute-var (subst bindings lift) idx)
  binding-count = (length bindings)
  (if (< idx binding-count)
    (list-ref bindings idx)
    (v-var (+ lift (- idx binding-count)))))

(define v0 (v-var 0))
(define sub-lift-1 (subst '() 1))
(define (subst-single arg) (subst (list arg) 0))

(define (substitute-value sub val)
  (match val
    ((v-pair l r)  (apply-map* v-pair (curry substitute-value sub) l r))
    ((v-var index) (substitute-var sub index))
    ((v-lam body)
     (lets (subst bindings lift) = (substitute-subst sub-lift-1 sub)
           (v-lam (t-subst (subst (list* v0 bindings) lift) body))))
    ((? value?)    val)))

(define (substitute sub tm)
  (define sub-value (curry substitute-value sub))
  (match tm
    ((t-subst inner tm) (t-subst (substitute-subst sub inner) tm))
    ((t-value val)      (t-value (sub-value val)))
    ((t-unpair idx pr)  (apply-map* t-unpair sub-value idx pr))
    ((t-apply proc arg) (apply-map* t-apply (curry t-subst sub) proc arg))))
{'fraction_non_alphanumeric': 0.1520979020979021, 'fraction_numerical': 0.004662004662004662, 'mean_word_length': 3.4125964010282774, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 6, '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': '90715', 'n_tokens_mistral': 1294, 'n_tokens_neox': 1231, 'n_words': 358}