From 0c1d58a07b4276575df283b5d6ac87e99c8832db Mon Sep 17 00:00:00 2001
From: AlexKnauth <alexander@knauth.org>
Date: Thu, 30 Jul 2015 23:15:34 -0400
Subject: [PATCH] handle define-new-subtype in earlier phase

---
 .../typed-racket/typecheck/tc-toplevel.rkt    | 30 ++++++++++++++-----
 .../succeed/define-new-subtype.rkt            | 10 +++++++
 2 files changed, 32 insertions(+), 8 deletions(-)

diff --git a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
index d2298a73..5985a79c 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
@@ -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)]))
+
diff --git a/typed-racket-test/succeed/define-new-subtype.rkt b/typed-racket-test/succeed/define-new-subtype.rkt
index 3bab1d6d..8fda33a5 100644
--- a/typed-racket-test/succeed/define-new-subtype.rkt
+++ b/typed-racket-test/succeed/define-new-subtype.rkt
@@ -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))
  )