Add a function to query how to get a given return type from a function.

This commit is contained in:
Vincent St-Amour 2011-07-20 14:39:09 -04:00
parent 51b98138d5
commit c0d0211ebb
3 changed files with 21 additions and 4 deletions

View File

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

View File

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

View File

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