Add tc-any-results as new result-type.

original commit: 05e53a0de5febe00d78c358f38a5c9aeb8e0df45
2013-01-19 14:49:20 -08:00 · 2013-01-19 14:49:20 -08:00 · 6e55c674d6
commit 6e55c674d6
parent ab06e489eb
17 changed files with 126 additions and 88 deletions
--- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
@ -1392,7 +1392,7 @@
        #;
        (tc-e (let: ((w : Will-Executor (make-will-executor)))
                (will-register w 'a (lambda: ((s : Symbol)) (void)))
-                (will-execute w)) ManyUniv)
+                (will-execute w)) #:ret tc-any-results)

        ;Promises
        ;For some reason they are failing in the test suite
--- a/collects/typed-racket/core.rkt
+++ b/collects/typed-racket/core.rkt
@ -102,6 +102,9 @@
                            ;; don't print results of type void
                            [(tc-result1: (== -Void type-equal?))
                             #f]
+                            ;; don't print results of unknown type
+                            [(tc-any-results:)
+                             #f]
                            [(tc-result1: t f o)
                             ;; Don't display the whole types at the REPL. Some case-lambda types
                             ;; are just too large to print.
--- a/collects/typed-racket/private/type-annotation.rkt
+++ b/collects/typed-racket/private/type-annotation.rkt
@ -103,13 +103,13 @@
 (define (get-types stxs #:default [default #f])
  (map (lambda (e) (get-type e #:default default)) stxs))

-;; list[identifier] stx (stx -> tc-results?) (stx tc-results? -> tc-results?) -> tc-results?
+;; list[identifier] stx (stx -> tc-results/c) (stx tc-results/c -> tc-results/c) -> tc-results/c
 ;; stxs : the identifiers, possibly with type annotations on them
 ;; expr : the RHS expression
 ;; tc-expr : a function like `tc-expr' from tc-expr-unit
 ;; tc-expr/check : a function like `tc-expr/check' from tc-expr-unit
 (define/cond-contract (get-type/infer stxs expr tc-expr tc-expr/check)
-  ((listof identifier?) syntax? (syntax? . -> . tc-results?) (syntax? tc-results? . -> . tc-results?) . -> . tc-results?)
+  ((listof identifier?) syntax? (syntax? . -> . tc-results/c) (syntax? tc-results/c . -> . tc-results/c) . -> . tc-results/c)
  (match stxs
    [(list stx ...)
     (let ([anns (for/list ([s stxs]) (type-annotation s #:infer #t))])
--- a/collects/typed-racket/rep/type-rep.rkt
+++ b/collects/typed-racket/rep/type-rep.rkt
@ -15,32 +15,6 @@

 (define name-table (make-weak-hasheq))

-(define Type/c?
-   (λ (e)
-     (and (Type? e)
-          (not (Scope? e))
-          (not (arr? e))
-          (not (fld? e))
-          (not (Values? e))
-          (not (ValuesDots? e))
-          (not (AnyValues? e))
-          (not (Result? e)))))
-
-;; (or/c Type/c Values? Results?)
-;; Anything that can be treated as a Values by sufficient expansion
-(define Values/c?
-   (λ (e)
-     (and (Type? e)
-          (not (Scope? e))
-          (not (arr? e))
-          (not (fld? e))
-          (not (ValuesDots? e))
-          (not (AnyValues? e)))))
-
-
-(define Type/c (flat-named-contract 'Type Type/c?))
-(define Values/c (flat-named-contract 'Values Values/c?))
-(define SomeValues/c (or/c Values? AnyValues? ValuesDots?))

 ;; Name = Symbol

@ -769,6 +743,32 @@

 ;(trace subst subst-all)

+(define Type/c?
+   (λ (e)
+     (and (Type? e)
+          (not (Scope? e))
+          (not (arr? e))
+          (not (fld? e))
+          (not (Values? e))
+          (not (ValuesDots? e))
+          (not (AnyValues? e))
+          (not (Result? e)))))
+
+;; (or/c Type/c Values? Results?)
+;; Anything that can be treated as a Values by sufficient expansion
+(define Values/c?
+   (λ (e)
+     (and (Type? e)
+          (not (Scope? e))
+          (not (arr? e))
+          (not (fld? e))
+          (not (ValuesDots? e))
+          (not (AnyValues? e)))))
+
+(define Type/c (flat-named-contract 'Type Type/c?))
+(define Values/c (flat-named-contract 'Values Values/c?))
+(define SomeValues/c (or/c Values? AnyValues? ValuesDots?))
+
 (provide
 Mu-name:
 Poly-names: Poly-fresh:
--- a/collects/typed-racket/typecheck/check-below.rkt
+++ b/collects/typed-racket/typecheck/check-below.rkt
@ -12,8 +12,8 @@
         (only-in srfi/1 split-at))

 (provide/cond-contract
- [check-below (-->d ([s (-or/c Type/c tc-results?)] [t (-or/c Type/c tc-results?)]) () [_ (if (Type/c s) Type/c tc-results?)])]
- [cond-check-below (-->d ([s (-or/c Type/c tc-results?)] [t (-or/c #f Type/c tc-results?)]) () [_ (if (Type/c s) Type/c tc-results?)])])
+ [check-below (-->d ([s (-or/c Type/c tc-results/c)] [t (-or/c Type/c tc-results/c)]) () [_ (if (Type? s) Type/c tc-results/c)])]
+ [cond-check-below (-->d ([s (-or/c Type/c tc-results/c)] [t (-or/c #f Type/c tc-results/c)]) () [_ (if (Type? s) Type/c tc-results/c)])])

 (define (print-object o)
  (match o
@ -48,6 +48,7 @@
     (ret ts2)]
    [((tc-result1: (? (lambda (t) (type-equal? t (Un))))) _)
     expected]
+    [((or (tc-any-results:) (tc-results: _)) (tc-any-results:)) tr1]

    [((tc-results: ts fs os) (tc-results: ts2 (NoFilter:) (NoObject:)))
     (unless (= (length ts) (length ts2))
@ -106,6 +107,9 @@
     (unless (subtype t1 t2)
       (tc-error/expr "Expected ~a, but got ~a" t2 t1))
     (ret t2 f o)]
+
+
+    [((? Type/c? t1) (tc-any-results:)) t1]
    [((? Type/c? t1) (tc-result1: t2 (FilterSet: (list) (list)) (Empty:)))
     (unless (subtype t1 t2)
       (tc-error/expr "Expected ~a, but got ~a" t2 t1))
--- a/collects/typed-racket/typecheck/signatures.rkt
+++ b/collects/typed-racket/typecheck/signatures.rkt
@ -5,39 +5,39 @@
 (provide (all-defined-out))

 (define-signature tc-expr^
-  ([cond-contracted tc-expr (syntax? . -> . tc-results?)]
+  ([cond-contracted tc-expr (syntax? . -> . tc-results/c)]
   [cond-contracted tc-literal (->* (syntax?) ((or/c #f Type/c)) Type/c)]
-   [cond-contracted tc-expr/check (syntax? tc-results? . -> . tc-results?)]
-   [cond-contracted tc-expr/check/t (syntax? tc-results? . -> . Type/c)]
-   [cond-contracted tc-exprs ((listof syntax?) . -> . tc-results?)]
-   [cond-contracted tc-exprs/check ((listof syntax?) tc-results? . -> . tc-results?)]
+   [cond-contracted tc-expr/check (syntax? tc-results/c . -> . tc-results/c)]
+   [cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type/c)]
+   [cond-contracted tc-exprs ((listof syntax?) . -> . tc-results/c)]
+   [cond-contracted tc-exprs/check ((listof syntax?) tc-results/c . -> . tc-results/c)]
   [cond-contracted tc-expr/t (syntax? . -> . Type/c)]
-   [cond-contracted single-value ((syntax?) ((or/c tc-results? #f)) . ->* . tc-results?)]))
+   [cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . tc-results/c)]))

 (define-signature check-subforms^
  ([cond-contracted check-subforms/ignore (syntax? . -> . any)]
   [cond-contracted check-subforms/with-handlers (syntax? . -> . any)]
-   [cond-contracted check-subforms/with-handlers/check (syntax? tc-results? . -> . any)]))
+   [cond-contracted check-subforms/with-handlers/check (syntax? tc-results/c . -> . any)]))

 (define-signature tc-if^
-  ([cond-contracted tc/if-twoarm ((syntax? syntax? syntax?) (tc-results?) . ->* . tc-results?)]))
+  ([cond-contracted tc/if-twoarm ((syntax? syntax? syntax?) (tc-results/c) . ->* . tc-results/c)]))

 (define-signature tc-lambda^
-  ([cond-contracted tc/lambda (syntax? syntax? syntax? . -> . tc-results?)]
-   [cond-contracted tc/lambda/check (syntax? syntax? syntax? tc-results? . -> . tc-results?)]
-   [cond-contracted tc/rec-lambda/check (syntax? syntax? syntax? syntax? (listof Type/c) tc-results? . -> . tc-results?)]))
+  ([cond-contracted tc/lambda (syntax? syntax? syntax? . -> . tc-results/c)]
+   [cond-contracted tc/lambda/check (syntax? syntax? syntax? tc-results/c . -> . tc-results/c)]
+   [cond-contracted tc/rec-lambda/check (syntax? syntax? syntax? syntax? (listof Type/c) tc-results/c . -> . tc-results/c)]))

 (define-signature tc-app^
-  ([cond-contracted tc/app (syntax? . -> . tc-results?)]
-   [cond-contracted tc/app/check (syntax? tc-results? . -> . tc-results?)]
-   [cond-contracted tc/app-regular (syntax? (or/c tc-results? #f) . -> . tc-results?)]))
+  ([cond-contracted tc/app (syntax? . -> . tc-results/c)]
+   [cond-contracted tc/app/check (syntax? tc-results/c . -> . tc-results/c)]
+   [cond-contracted tc/app-regular (syntax? (or/c tc-results/c #f) . -> . tc-results/c)]))

 (define-signature tc-apply^
-  ([cond-contracted tc/apply (syntax? syntax? . -> . tc-results?)]))
+  ([cond-contracted tc/apply (syntax? syntax? . -> . tc-results/c)]))

 (define-signature tc-let^
-  ([cond-contracted tc/let-values ((syntax? syntax? syntax? syntax?) ((or/c #f tc-results?)) . ->* . tc-results?)]
-   [cond-contracted tc/letrec-values ((syntax? syntax? syntax? syntax?) ((or/c #f tc-results?)) . ->* . tc-results?)]))
+  ([cond-contracted tc/let-values ((syntax? syntax? syntax? syntax?) ((or/c #f tc-results/c)) . ->* . tc-results/c)]
+   [cond-contracted tc/letrec-values ((syntax? syntax? syntax? syntax?) ((or/c #f tc-results/c)) . ->* . tc-results/c)]))

 (define-signature tc-dots^
  ([cond-contracted tc/dots (syntax? . -> . (values Type/c symbol?))]))
--- a/collects/typed-racket/typecheck/tc-app-helper.rkt
+++ b/collects/typed-racket/typecheck/tc-app-helper.rkt
@ -12,19 +12,24 @@

 (provide (all-defined-out))

-;; syntax? syntax? arr? (listof tc-results?) (or/c #f tc-results) [boolean?] -> tc-results?
+;; syntax? syntax? arr? (listof tc-results/c) (or/c #f tc-results/c) [boolean?] -> tc-results/c
 (define/cond-contract (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t])
-  ((syntax? (c:and/c syntax? syntax->list) arr? (c:listof tc-results?) (c:or/c #f tc-results?)) (#:check boolean?) . c:->* . tc-results?)
+  ((syntax? (c:and/c syntax? syntax->list) arr? (c:listof tc-results/c) (c:or/c #f tc-results/c)) (#:check boolean?) . c:->* . tc-results/c)
  (match* (ftype0 argtys)
    ;; we check that all kw args are optional
-    [((arr: dom (Values: (and results (list (Result: t-r f-r o-r) ...))) rest #f (and kws (list (Keyword: _ _ #f) ...)))
+    [((arr: dom (and rng (or (AnyValues:) (Values: _))) rest #f (and kws (list (Keyword: _ _ #f) ...)))
      (list (tc-result1: t-a phi-a o-a) ...))
+
     (when check?
+       (define error-ret
+         (match rng
+          ((AnyValues:) tc-any-results)
+          ((Values: (list (Result: t-r _ _) ...)) (ret t-r))))
       (cond [(and (not rest) (not (= (length dom) (length t-a))))
-              (tc-error/expr #:return (ret t-r)
+              (tc-error/expr #:return error-ret
                             "Wrong number of arguments, expected ~a and got ~a" (length dom) (length t-a))]
             [(and rest (< (length t-a) (length dom)))
-              (tc-error/expr #:return (ret t-r)
+              (tc-error/expr #:return error-ret
                             "Wrong number of arguments, expected at least ~a and got ~a" (length dom) (length t-a))])
       (for ([dom-t (if rest (in-sequence-forever dom rest) (in-list dom))]
             [a (in-list (syntax->list args-stx))]
@ -39,11 +44,14 @@
                          [ta (in-sequence-forever (in-list t-a) (Un))])
                         (values (if (>= nm dom-count) (make-Empty) oa)
                                 ta))])
-         (define-values (t-r f-r o-r)
-           (for/lists (t-r f-r o-r)
-             ([r (in-list results)])
-             (open-Result r o-a t-a)))
-         (ret t-r f-r o-r)))]
+           (match rng
+            ((AnyValues:) tc-any-results)
+            ((Values: results)
+             (define-values (t-r f-r o-r)
+               (for/lists (t-r f-r o-r)
+                 ([r (in-list results)])
+                 (open-Result r o-a t-a)))
+             (ret t-r f-r o-r)))))]
    ;; this case should only match if the function type has mandatory keywords
    ;; but no keywords were provided in the application
    [((arr: _ _ _ _
@ -86,7 +94,7 @@
     (c:listof SomeValues/c) (c:listof tc-results?) (c:or/c #f Type/c) c:any/c)
    (#:expected (c:or/c #f tc-results?) #:return tc-results?
     #:msg-thunk (c:-> string? string?))
-    . c:->* . tc-results?)
+    . c:->* . tc-results/c)

  (define arguments-str
    (stringify-domain arg-tys
@ -198,7 +206,7 @@
      (ormap (lambda (x) (subtype x fun-ty))
             others))

-    ;; currently does not take advantage of multi-valued expected types
+    ;; currently does not take advantage of multi-valued or arbitrary-valued expected types,
    (define expected-ty (and expected (match expected [(tc-result1: t) t] [_ #f])))
    (define (returns-subtype-of-expected? fun-ty)
      (or (not expected)
@ -217,6 +225,7 @@
      (map (compose make-Function list make-arr)
           doms
           (map (match-lambda ; strip filters
+                 [(AnyValues:) ManyUniv]
                 [(Values: (list (Result: t _ _) ...))
                  (-values t)]
                 [(ValuesDots: (list (Result: t _ _) ...) _ _)
--- a/collects/typed-racket/typecheck/tc-app/tc-app-main.rkt
+++ b/collects/typed-racket/typecheck/tc-app/tc-app-main.rkt
@ -49,7 +49,7 @@
  tc/app-regular*)

 ;; the main dispatching function
-;; syntax tc-results? -> tc-results?
+;; syntax tc-results/c -> tc-results/c
 (define (tc/app/internal form expected)
  (syntax-parse form
    [(#%plain-app . (~var v (tc/app-special-cases expected)))
@ -80,7 +80,7 @@
 ;; syntax -> tc-results
 (define (tc/app form) (tc/app/internal form #f))

-;; syntax tc-results? -> tc-results?
+;; syntax tc-results/c -> tc-results/c
 (define (tc/app/check form expected)
    (define t (tc/app/internal form expected))
    (check-below t expected))
--- a/collects/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-racket/typecheck/tc-expr-unit.rkt
@ -188,7 +188,7 @@
 ;; the identifier has variable effect
 ;; tc-id : identifier -> tc-results
 (define/cond-contract (tc-id id)
-  (--> identifier? tc-results?)
+  (--> identifier? tc-results/c)
  (let* ([ty (lookup-type/lexical id)])
    (ret ty
         (make-FilterSet (-not-filter (-val #f) id)
@ -206,7 +206,7 @@
    [(tc-result1: t) t]))

 (define (tc-expr/check/type form expected)
-  #;(syntax? Type/c . -> . tc-results?)
+  #;(syntax? Type/c . -> . tc-results/c)
  (tc-expr/check form (ret expected)))

 (define (tc-expr/check form expected)
@ -273,7 +273,7 @@

 ;; tc-expr/check : syntax tc-results -> tc-results
 (define/cond-contract (tc-expr/check/internal form expected)
-  (--> syntax? tc-results? tc-results?)
+  (--> syntax? tc-results/c tc-results/c)
  (parameterize ([current-orig-stx form])
    ;(printf "form: ~a\n" (syntax-object->datum form))
    ;; the argument must be syntax
@ -511,6 +511,9 @@
                                                 (tc-expr/check form ann))]
                    [else (internal-tc-expr form)])])
      (match ty
+        [(tc-any-results:)
+         (add-typeof-expr form ty)
+         ty]
        [(tc-results: ts fs os)
         (let* ([ts* (do-inst form ts)]
                [r (ret ts* fs os)])
@ -518,7 +521,7 @@
           r)]))))

 (define/cond-contract (tc/send form rcvr method args [expected #f])
-  (-->* (syntax? syntax? syntax? syntax?) ((-or/c tc-results? #f)) tc-results?)
+  (-->* (syntax? syntax? syntax? syntax?) ((-or/c tc-results/c #f)) tc-results/c)
  (match (tc-expr rcvr)
    [(tc-result1: (Instance: (and c (Class: _ _ methods))))
     (match (tc-expr method)
--- a/collects/typed-racket/typecheck/tc-funapp.rkt
+++ b/collects/typed-racket/typecheck/tc-funapp.rkt
@ -43,9 +43,9 @@
                        #:expected expected))))]))

 (define/cond-contract (tc/funapp f-stx args-stx ftype0 argtys expected)
-  (syntax? (c:and/c syntax? syntax->list) tc-results? (c:listof tc-results?)
-           (c:or/c #f tc-results?)
-           . c:-> . tc-results?)
+  (syntax? (c:and/c syntax? syntax->list) tc-results/c (c:listof tc-results/c)
+           (c:or/c #f tc-results/c)
+           . c:-> . tc-results/c)
  (match* (ftype0 argtys)
    ;; we special-case this (no case-lambda) for improved error messages
    [((tc-result1: (and t (Function: (list (and a (arr: dom (Values: _)
--- a/collects/typed-racket/typecheck/tc-lambda-unit.rkt
+++ b/collects/typed-racket/typecheck/tc-lambda-unit.rkt
@ -25,7 +25,7 @@
                                         [kws (listof (list/c keyword? identifier? Type/c boolean?))]
                                         [rest (or/c #f (list/c identifier? Type/c))]
                                         [drest (or/c #f (cons/c identifier? (cons/c Type/c symbol?)))]
-                                         [body tc-results?])
+                                         [body tc-results/c])
  #:transparent)

 (define (lam-result->type lr)
@ -58,7 +58,8 @@
 ;; listof[id] option[id] block listof[type] option[type] option[(cons type var)] tc-result -> lam-result
 (define/cond-contract (check-clause arg-list rest body arg-tys rest-ty drest ret-ty)
     ((listof identifier?)
-      (or/c #f identifier?) syntax? (listof Type/c) (or/c #f Type/c) (or/c #f (cons/c Type/c symbol?)) tc-results?
+      (or/c #f identifier?) syntax? (listof Type/c) (or/c #f Type/c)
+      (or/c #f (cons/c Type/c symbol?)) tc-results/c
      . --> .
      lam-result?)
  (let* ([arg-len (length arg-list)]
@ -241,7 +242,7 @@
                (match (find-expected expected f*)
                  ;; very conservative -- only do anything interesting if we get exactly one thing that matches
                  [(list) 
-                   (if (and (= 1 (length formals*)) expected)
+                   (if (and (= 1 (length formals*)) (tc-results? expected))
                       (tc-error/expr #:return (list (lam-result null null (list #'here Univ) #f (ret (Un))))
                                      "Expected a function of type ~a, but got a function with the wrong arity"
                                      (match expected [(tc-result1: t) t]))
@ -280,9 +281,9 @@
 ;; tc/plambda syntax syntax-list syntax-list type -> Poly
 ;; formals and bodies must by syntax-lists
 (define/cond-contract (tc/plambda form formals bodies expected)
-  (syntax? syntax? syntax? (or/c tc-results? #f) . --> . Type/c)
+  (syntax? syntax? syntax? (or/c tc-results/c #f) . --> . Type/c)
  (define/cond-contract (maybe-loop form formals bodies expected)
-    (syntax? syntax? syntax? tc-results? . --> . Type/c)
+    (syntax? syntax? syntax? tc-results/c . --> . Type/c)
    (match expected
      [(tc-result1: (Function: _)) (tc/mono-lambda/type formals bodies expected)]
      [(tc-result1: (or (Poly: _ _) (PolyDots: _ _)))
@ -329,7 +330,7 @@
         (extend-tvars tvars
           (maybe-loop form formals bodies (ret expected*))))
       t)]
-    [#f
+    [(or (tc-any-results:) #f)
     (match (map syntax-e (syntax->list (plambda-prop form)))
       [(list tvars ... dotted-var '...)
        (let* ([ty (extend-indexes dotted-var
--- a/collects/typed-racket/typecheck/tc-let-unit.rkt
+++ b/collects/typed-racket/typecheck/tc-let-unit.rkt
@ -27,12 +27,12 @@
     (ret ts (for/list ([f ts]) (make-NoFilter)) (for/list ([f ts]) (make-NoObject)))]))

 (define/cond-contract (do-check expr->type namess results expected-results form exprs body clauses expected #:abstract [abstract null])
-     (((syntax? syntax? tc-results? . c:-> . any/c)
-       (listof (listof identifier?)) (listof tc-results?) (listof tc-results?)
-       syntax? (listof syntax?) syntax? (listof syntax?) (or/c #f tc-results?))
+     (((syntax? syntax? tc-results/c . c:-> . any/c)
+       (listof (listof identifier?)) (listof tc-results/c) (listof tc-results/c)
+       syntax? (listof syntax?) syntax? (listof syntax?) (or/c #f tc-results/c))
      (#:abstract any/c)
      . c:->* .
-      tc-results?)
+      tc-results/c)
     (with-cond-contract t/p ([types          (listof (listof Type/c))] ; types that may contain undefined (letrec)
                              [expected-types (listof (listof Type/c))] ; types that may not contain undefined (what we got from the user)
                              [props          (listof (listof Filter?))])
@ -77,6 +77,7 @@
                       (proc s nm (make-Empty) #t))))])
     (define (run res)
       (match res
+         [(tc-any-results:) res]
         [(tc-results: ts fs os)
          (ret (subber subst-type ts) (subber subst-filter-set fs) (subber subst-object os))]
         [(tc-results: ts fs os dt db)
--- a/collects/typed-racket/typecheck/tc-metafunctions.rkt
+++ b/collects/typed-racket/typecheck/tc-metafunctions.rkt
@ -16,6 +16,7 @@
     (tc-results? (listof identifier?) . -> . SomeValues/c)
     (define keys (for/list ([(nm k) (in-indexed arg-names)]) k))
     (match results
+       [(tc-any-results:) (make-AnyValues)]
       [(tc-results: ts fs os dty dbound)
        (make-ValuesDots
         (for/list ([t ts] [f fs] [o os])
--- a/collects/typed-racket/typecheck/tc-subst.rkt
+++ b/collects/typed-racket/typecheck/tc-subst.rkt
@ -145,10 +145,11 @@



-;; (or/c Values? ValuesDots?) listof[identifier] -> tc-results?
+;; SomeValues/c (or/c #f listof[identifier]) -> tc-results/c
 (define/cond-contract (values->tc-results tc formals)
-  ((or/c Values? ValuesDots?) (or/c #f (listof identifier?)) . -> . tc-results?)
+  (SomeValues/c (or/c #f (listof identifier?)) . -> . tc-results/c)
  (match tc
+    [(AnyValues:) tc-any-results]
    [(ValuesDots: (list (and rs (Result: ts fs os)) ...) dty dbound)
     (if formals
         (let-values ([(ts fs os)
--- a/collects/typed-racket/typecheck/tc-toplevel.rkt
+++ b/collects/typed-racket/typecheck/tc-toplevel.rkt
@ -416,7 +416,7 @@

 ;; typecheck a top-level form
 ;; used only from #%top-interaction
-;; syntax -> (values #f (or/c void? tc-results?))
+;; syntax -> (values #f (or/c void? tc-results/c))
 (define (tc-toplevel-form form)
  (tc-toplevel/pass1 form)
  (begin0 (values #f (tc-toplevel/pass2 form))
--- a/collects/typed-racket/types/tc-result.rkt
+++ b/collects/typed-racket/types/tc-result.rkt
@ -13,6 +13,12 @@
 (define-struct/cond-contract tc-results
  ([ts (listof tc-result?)] [drest (or/c (cons/c Type/c symbol?) #f)])
  #:transparent)
+(define-struct/cond-contract tc-any-results () #:transparent)
+(define tc-any-results* (tc-any-results))
+
+(define (tc-results/c v)
+  (or (tc-results? v)
+      (tc-any-results? v)))

 (define-match-expander tc-result:
  (syntax-rules ()
@ -31,6 +37,12 @@
    (struct tc-results ((list (struct tc-result (tp _ _)) (... ...))
                          #f))]))

+(define-match-expander tc-any-results:
+  (syntax-rules ()
+   [(_)
+    (struct tc-any-results ())]))
+
+
 (define-match-expander tc-result1:
  (syntax-rules ()
   [(_ tp fp op) (struct tc-results ((list (struct tc-result (tp fp op)))
@ -107,10 +119,13 @@

 (define tc-result-equal? equal?)

-(provide tc-result: tc-results: tc-result1: Result1: Results:)
+(provide tc-result: tc-results: tc-any-results: tc-result1: Result1: Results:
+         (rename-out
+           (tc-any-results* tc-any-results)))
 (provide/cond-contract
 [combine-results ((listof tc-results?) . -> . tc-results?)]
 [tc-result? (any/c . -> . boolean?)]
 [tc-result-t (tc-result? . -> . Type/c)]
 [tc-result-equal? (tc-result? tc-result? . -> . boolean?)]
- [tc-results? (any/c . -> . boolean?)])
+ [tc-results? (any/c . -> . boolean?)]
+ [tc-results/c flat-contract?])
--- a/collects/typed-racket/types/type-table.rkt
+++ b/collects/typed-racket/types/type-table.rkt
@ -101,10 +101,10 @@
    (values (mk 'tautology) (mk 'contradiction) (mk 'neither))))

 (provide/cond-contract
- [add-typeof-expr (syntax? tc-results? . -> . any)]
- [type-of (syntax? . -> . tc-results?)]
- [reset-type-table (-> any)]
- [add-struct-fn! (identifier? StructPE? boolean? . -> . any)]
+ [add-typeof-expr (syntax? tc-results/c . -> . any/c)]
+ [type-of (syntax? . -> . tc-results/c)]
+ [reset-type-table (-> any/c)]
+ [add-struct-fn! (identifier? StructPE? boolean? . -> . any/c)]
 [add-struct-constructor! (identifier? . -> . any)]
 [struct-constructor? (identifier? . -> . boolean?)]
 [struct-accessor? (identifier? . -> . (or/c #f StructPE?))]