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

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/typed-scheme/base-env/prims.rkt
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" "../env/type-name-env.rkt"
"../private/type-contract.rkt" "../private/type-contract.rkt"
"for-clauses.rkt" "for-clauses.rkt"
"../tc-setup.rkt"
"../typecheck/tc-toplevel.rkt" "../typecheck/tc-toplevel.rkt"
"../typecheck/tc-app-helper.rkt"
"../types/utils.rkt") "../types/utils.rkt")
"../types/numeric-predicates.rkt") "../types/numeric-predicates.rkt")
(provide index?) ; useful for assert, and racket doesn't have it (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 (syntax-parse stx
[(_ e:expr) [(_ e:expr)
#`(display #,(format "~a\n" #`(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 (match type
[(tc-result1: t f o) t] [(tc-result1: t f o) t]
[(tc-results: t) (cons 'Values 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 (require/opaque-type stx)
(define-syntax-class name-exists-kw (define-syntax-class name-exists-kw
(pattern #:name-exists)) (pattern #:name-exists))

6
collects/typed-scheme/scribblings/reference/experimental.scrbl
View File

@ -13,7 +13,11 @@ These features are currently experimental and subject to change.
@defform[(:type t)]{Prints the type @racket[_t].} @defform[(:type t)]{Prints the type @racket[_t].}
@defform[(:print-type e)]{Prints the type of @racket[_e]. This prints the whole @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 @defform[(declare-refinement id)]{Declares @racket[id] to be usable in
refinement types.} refinement types.}

4
collects/typed-scheme/typecheck/tc-app-helper.rkt
View File

@ -273,11 +273,11 @@
(reverse parts-acc))))))))))) (reverse parts-acc)))))))))))
;; Wrapper over possible-domains that works on types. ;; Wrapper over possible-domains that works on types.
(define (cleanup-type t) (define (cleanup-type t [expected #f])
(match t (match t
;; function type, prune if possible. ;; function type, prune if possible.
[(Function: (list (arr: doms rngs rests drests kws) ...)) [(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 (let ([res (make-Function (map make-arr
pdoms rngs rests drests (make-list (length pdoms) null)))]) pdoms rngs rests drests (make-list (length pdoms) null)))])
res))] res))]