<commit_before>#lang racket/unit


(require (rename-in "../utils/utils.rkt" [private private-in])
         racket/match (prefix-in - (contract-req))
         "signatures.rkt"
         "check-below.rkt" "tc-app-helper.rkt" "../types/kw-types.rkt"
         (types utils abbrev union subtype type-table classes filter-ops)
         (private-in parse-type type-annotation syntax-properties)
         (rep type-rep filter-rep object-rep)
         (utils tc-utils)
         (env lexical-env tvar-env index-env)
         racket/format racket/list
         racket/private/class-internal
         syntax/parse syntax/stx
         unstable/syntax
         (only-in racket/list split-at)
         (typecheck internal-forms tc-envops)
         ;; Needed for current implementation of typechecking letrec-syntax+values
         (for-template (only-in racket/base letrec-values))

         (for-label (only-in '#%paramz [parameterization-key pz:pk])
                    (only-in racket/private/class-internal find-method/who)))

(import tc-if^ tc-lambda^ tc-app^ tc-let^ tc-send^ check-subforms^ tc-literal^
        check-class^)
(export tc-expr^)

(define-literal-set tc-expr-literals #:for-label
  (find-method/who))

;; do-inst : syntax type -> type
;; Perform a type instantiation, delegating to the appropriate helper
;; function depending on if the argument is a row or not
(define (do-inst stx ty)
  (define inst (type-inst-property stx))
  (if (row-syntax? inst)
      (do-row-inst stx inst ty)
      (do-normal-inst stx inst ty)))

;; row-syntax? Syntax -> Boolean
;; This checks if the syntax object resulted from a row instantiation
(define (row-syntax? stx)
  (define lst (stx->list stx))
  (and lst (pair? lst)
       (eq? (syntax-e (car lst)) '#:row)))

;; do-normal-inst : Syntax Syntax Type -> Type
;; Instantiate a normal polymorphic type
(define (do-normal-inst stx inst ty)
  (define (split-last l)
    (let-values ([(all-but last-list) (split-at l (sub1 (length l)))])
      (values all-but (car last-list))))
  (define (in-improper-stx stx)
    (let loop ([l stx])
      (match l
        [#f null]
        [(cons a b) (cons a (loop b))]
        [e (list e)])))
  (match ty
    [(list ty)
     (list
      (for/fold ([ty ty])
        ([inst (in-list (in-improper-stx inst))])
        (cond [(not inst) ty]
              [(not (or (Poly? ty) (PolyDots? ty)))
               (tc-error/expr #:return (Un) "Cannot instantiate non-polymorphic type ~a"
                              (cleanup-type ty))]
              [(and (Poly? ty)
                    (not (= (syntax-length inst) (Poly-n ty))))
               (tc-error/expr #:return (Un)
                              "Wrong number of type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
                              (cleanup-type ty) (Poly-n ty) (syntax-length inst))]
              [(and (PolyDots? ty) (not (>= (syntax-length inst) (sub1 (PolyDots-n ty)))))
               ;; we can provide 0 arguments for the ... var
               (tc-error/expr #:return (Un)
                              "Wrong number of type arguments to polymorphic type ~a:\nexpected at least: ~a\ngot: ~a"
                              (cleanup-type ty) (sub1 (PolyDots-n ty)) (syntax-length inst))]
              [(PolyDots? ty)
               ;; In this case, we need to check the last thing.  If it's a dotted var, then we need to
               ;; use instantiate-poly-dotted, otherwise we do the normal thing.
               ;; In the case that the list is empty we also do the normal thing
               (let ((stx-list (syntax->list inst)))
                 (if (null? stx-list)
                     (instantiate-poly ty (map parse-type stx-list))
                     (let-values ([(all-but-last last-stx) (split-last stx-list)])
                       (match (syntax-e last-stx)
                         [(cons last-ty-stx (? identifier? last-id-stx))
                          (unless (bound-index? (syntax-e last-id-stx))
                            (tc-error/stx last-id-stx "~a is not a type variable bound with ..." (syntax-e last-id-stx)))
                          (if (= (length all-but-last) (sub1 (PolyDots-n ty)))
                              (let* ([last-id (syntax-e last-id-stx)]
                                     [last-ty (extend-tvars (list last-id) (parse-type last-ty-stx))])
                                (instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id))
                              (tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
                                             ty (sub1 (PolyDots-n ty)) (length all-but-last)))]
                         [_
                          (instantiate-poly ty (map parse-type stx-list))]))))]
              [else
               (instantiate-poly ty (stx-map parse-type inst))])))]
    [_ (if inst
           (tc-error/expr #:return (Un)
                          "Cannot instantiate expression that produces ~a values"
                          (if (null? ty) 0 "multiple"))
           ty)]))

;; do-row-inst : Syntax ClassRow Type -> Type
;; Instantiate a row polymorphic function
(define (do-row-inst stx row-stx ty)
  ;; At this point, we know `stx` represents a row so we can parse it.
  ;; The parsing is done here because if `inst` did the parsing, it's<commit_msg>Remove extraneous old feature of do-inst.<commit_after>#lang racket/unit


(require (rename-in "../utils/utils.rkt" [private private-in])
         racket/match (prefix-in - (contract-req))
         "signatures.rkt"
         "check-below.rkt" "tc-app-helper.rkt" "../types/kw-types.rkt"
         (types utils abbrev union subtype type-table classes filter-ops)
         (private-in parse-type type-annotation syntax-properties)
         (rep type-rep filter-rep object-rep)
         (utils tc-utils)
         (env lexical-env tvar-env index-env)
         racket/format racket/list
         racket/private/class-internal
         syntax/parse syntax/stx
         unstable/syntax
         (only-in racket/list split-at)
         (typecheck internal-forms tc-envops)
         ;; Needed for current implementation of typechecking letrec-syntax+values
         (for-template (only-in racket/base letrec-values))

         (for-label (only-in '#%paramz [parameterization-key pz:pk])
                    (only-in racket/private/class-internal find-method/who)))

(import tc-if^ tc-lambda^ tc-app^ tc-let^ tc-send^ check-subforms^ tc-literal^
        check-class^)
(export tc-expr^)

(define-literal-set tc-expr-literals #:for-label
  (find-method/who))

;; do-inst : syntax type -> type
;; Perform a type instantiation, delegating to the appropriate helper
;; function depending on if the argument is a row or not
(define (do-inst stx ty)
  (define inst (type-inst-property stx))
  (if (row-syntax? inst)
      (do-row-inst stx inst ty)
      (do-normal-inst stx inst ty)))

;; row-syntax? Syntax -> Boolean
;; This checks if the syntax object resulted from a row instantiation
(define (row-syntax? stx)
  (define lst (stx->list stx))
  (and lst (pair? lst)
       (eq? (syntax-e (car lst)) '#:row)))

;; do-normal-inst : Syntax (Option Syntax) Type -> Type
;; Instantiate a normal polymorphic type
(define (do-normal-inst stx inst ty)
  (define (split-last l)
    (let-values ([(all-but last-list) (split-at l (sub1 (length l)))])
      (values all-but (car last-list))))
  (match ty
    [(list ty)
     (list
       (cond
         [(not inst) ty]
         [(not (or (Poly? ty) (PolyDots? ty)))
          (tc-error/expr #:return (Un) "Cannot instantiate non-polymorphic type ~a"
                         (cleanup-type ty))]
         [(and (Poly? ty)
               (not (= (syntax-length inst) (Poly-n ty))))
          (tc-error/expr #:return (Un)
                         "Wrong number of type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
                         (cleanup-type ty) (Poly-n ty) (syntax-length inst))]
         [(and (PolyDots? ty) (not (>= (syntax-length inst) (sub1 (PolyDots-n ty)))))
          ;; we can provide 0 arguments for the ... var
          (tc-error/expr #:return (Un)
                         "Wrong number of type arguments to polymorphic type ~a:\nexpected at least: ~a\ngot: ~a"
                         (cleanup-type ty) (sub1 (PolyDots-n ty)) (syntax-length inst))]
         [(PolyDots? ty)
          ;; In this case, we need to check the last thing.  If it's a dotted var, then we need to
          ;; use instantiate-poly-dotted, otherwise we do the normal thing.
          ;; In the case that the list is empty we also do the normal thing
          (let ((stx-list (syntax->list inst)))
            (if (null? stx-list)
                (instantiate-poly ty (map parse-type stx-list))
                (let-values ([(all-but-last last-stx) (split-last stx-list)])
                  (match (syntax-e last-stx)
                    [(cons last-ty-stx (? identifier? last-id-stx))
                     (unless (bound-index? (syntax-e last-id-stx))
                       (tc-error/stx last-id-stx "~a is not a type variable bound with ..." (syntax-e last-id-stx)))
                     (if (= (length all-but-last) (sub1 (PolyDots-n ty)))
                         (let* ([last-id (syntax-e last-id-stx)]
                                [last-ty (extend-tvars (list last-id) (parse-type last-ty-stx))])
                           (instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id))
                         (tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
                                        ty (sub1 (PolyDots-n ty)) (length all-but-last)))]
                    [_
                     (instantiate-poly ty (map parse-type stx-list))]))))]
         [else
          (instantiate-poly ty (stx-map parse-type inst))]))]
    [_ (if inst
           (tc-error/expr #:return (Un)
                          "Cannot instantiate expression that produces ~a values"
                          (if (null? ty) 0 "multiple"))
           ty)]))

;; do-row-inst : Syntax ClassRow Type -> Type
;; Instantiate a row polymorphic function
(define (do-row-inst stx row-stx ty)
  ;; At this point, we know `stx` represents a row so we can parse it.
  ;; The parsing is done here because if `inst` did the parsing, it's
{'fraction_non_alphanumeric': 0.13240518482957273, 'fraction_numerical': 0.0013442150744119058, 'mean_word_length': 1.894941634241245, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 17, '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': '3838525', 'n_tokens_mistral': 3330, 'n_tokens_neox': 3140, 'n_words': 987}