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

handle define-new-subtype in earlier phase

Browse Source
This commit is contained in:
AlexKnauth 2015-07-30 23:15:34 -04:00
parent a97489cc80
commit 0c1d58a07b
2 changed files with 32 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -69,13 +69,7 @@
;; define-new-subtype
[form:new-subtype-def
;; (define-new-subtype-internal name (constructor rep-type) #:gen-id gen-id)
(define name (syntax-e (attribute form.name)))
(define sym (syntax-e (attribute form.gen-id)))
(define rep-ty (parse-type (attribute form.rep-type)))
(define new-ty (-Distinction name sym rep-ty))
(register-type (attribute form.constructor) (-> rep-ty new-ty))
(register-type-alias (attribute form.name) new-ty)
;; also handled by an earlier pass
(list)]
;; declare-refinement
@ -296,11 +290,12 @@
(define (type-check forms0)
(define forms (syntax->list forms0))
(do-time "before form splitting")
(define-values (type-aliases struct-defs stx-defs0 val-defs0 provs)
(define-values (type-aliases struct-defs new-subtype-defs stx-defs0 val-defs0 provs)
(filter-multiple
forms
type-alias?
(lambda (e) (or (typed-struct? e) (typed-struct/exec? e)))
new-subtype-def?
parse-syntax-def
parse-def
provide?))
@ -319,6 +314,8 @@
(for-each add-constant-variance! names type-vars))
(do-time "after adding type names")
(for-each handle-define-new-subtype new-subtype-defs)
(register-all-type-aliases type-alias-names type-alias-map)
(do-time "starting struct handling")
@ -559,3 +556,20 @@
(tc-toplevel/pass1.5 form)
(begin0 (tc-toplevel/pass2 form #f)
(report-all-errors))]))
;; handle-define-new-subtype : Syntax -> Void
(define (handle-define-new-subtype form)
(syntax-parse form
;; define-new-subtype
[form:new-subtype-def
;; (define-new-subtype-internal name (constructor rep-type) #:gen-id gen-id)
(define name (syntax-e (attribute form.name)))
(define sym (syntax-e (attribute form.gen-id)))
(define rep-ty (parse-type (attribute form.rep-type)))
(define new-ty (-Distinction name sym rep-ty))
(register-type (attribute form.constructor) (-> rep-ty new-ty))
(register-type-alias (attribute form.name) new-ty)
(void)]))

10
typed-racket-test/succeed/define-new-subtype.rkt
View File

@ -30,6 +30,16 @@
(define (radians->degrees x)
(degrees (rkt:radians->degrees x)))
(define-type Listof-Radians (Listof Radians))
(: map-sin : Listof-Radians -> (Listof Real))
(define (map-sin angles)
(map sin angles))
(: map-deg->rad : (Listof Degrees) -> (Listof Radians))
(define (map-deg->rad angles)
(map degrees->radians angles))
(void
(sin (asin 1/2))
)