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

Refactoring.

Browse Source 
original commit: 75efede59b26315cd0273427ca08a46a5b947d88
This commit is contained in:
Vincent St-Amour 2012-08-07 16:31:24 -04:00
parent 806c02c533
commit 7acddd1b92
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/typed-racket/core.rkt
View File

@ -55,25 +55,26 @@
#`(display #,(format "~a\n" (parse-type #'ty)))]
;; Prints the _entire_ type. May be quite large.
[(_ . ((~literal :print-type) e:expr))
#`(display #,(tc-setup #'stx #'e 'top-level expanded init tc-toplevel-form before type
(parameterize ([print-multi-line-case-> #t])
(format "~a\n"
(match type
[(tc-result1: t f o) t]
[(tc-results: t) (cons 'Values t)])))))]
(tc-setup #'stx #'e 'top-level expanded init tc-toplevel-form before type
#`(display
#,(parameterize ([print-multi-line-case-> #t])
(format "~a\n" (match type
[(tc-result1: t f o) t]
[(tc-results: t) (cons 'Values t)])))))]
;; given a function and input types, display the result type
[(_ . ((~literal :query-type/args) op:expr arg-type:expr ...))
(with-syntax ([(dummy-arg ...) (generate-temporaries #'(arg-type ...))])
#`(display #,(tc-setup #'stx
;; create a dummy function with the right argument types
#`(lambda #,(stx-map (lambda (a t)
(syntax-property a 'type-label t))
#'(dummy-arg ...) #'(arg-type ...))
(op dummy-arg ...))
'top-level expanded init tc-toplevel-form before type
(format "~a\n"
(match type
[(tc-result1: (and t (Function: _)) f o) t])))))]
(tc-setup #'stx
;; create a dummy function with the right argument types
#`(lambda #,(stx-map (lambda (a t)
(syntax-property a 'type-label t))
#'(dummy-arg ...) #'(arg-type ...))
(op dummy-arg ...))
'top-level expanded init tc-toplevel-form before type
#`(display
#,(format "~a\n"
(match type
[(tc-result1: (and t (Function: _)) f o) t])))))]
;; given a function and a desired return type, fill in the blanks
[(_ . ((~literal :query-type/result) op:expr desired-type:expr))
(let ([expected (parse-type #'desired-type)])