From 9efcc454332bed13e9b0b7a8f9566569a1934175 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 31 Aug 2011 12:18:12 -0400
Subject: [PATCH] Move interactive helpers away from prims.rkt.

original commit: 166efdd2ecd52c291d7f860d7117ec85cf39f707
---
 collects/typed-scheme/base-env/prims.rkt | 35 ++----------------------
 collects/typed-scheme/core.rkt           | 26 +++++++++++++++++-
 2 files changed, 28 insertions(+), 33 deletions(-)

diff --git a/collects/typed-scheme/base-env/prims.rkt b/collects/typed-scheme/base-env/prims.rkt
index 57ad6f50..e5762a38 100644
--- a/collects/typed-scheme/base-env/prims.rkt
+++ b/collects/typed-scheme/base-env/prims.rkt
@@ -37,7 +37,6 @@ This file defines two sorts of primitives. All of them are provided into any mod
          racket/flonum ; for for/flvector and for*/flvector
          mzlib/etc
          (for-syntax
-          racket/match
           syntax/parse
           racket/syntax
           racket/base
@@ -51,9 +50,6 @@ 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
@@ -173,36 +169,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
          #,(internal #'(require/typed-internal name (Any -> Boolean : ty))))]))
 
 (define-syntax (:type stx)
-  (syntax-parse stx
-    [(_ ty:expr)
-     #`(display #,(format "~a\n" (parse-type #'ty)))]))
-
-;; Prints the _entire_ type. May be quite large.
+  (error ":type is only valid at the top-level of an interaction"))
 (define-syntax (:print-type stx)
-  (syntax-parse stx
-    [(_ e:expr)
-     #`(display #,(format "~a\n"
-                          (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
+  (error ":print-type is only valid at the top-level of an interaction"))
 (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)
-                    (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) ))])))]))
+  (error ":query-result-type is only valid at the top-level of an interaction"))
 
 (define-syntax (require/opaque-type stx)
   (define-syntax-class name-exists-kw
diff --git a/collects/typed-scheme/core.rkt b/collects/typed-scheme/core.rkt
index deab5b85..a49ed44c 100644
--- a/collects/typed-scheme/core.rkt
+++ b/collects/typed-scheme/core.rkt
@@ -3,7 +3,7 @@
 (require (rename-in "utils/utils.rkt" [infer r:infer])
          (for-syntax racket/base)
          (for-template racket/base)
-         (private with-types type-contract)
+         (private with-types type-contract parse-type)
          (except-in syntax/parse id)
          racket/match racket/syntax unstable/match racket/list
          (types utils convenience)
@@ -11,6 +11,7 @@
          (env type-name-env type-alias-env)
          (r:infer infer)
          (rep type-rep)
+         (for-template (only-in (base-env prims) :type :print-type :query-result-type))
          (except-in (utils utils tc-utils arm) infer)
          (only-in (r:infer infer-dummy) infer-param)
          "tc-setup.rkt")
@@ -52,6 +53,29 @@
   (syntax-parse stx
     [(_ . ((~datum module) . rest))
      #'(module . rest)]
+    [(_ . ((~literal :type) ty:expr))
+     #`(display #,(format "~a\n" (parse-type #'ty)))]
+    ;; Prints the _entire_ type. May be quite large.
+    [(_ . ((~literal :print-type) e:expr))
+     #`(display #,(format "~a\n"
+                          (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
+    [(_ . ((~literal :query-result-type) 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)
+                    (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)
      (tc-setup
       stx #'form 'top-level body2 tc-toplevel-form type