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

Move interactive helpers away from prims.rkt.

Browse Source 
original commit: 166efdd2ecd52c291d7f860d7117ec85cf39f707
This commit is contained in:
Vincent St-Amour 2011-08-31 12:18:12 -04:00
parent ce1fcd2b54
commit 9efcc45433
2 changed files with 28 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/typed-scheme/base-env/prims.rkt
View File

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

26
collects/typed-scheme/core.rkt
View File

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