Move syntax class code into internal forms.

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/internal-forms.rkt

@@ -1,8 +1,27 @@
 #lang racket/base
 
-(require (for-syntax racket/base)
+(require
-	 syntax/parse)
+  syntax/parse
+  (for-syntax racket/base racket/syntax
+              syntax/parse syntax/parse/experimental/template)
+  (for-template racket/base))
 
+(provide
+  type-alias
+  type-refinement
+  typed-struct
+  typed-struct/exec
+  typed-require
+  typed-require/struct
+  predicate-assertion
+  type-declaration
+  failed-typecheck
+
+  type-alias?
+  typed-struct?
+  typed-struct/exec?)
+
+;; Forms
 (define-syntax-rule (internal-forms set-name nms ...)
   (begin
     (provide nms ... set-name)
@@ -20,3 +39,78 @@
  :-internal
  typecheck-fail-internal)
 
+
+
+;;; Helpers
+
+(define-splicing-syntax-class dtsi-fields
+ #:attributes (mutable type-only maker)
+ (pattern
+  (~seq
+    (~or (~optional (~and #:mutable (~bind (mutable #t))))
+         (~optional (~and #:type-only (~bind (type-only #t))))
+         (~optional (~seq #:maker maker))) ...)))
+
+(define-syntax-class struct-name
+ (pattern nm:id)
+ (pattern (nm:id parent:id)))
+
+
+(define-syntax-class define-typed-struct-body
+  #:attributes (name mutable type-only maker nm (tvars 1) (fields 1) (types 1))
+  (pattern ((~optional (tvars:id ...) #:defaults (((tvars 1) null)))
+            nm:struct-name ([fields:id : types:expr] ...) options:dtsi-fields)
+           #:attr name #'nm.nm
+           #:attr mutable (attribute options.mutable)
+           #:attr type-only (attribute options.type-only)
+           #:attr maker (or (attribute options.maker) #'nm.nm)))
+
+;;; Internal form syntax matching
+
+
+(define-syntax-class internal
+   #:attributes (value)
+   #:literals (values)
+   #:literal-sets (kernel-literals)
+   (pattern (define-values () (begin (quote-syntax value:expr) (#%plain-app values)))))
+
+(define-syntax (define-internal-classes stx)
+  (define-syntax-class clause
+    (pattern [name:id (lit:id . body:expr)]
+     #:with pred (format-id #'name "~a?" #'name)))
+
+  (syntax-parse stx
+    [(_ :clause ...)
+     (template
+       (begin
+         (begin
+           (define-syntax-class name
+             #:auto-nested-attributes
+             #:literal-sets ((internal-literals #:at name))
+             (pattern i:internal #:with (lit . body) #'i.value))
+           (define pred
+             (syntax-parser
+               [(~var _ name) #t]
+               [_ #f]))) ...))]))
+
+
+(define-internal-classes
+  [type-alias
+    (define-type-alias-internal name type)]
+  [type-refinement
+    (declare-refinement-internal predicate)]
+  [typed-struct
+    (define-typed-struct-internal . :define-typed-struct-body)]
+  [typed-struct/exec
+    (define-typed-struct/exec-internal nm ([fields:id : types] ...) proc-type)]
+  [typed-require
+    (require/typed-internal name type)]
+  [typed-require/struct
+    (require/typed-internal name type #:struct-maker parent)]
+  [predicate-assertion
+    (assert-predicate-internal type predicate)]
+  [type-declaration
+    (:-internal id:identifier type)]
+  [failed-typecheck
+    (typecheck-fail-internal stx message:str var:id)])
+

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt

@@ -8,12 +8,13 @@
          (types utils abbrev union subtype type-table)
          (private-in parse-type type-annotation syntax-properties)
          (rep type-rep filter-rep object-rep)
-         (utils tc-utils syntax-classes)
+         (utils tc-utils)
          (env lexical-env tvar-env index-env)
          racket/private/class-internal
          syntax/parse syntax/stx
          unstable/syntax
          (only-in srfi/1 split-at)
+         (typecheck internal-forms)
          (for-template (only-in '#%paramz [parameterization-key pz:pk])))
 
 (require (for-template racket/base racket/private/class-internal))

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt

@@ -7,9 +7,8 @@
          (private type-annotation parse-type syntax-properties)
          (env lexical-env type-alias-env global-env type-env-structs scoped-tvar-env)
          (rep type-rep filter-rep)
-         (utils syntax-classes)
          syntax/free-vars
-         (typecheck signatures tc-metafunctions tc-subst)
+         (typecheck signatures tc-metafunctions tc-subst internal-forms)
          racket/match (contract-req)
          syntax/parse syntax/stx
          (for-template racket/base))

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt

@@ -9,8 +9,8 @@
          (private parse-type syntax-properties)
          (types abbrev utils resolve substitute type-table struct-table)
          (env global-env type-name-env tvar-env)
-         (utils tc-utils syntax-classes)
+         (utils tc-utils)
-         (typecheck def-binding)
+         (typecheck def-binding internal-forms)
          (for-syntax syntax/parse racket/base)
          (for-template racket/base))
 

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt

@@ -9,8 +9,9 @@
          (private parse-type type-annotation type-contract syntax-properties)
          (env global-env init-envs type-name-env type-alias-env
               lexical-env env-req mvar-env scoped-tvar-env)
-         (utils tc-utils syntax-classes)
+         (utils tc-utils)
-         (typecheck provide-handling def-binding tc-structs typechecker)
+         (typecheck provide-handling def-binding tc-structs
+                    typechecker internal-forms)
 
          syntax/location
 

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/syntax-classes.rkt

@@ -1,97 +0,0 @@
-#lang racket/base
-
-(require
-  (only-in "utils.rkt" typecheck)
-  syntax/parse
-  (for-syntax racket/base racket/syntax
-              syntax/parse syntax/parse/experimental/template)
-  (only-in (typecheck internal-forms) internal-literals)
-  (for-template racket/base))
-(provide
-  type-alias
-  type-refinement
-  typed-struct
-  typed-struct/exec
-  typed-require
-  typed-require/struct
-  predicate-assertion
-  type-declaration
-  failed-typecheck
-
-  type-alias?
-  typed-struct?
-  typed-struct/exec?
-  )
-
-;;; Helpers
-
-(define-splicing-syntax-class dtsi-fields
- #:attributes (mutable type-only maker)
- (pattern
-  (~seq
-    (~or (~optional (~and #:mutable (~bind (mutable #t))))
-         (~optional (~and #:type-only (~bind (type-only #t))))
-         (~optional (~seq #:maker maker))) ...)))
-
-(define-syntax-class struct-name
- (pattern nm:id)
- (pattern (nm:id parent:id)))
-
-
-(define-syntax-class define-typed-struct-body
-  #:attributes (name mutable type-only maker nm (tvars 1) (fields 1) (types 1))
-  (pattern ((~optional (tvars:id ...) #:defaults (((tvars 1) null)))
-            nm:struct-name ([fields:id : types:expr] ...) options:dtsi-fields)
-           #:attr name #'nm.nm
-           #:attr mutable (attribute options.mutable)
-           #:attr type-only (attribute options.type-only)
-           #:attr maker (or (attribute options.maker) #'nm.nm)))
-
-;;; Internal form syntax matching
-
-
-(define-syntax-class internal
-   #:attributes (value)
-   #:literals (values)
-   #:literal-sets (kernel-literals)
-   (pattern (define-values () (begin (quote-syntax value:expr) (#%plain-app values)))))
-
-(define-syntax (define-internal-classes stx)
-  (define-syntax-class clause
-    (pattern [name:id (lit:id . body:expr)]
-     #:with pred (format-id #'name "~a?" #'name)))
-
-  (syntax-parse stx
-    [(_ :clause ...)
-     (template
-       (begin
-         (begin
-           (define-syntax-class name
-             #:auto-nested-attributes
-             #:literal-sets ((internal-literals #:at name))
-             (pattern i:internal #:with (lit . body) #'i.value))
-           (define pred
-             (syntax-parser
-               [(~var _ name) #t]
-               [_ #f]))) ...))]))
-
-
-(define-internal-classes
-  [type-alias
-    (define-type-alias-internal name type)]
-  [type-refinement
-    (declare-refinement-internal predicate)]
-  [typed-struct
-    (define-typed-struct-internal . :define-typed-struct-body)]
-  [typed-struct/exec
-    (define-typed-struct/exec-internal nm ([fields:id : types] ...) proc-type)]
-  [typed-require
-    (require/typed-internal name type)]
-  [typed-require/struct
-    (require/typed-internal name type #:struct-maker parent)]
-  [predicate-assertion
-    (assert-predicate-internal type predicate)]
-  [type-declaration
-    (:-internal id:identifier type)]
-  [failed-typecheck
-    (typecheck-fail-internal stx message:str var:id)])