From 163b3dc11e5fd887a5fbcdbfef4f54579d0eb940 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 5 Feb 2013 16:33:49 -0500
Subject: [PATCH] Allow cast in typed/racket/no-check.

original commit: bf2768f2c5a28ff4940ae7e640894738af9f3686
---
 .../typed-racket/succeed/cast-no-check.rkt    |  4 ++
 collects/typed-racket/base-env/prims.rkt      | 51 ++++++++++---------
 2 files changed, 31 insertions(+), 24 deletions(-)
 create mode 100644 collects/tests/typed-racket/succeed/cast-no-check.rkt

diff --git a/collects/tests/typed-racket/succeed/cast-no-check.rkt b/collects/tests/typed-racket/succeed/cast-no-check.rkt
new file mode 100644
index 00000000..d8b4bb3e
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/cast-no-check.rkt
@@ -0,0 +1,4 @@
+#lang typed/racket/no-check
+
+(cast 5 Number)
+(cast 5 String)
diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt
index 1dc141a0..9d1f514a 100644
--- a/collects/typed-racket/base-env/prims.rkt
+++ b/collects/typed-racket/base-env/prims.rkt
@@ -254,30 +254,33 @@ This file defines two sorts of primitives. All of them are provided into any mod
                    'typechecker:ignore-some #t)
              ty)))
 
-     (if (syntax-transforming-module-expression?)
-         (let ((ctc (syntax-local-lift-expression
-                       (syntax-property #'#f 'typechecker:contract-def #'ty))))
-           (define (check-valid-type _)
-             (define type (parse-type #'ty))
-             (define vars (fv type))
-             ;; If there was an error don't create another one
-             (unless (or (Error? type) (null? vars))
-               (tc-error/delayed
-                 "Type ~a could not be converted to a contract because it contains free variables."
-                 type)))
-             (syntax-property (apply-contract ctc)
-                              'typechecker:external-check check-valid-type))
-         (let ([typ (parse-type #'ty)])
-           (if (Error? typ)
-               ;; This code should never get run, typechecking will have an error earlier
-               #`(error 'cast "Couldn't parse type")
-               (apply-contract
-                 (type->contract
-                   typ
-                   ;; the value is not from the typed side
-                   #:typed-side #f
-                   (lambda ()
-                     (tc-error/stx #'ty "Type ~a could not be converted to a contract" typ)))))))]))
+     (cond [(not (unbox typed-context?)) ; no-check, don't check
+            #'v]
+           [(syntax-transforming-module-expression?)
+            (let ((ctc (syntax-local-lift-expression
+                        (syntax-property #'#f 'typechecker:contract-def #'ty))))
+              (define (check-valid-type _)
+                (define type (parse-type #'ty))
+                (define vars (fv type))
+                ;; If there was an error don't create another one
+                (unless (or (Error? type) (null? vars))
+                  (tc-error/delayed
+                   "Type ~a could not be converted to a contract because it contains free variables."
+                   type)))
+              (syntax-property (apply-contract ctc)
+                               'typechecker:external-check check-valid-type))]
+           [else
+            (let ([typ (parse-type #'ty)])
+              (if (Error? typ)
+                  ;; This code should never get run, typechecking will have an error earlier
+                  #`(error 'cast "Couldn't parse type")
+                  (apply-contract
+                   (type->contract
+                    typ
+                    ;; the value is not from the typed side
+                    #:typed-side #f
+                    (lambda ()
+                      (tc-error/stx #'ty "Type ~a could not be converted to a contract" typ))))))])]))
 
 
 (define-syntax (:type stx)