diff --git a/collects/typed-scheme/base-env/prims.rkt b/collects/typed-scheme/base-env/prims.rkt
index a67b1c6107..7b46524af4 100644
--- a/collects/typed-scheme/base-env/prims.rkt
+++ b/collects/typed-scheme/base-env/prims.rkt
@@ -51,7 +51,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
           "../env/type-name-env.rkt"
           "../private/type-contract.rkt"
           "for-clauses.rkt"
+          "../tc-setup.rkt"
           "../typecheck/tc-toplevel.rkt"
+          "../typecheck/tc-app-helper.rkt"
           "../types/utils.rkt")
          "../types/numeric-predicates.rkt")
 (provide index?) ; useful for assert, and racket doesn't have it
@@ -180,11 +182,22 @@ This file defines two sorts of primitives. All of them are provided into any mod
   (syntax-parse stx
     [(_ e:expr)
      #`(display #,(format "~a\n"
-                          (tc-setup #'e #'e 'top-level expanded tc-toplevel-form type
+                          (tc-setup #'stx #'e 'top-level expanded tc-toplevel-form type
                                     (match type
                                       [(tc-result1: t f o) t]
                                       [(tc-results: t) (cons 'Values t)]))))]))
 
+;; given a function and a desired return type, fill in the blanks
+(define-syntax (:query-result-type stx)
+  (syntax-parse stx
+    [(_ op:expr desired-type:expr)
+     (let ([expected (parse-type #'desired-type)])
+       (tc-setup #'stx #'op 'top-level expanded tc-toplevel-form type
+                 (match type
+                   [(tc-result1: (and t (Function: _)) f o)
+                    #`(display #,(format "~a\n" (cleanup-type t expected)))]
+                   [_ (error (format "~a: not a function" (syntax->datum #'op) ))])))]))
+
 (define-syntax (require/opaque-type stx)
   (define-syntax-class name-exists-kw
     (pattern #:name-exists))
diff --git a/collects/typed-scheme/scribblings/reference/experimental.scrbl b/collects/typed-scheme/scribblings/reference/experimental.scrbl
index 3fd5cf9f0f..66b04bab8f 100644
--- a/collects/typed-scheme/scribblings/reference/experimental.scrbl
+++ b/collects/typed-scheme/scribblings/reference/experimental.scrbl
@@ -13,7 +13,11 @@ These features are currently experimental and subject to change.
 @defform[(:type t)]{Prints the type @racket[_t].}
 
 @defform[(:print-type e)]{Prints the type of @racket[_e]. This prints the whole
-types, which can sometimes be quite large.}
+type, which can sometimes be quite large.}
+
+@defform[(:query-result-type f t)]{Given a function @racket[f] and a desired
+return type @racket[t], shows the arguments types @racket[f] should be given to
+return a value of type @racket[t].}
 
 @defform[(declare-refinement id)]{Declares @racket[id] to be usable in
 refinement types.}
diff --git a/collects/typed-scheme/typecheck/tc-app-helper.rkt b/collects/typed-scheme/typecheck/tc-app-helper.rkt
index 490a3bc502..da41e9174f 100644
--- a/collects/typed-scheme/typecheck/tc-app-helper.rkt
+++ b/collects/typed-scheme/typecheck/tc-app-helper.rkt
@@ -273,11 +273,11 @@
                                   (reverse parts-acc)))))))))))
 
 ;; Wrapper over possible-domains that works on types.
-(define (cleanup-type t)
+(define (cleanup-type t [expected #f])
   (match t
     ;; function type, prune if possible.
     [(Function: (list (arr: doms rngs rests drests kws) ...))
-     (let-values ([(pdoms rngs rests drests) (possible-domains doms rests drests rngs #f)])
+     (let-values ([(pdoms rngs rests drests) (possible-domains doms rests drests rngs (and expected (ret expected)))])
        (let ([res (make-Function (map make-arr
                                       pdoms rngs rests drests (make-list (length pdoms) null)))])
          res))]