<commit_before>#lang racket/base

(require
  "../utils/utils.rkt"
  (for-syntax
    racket/base
    racket/match
    racket/format
    racket/string
    racket/list
    syntax/stx
    syntax/parse
    "../tc-setup.rkt"
    (private parse-type syntax-properties)
    (types utils abbrev printer)
    (typecheck tc-toplevel tc-app-helper)
    (rep type-rep)
    (utils tc-utils)))
(provide
  (for-syntax
    interactive-command?
    interactive-command-procedure)

  :type :print-type :query-type/args :query-type/result)

(define-for-syntax (fail _ stx)
  (syntax-parse stx
    [_:id
     (raise-syntax-error #f "must be applied to arguments" stx)]
    [_ (raise-syntax-error #f "only valid at the top-level of an interaction" stx)]))

(begin-for-syntax
  (struct interactive-command (procedure)
    #:property prop:procedure fail))


(define-syntax :type
  (interactive-command
    (λ (stx init)
      (syntax-parse stx
        [(_ (~optional (~and #:verbose verbose-kw)) ty:expr)
         (parameterize ([current-print-type-fuel
                         (if (attribute verbose-kw) +inf.0 1)]
                        ;; This makes sure unions are totally flat for the
                        ;; infinite fuel case. If fuel that's not 0, 1, or +inf.0
                        ;; is ever used, more may need to be done.
                        [current-type-names
                         (if (attribute verbose-kw) '() (current-type-names))]
                        [current-print-unexpanded (box '())])
           (define type (format "~a" (parse-type #'ty)))
           (define unexpanded
             (remove-duplicates (unbox (current-print-unexpanded))))
           (define cue (if (null? unexpanded)
                           ""
                           (format "[can expand further: ~a]"
                                   (string-join (map ~a unexpanded)))))
           #`(display #,(format "~a\n~a" type cue)))]
        [form
         (raise-syntax-error #f "must be applied to exactly one argument" #'form)]))))

;; TODO what should be done with stx
;; Prints the _entire_ type. May be quite large.
(define-syntax :print-type
  (interactive-command
    (λ (stx init)
      (syntax-parse stx
        [(_ e)
         (tc-setup #'stx #'e 'top-level expanded init tc-toplevel-form before type
                   #`(display
                      #,(parameterize ([print-multi-line-case-> #t])
                          (format "~a\n" (match type
                                           [(tc-result1: t f o) t]
                                           [(tc-results: t) (-values t)]
                                           [(tc-any-results:) ManyUniv])))))]
        [form
         (raise-syntax-error #f "must be applied to exactly one argument" #'form)]))))

;; given a function and input types, display the result type
(define-syntax :query-type/args
  (interactive-command
    (λ (stx init)
      (syntax-parse stx
        [(_ op arg-type ...)
         (with-syntax ([(dummy-arg ...) (generate-temporaries #'(arg-type ...))])
            (tc-setup #'stx
                      ;; create a dummy function with the right argument types
                      #`(lambda #,(stx-map type-label-property
                                           #'(dummy-arg ...) #'(arg-type ...))
                          (op dummy-arg ...))
                      'top-level expanded init tc-toplevel-form before type
                      #`(display
                         #,(format "~a\n"
                                   (match type
                                     [(tc-result1: (and t (Function: _)) f o) t])))))]
        [form
         (raise-syntax-error #f "must be applied to at least one argument" #'form)]))))

;; given a function and a desired return type, fill in the blanks
(define-syntax :query-type/result
  (interactive-command
    (λ (stx init)
      (syntax-parse stx
        [(_ op desired-type)
         (let ([expected (parse-type #'desired-type)])
           (tc-setup #'stx #'op 'top-level expanded init tc-toplevel-form before type
                     (match type
                       [(tc-result1: (and t (Function: _)) f o)
                        (let ([cleaned (cleanup-type t expected)])
                          #`(display
                             #,(match cleaned
                                 [(Function: '())
                                  "Desired return type not in the given function's range."]
                                 [(Function: arrs)
                                  (format "~a\n" cleaned)])))]
                       [_ (error (format "~a: not a function" (syntax->datum #'op) ))])))]
        [form
         (raise-syntax-error #f "must be applied to exactly two arguments" #'form)]))))
<commit_msg>Use actual original syntax.<commit_after>#lang racket/base

(require
  "../utils/utils.rkt"
  (for-syntax
    racket/base
    racket/match
    racket/format
    racket/string
    racket/list
    syntax/stx
    syntax/parse
    "../tc-setup.rkt"
    (private parse-type syntax-properties)
    (types utils abbrev printer)
    (typecheck tc-toplevel tc-app-helper)
    (rep type-rep)
    (utils tc-utils)))
(provide
  (for-syntax
    interactive-command?
    interactive-command-procedure)

  :type :print-type :query-type/args :query-type/result)

(define-for-syntax (fail _ stx)
  (syntax-parse stx
    [_:id
     (raise-syntax-error #f "must be applied to arguments" stx)]
    [_ (raise-syntax-error #f "only valid at the top-level of an interaction" stx)]))

(begin-for-syntax
  (struct interactive-command (procedure)
    #:property prop:procedure fail))


(define-syntax :type
  (interactive-command
    (λ (stx init)
      (syntax-parse stx
        [(_ (~optional (~and #:verbose verbose-kw)) ty:expr)
         (parameterize ([current-print-type-fuel
                         (if (attribute verbose-kw) +inf.0 1)]
                        ;; This makes sure unions are totally flat for the
                        ;; infinite fuel case. If fuel that's not 0, 1, or +inf.0
                        ;; is ever used, more may need to be done.
                        [current-type-names
                         (if (attribute verbose-kw) '() (current-type-names))]
                        [current-print-unexpanded (box '())])
           (define type (format "~a" (parse-type #'ty)))
           (define unexpanded
             (remove-duplicates (unbox (current-print-unexpanded))))
           (define cue (if (null? unexpanded)
                           ""
                           (format "[can expand further: ~a]"
                                   (string-join (map ~a unexpanded)))))
           #`(display #,(format "~a\n~a" type cue)))]
        [form
         (raise-syntax-error #f "must be applied to exactly one argument" #'form)]))))

;; Prints the _entire_ type. May be quite large.
(define-syntax :print-type
  (interactive-command
    (λ (stx init)
      (syntax-parse stx
        [(_ e)
         (tc-setup stx #'e 'top-level expanded init tc-toplevel-form before type
                   #`(display
                      #,(parameterize ([print-multi-line-case-> #t])
                          (format "~a\n" (match type
                                           [(tc-result1: t f o) t]
                                           [(tc-results: t) (-values t)]
                                           [(tc-any-results:) ManyUniv])))))]
        [form
         (raise-syntax-error #f "must be applied to exactly one argument" #'form)]))))

;; given a function and input types, display the result type
(define-syntax :query-type/args
  (interactive-command
    (λ (stx init)
      (syntax-parse stx
        [(_ op arg-type ...)
         (with-syntax ([(dummy-arg ...) (generate-temporaries #'(arg-type ...))])
            (tc-setup stx
                      ;; create a dummy function with the right argument types
                      #`(lambda #,(stx-map type-label-property
                                           #'(dummy-arg ...) #'(arg-type ...))
                          (op dummy-arg ...))
                      'top-level expanded init tc-toplevel-form before type
                      #`(display
                         #,(format "~a\n"
                                   (match type
                                     [(tc-result1: (and t (Function: _)) f o) t])))))]
        [form
         (raise-syntax-error #f "must be applied to at least one argument" #'form)]))))

;; given a function and a desired return type, fill in the blanks
(define-syntax :query-type/result
  (interactive-command
    (λ (stx init)
      (syntax-parse stx
        [(_ op desired-type)
         (let ([expected (parse-type #'desired-type)])
           (tc-setup stx #'op 'top-level expanded init tc-toplevel-form before type
                     (match type
                       [(tc-result1: (and t (Function: _)) f o)
                        (let ([cleaned (cleanup-type t expected)])
                          #`(display
                             #,(match cleaned
                                 [(Function: '())
                                  "Desired return type not in the given function's range."]
                                 [(Function: arrs)
                                  (format "~a\n" cleaned)])))]
                       [_ (error (format "~a: not a function" (syntax->datum #'op) ))])))]
        [form
         (raise-syntax-error #f "must be applied to exactly two arguments" #'form)]))))

{'fraction_non_alphanumeric': 0.12824829037348764, 'fraction_numerical': 0.0016833245660178853, 'mean_word_length': 1.478748370273794, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 7, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 30, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5399428', 'n_tokens_mistral': 2760, 'n_tokens_neox': 2593, 'n_words': 764}