suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow cast in typed/racket/no-check.

Browse Source 
original commit: bf2768f2c5a28ff4940ae7e640894738af9f3686
This commit is contained in:
Vincent St-Amour 2013-02-05 16:33:49 -05:00
parent df3fafae8c
commit 163b3dc11e
2 changed files with 31 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-racket/succeed/cast-no-check.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang typed/racket/no-check
(cast 5 Number)
(cast 5 String)

51
collects/typed-racket/base-env/prims.rkt
View File

@ -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)