From 64a653696cba5f4c24a3b64caa8182e84891b04b Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sun, 6 Jul 2014 17:06:10 -0700
Subject: [PATCH] Add omit-define-syntaxes to secondary form of
 define-type-alias.

Closes PR 14505.
---
 .../typed-racket/base-env/prims.rkt           | 38 ++++++++++---------
 .../type-alias-omit-define-syntaxes.rkt       |  7 ++++
 2 files changed, 28 insertions(+), 17 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-alias-omit-define-syntaxes.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
index 257fc9d720..d4885c4c9e 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
@@ -519,21 +519,28 @@ This file defines two sorts of primitives. All of them are provided into any mod
      (syntax/loc stx
        ((plambda: (A ...) (bn ...) . body) e ...))]))
 
-;; Syntax classes for `define-type-alias`
-(begin-for-syntax
- (define-syntax-class type-alias-rest
-   #:literals (All)
-   #:attributes (args)
-   (pattern (All (arg:id ...) rest)
-            #:with args #'(arg ...))
-   (pattern type:expr #:with args #'#f)))
-
 (define-syntax (define-type-alias stx)
+  (define-syntax-class all-vars
+    #:literals (All)
+    #:attributes (poly-vars)
+    (pattern (All (arg:id ...) rest)
+             #:with poly-vars #'(arg ...))
+    (pattern type:expr #:with poly-vars #'#f))
+
+  (define-splicing-syntax-class omit-define-syntaxes
+    #:attributes (omit)
+    (pattern #:omit-define-syntaxes #:attr omit #t)
+    (pattern (~seq) #:attr omit #f))
+
+  (define-splicing-syntax-class type-alias-full
+     #:attributes (tname type poly-vars omit)
+     (pattern (~seq tname:id (~and type:expr :all-vars) :omit-define-syntaxes))
+     (pattern (~seq (tname:id arg:id ...) body:expr :omit-define-syntaxes)
+       #:with poly-vars #'(arg ...)
+       #:with type (syntax/loc #'body (All (arg ...) body))))
+
   (syntax-parse stx
-    [(_ tname:id rest:type-alias-rest
-        (~optional (~and omit #:omit-define-syntaxes)
-                   #:defaults
-                   ([omit #f])))
+    [(_ :type-alias-full)
      (define/with-syntax stx-err-fun
        #'(lambda (stx)
            (raise-syntax-error
@@ -546,10 +553,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
                (ignore #'(define-syntax tname stx-err-fun))
                #'(begin))
          #,(internal (syntax/loc stx
-                       (define-type-alias-internal tname rest
-                         rest.args))))]
-    [(_ (tname:id args:id ...) rest)
-     (syntax/loc stx (define-type-alias tname (All (args ...) rest)))]))
+                       (define-type-alias-internal tname type poly-vars))))]))
 
 (define-syntax (with-handlers: stx)
   (syntax-parse stx
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-alias-omit-define-syntaxes.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-alias-omit-define-syntaxes.rkt
new file mode 100644
index 0000000000..3f0aeac832
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-alias-omit-define-syntaxes.rkt
@@ -0,0 +1,7 @@
+#lang typed/racket
+(define-type (Type1 t) t #:omit-define-syntaxes)
+(define-type (Type1* t) t)
+(define-type Type2 (All (t) t) #:omit-define-syntaxes)
+(define-type Type2* (All (t) t))
+(define-type Type3 Symbol #:omit-define-syntaxes)
+(define-type Type3* Symbol)