Use unstable/lazy-require to dynamically-load the compile-time of match.

collects/racket/match/define-forms.rkt

@@ -5,8 +5,11 @@
                      (only-in racket/list append* remove-duplicates)
                      unstable/sequence
                      syntax/parse
-                     "patterns.rkt"
+                     unstable/lazy-require))
-                     "gen-match.rkt"))
+
+(begin-for-syntax
+ (lazy-require [racket/match/patterns (bound-vars)]
+               [racket/match/gen-match (go parse-id go/one)]))
 
 (provide define-forms)
 

collects/racket/match/match-expander.rkt

@@ -1,10 +1,26 @@
 #lang racket/base
 
-(require (for-syntax racket/base
+(require (for-syntax racket/base "stxtime.rkt"))
-                     "patterns.rkt"))
 
 (provide define-match-expander)
 
+(begin-for-syntax
+  (define make-match-expander
+    (let ()
+      (define-struct match-expander (match-xform legacy-xform macro-xform)
+        #:property prop:set!-transformer 
+        (λ (me stx)
+          (define xf (match-expander-macro-xform me))
+          (if (set!-transformer? xf)
+              ((set!-transformer-procedure xf) stx)
+              (syntax-case stx (set!)
+                [(set! . _)
+                 (raise-syntax-error #f "cannot mutate syntax identifier" stx)]
+                [_ (xf stx)])))
+        #:property prop:match-expander (struct-field-index match-xform)
+        #:property prop:legacy-match-expander (struct-field-index legacy-xform))
+      (values make-match-expander))))
+
 (define-syntax (define-match-expander stx)
   (define (lookup v alist)
     (cond [(assoc v alist) => cadr]

collects/racket/match/match.rkt

@@ -6,11 +6,15 @@
          (only-in "match-expander.rkt"
                   define-match-expander)
          "define-forms.rkt"
-         "struct.rkt"         
+         "struct.rkt"
-         (for-syntax "parse.rkt"
+         (for-syntax unstable/lazy-require
-                     (only-in "patterns.rkt" 
+                     (only-in "stxtime.rkt"
                               match-...-nesting
-                              prop:match-expander prop:legacy-match-expander)))
+                              prop:match-expander
+                              prop:legacy-match-expander)))
+
+(begin-for-syntax
+  (lazy-require [racket/match/parse (parse)]))
 
 (provide (for-syntax match-...-nesting
                      prop:match-expander prop:legacy-match-expander)
@@ -22,4 +26,5 @@
 (define-forms parse
   match match* match-lambda match-lambda* match-lambda** match-let match-let*
   match-let-values match-let*-values
-  match-define match-define-values match-letrec match/values match/derived match*/derived)
+  match-define match-define-values match-letrec match/values
+  match/derived match*/derived)

collects/racket/match/patterns.rkt

@@ -2,9 +2,12 @@
 
 (require syntax/boundmap
          racket/contract
+         "stxtime.rkt"
          (for-syntax racket/base))
 
-(provide (except-out (all-defined-out)
+(provide (except-out (combine-out 
+                      (all-defined-out)
+                      (all-from-out "stxtime.rkt"))
                      struct-key-ht
                      get-key
                      (struct-out Row)))
@@ -176,8 +179,6 @@
     [(Exact? p) null]
     [else (error 'match "bad pattern: ~a" p)]))
 
-(define match-...-nesting (make-parameter 0))
-
 (define current-renaming (make-parameter (make-free-identifier-mapping)))
 
 (define (copy-mapping ht)
@@ -208,45 +209,3 @@
                                [vars-seen (listof (cons/c identifier?
                                                           identifier?))])))
 
-
-(struct acc-prop (n acc))
-(define (make-struct-type-property/accessor name [guard #f] [supers null])
-  (define-values (p pred? acc)
-    (make-struct-type-property name
-     (λ (pval sinfo)
-	(cond [(exact-nonnegative-integer? pval)
-	       (acc-prop pval (cadddr sinfo))]
-	      [else (if (procedure? guard) 
-			(guard pval sinfo)
-			pval)]))
-     supers))
-  (values p pred? (lambda (v)
-		    (define v* (acc v))
-		    (if (acc-prop? v*)
-			((acc-prop-acc v*) v (acc-prop-n v*))
-			v*))))
-
-(define-values (prop:match-expander match-expander? match-expander-proc) 
-  (make-struct-type-property/accessor 'prop:match-expander))
-
-(define-values (prop:legacy-match-expander legacy-match-expander? legacy-match-expander-proc)
-  (make-struct-type-property/accessor 'prop:legacy-match-expander ))
-
-(define make-match-expander
-  (let ()
-    (define-struct match-expander (match-xform legacy-xform macro-xform)
-      #:property prop:set!-transformer (lambda (me stx)
-                                         (define xf (match-expander-macro-xform me))
-                                         (if (set!-transformer? xf)
-                                             ((set!-transformer-procedure xf) stx)
-                                             (syntax-case stx (set!)
-                                               [(set! . _)
-                                                (raise-syntax-error #f "cannot mutate syntax identifier" stx)]
-                                               [_ (xf stx)])))
-      #:property prop:match-expander (struct-field-index match-xform)
-      #:property prop:legacy-match-expander (struct-field-index legacy-xform))
-    (values make-match-expander)))
-
-(provide match-expander? legacy-match-expander?
-         match-expander-proc legacy-match-expander-proc
-         prop:match-expander prop:legacy-match-expander)

collects/racket/match/struct.rkt

@@ -2,7 +2,7 @@
 (require racket/match/match-expander
          (for-syntax racket/base
                      racket/struct-info
-                     syntax/boundmap
+                     syntax/id-table
                      racket/list))
 
 (define-match-expander
@@ -17,7 +17,7 @@
               [v (if (identifier? #'struct-name)
                      (syntax-local-value #'struct-name fail)
                      (fail))]
-              [field-acc->pattern (make-free-identifier-mapping)])
+              [field-acc->pattern (make-free-id-table)])
          (unless (struct-info? v) (fail))
          ; Check each pattern and capture the field-accessor name
          (for-each (lambda (an)
@@ -34,9 +34,9 @@
                                                        (syntax-e #'struct-name)
                                                        (syntax-e #'field)))
                                               #'field)])
-                          (when (free-identifier-mapping-get field-acc->pattern field-acc (lambda () #f))
+                          (when (free-id-table-ref field-acc->pattern field-acc #f)
                             (raise-syntax-error 'struct* "Field name appears twice" stx #'field)) 
-                          (free-identifier-mapping-put! field-acc->pattern field-acc #'pat))]
+                          (free-id-table-set! field-acc->pattern field-acc #'pat))]
                        [_
                         (raise-syntax-error
                          'struct* "expected a field pattern of the form (<field-id> <pat>)"
@@ -54,14 +54,13 @@
                 [pats-in-order
                  (for/list ([field-acc (in-list acc)])
                    (begin0
-                     (free-identifier-mapping-get
+                     (free-id-table-ref
                       field-acc->pattern field-acc
-                      (lambda () (syntax/loc stx _)))
+                      (syntax/loc stx _))
                      ; Use up pattern
-                     (free-identifier-mapping-put!
+                     (free-id-table-remove! field-acc->pattern field-acc)))])
-                      field-acc->pattern field-acc #f)))])
            ; Check that all patterns were used
-           (free-identifier-mapping-for-each
+           (free-id-table-for-each
             field-acc->pattern
             (lambda (field-acc pat)
               (when pat

collects/racket/match/stxtime.rkt

@@ -0,0 +1,29 @@
+#lang racket/base
+
+(provide (all-defined-out))
+
+(define match-...-nesting (make-parameter 0))
+
+(struct acc-prop (n acc))
+
+(define (make-struct-type-property/accessor name [guard #f] [supers null])
+  (define-values (p pred? acc)
+    (make-struct-type-property name
+     (λ (pval sinfo)
+	(cond [(exact-nonnegative-integer? pval)
+	       (acc-prop pval (cadddr sinfo))]
+	      [else (if (procedure? guard) 
+			(guard pval sinfo)
+			pval)]))
+     supers))
+  (values p pred? (lambda (v)
+		    (define v* (acc v))
+		    (if (acc-prop? v*)
+			((acc-prop-acc v*) v (acc-prop-n v*))
+			v*))))
+
+(define-values (prop:match-expander match-expander? match-expander-proc) 
+  (make-struct-type-property/accessor 'prop:match-expander))
+
+(define-values (prop:legacy-match-expander legacy-match-expander? legacy-match-expander-proc)
+  (make-struct-type-property/accessor 'prop:legacy-match-expander ))