syntax/parse: eliminate old minimatch struct syntaxes

collects/syntax/parse/private/minimatch.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 (require unstable/struct
          (for-syntax racket/base racket/struct-info unstable/struct))
-(provide match make ?)
+(provide match ?)
 
 (define-syntax (match stx)
   (syntax-case stx ()
@@ -25,7 +25,7 @@
 
 ;; (match-p id Pattern SuccessExpr FailureExpr)
 (define-syntax (match-p stx)
-  (syntax-case stx (quote cons list vector make struct ?)
+  (syntax-case stx (quote cons list vector STRUCT ?)
     [(match-p x wildcard success failure)
      (and (identifier? #'wildcard) (free-identifier=? #'wildcard #'_))
      #'success]
@@ -51,9 +51,7 @@
     [(match-p x var success failure)
      (identifier? #'var)
      #'(let ([var x]) success)]
-    [(match-p x (make S p ...) success failure)
+    [(match-p x (STRUCT S (p ...)) success failure)
-     #'(match-p x (struct S (p ...)) success failure)]
-    [(match-p x (struct S (p ...)) success failure)
      (identifier? #'S)
      (let ()
        (define (not-a-struct)
@@ -79,7 +77,7 @@
     [(match-p x (S p ...) success failure)
      (identifier? #'S)
      (if (struct-info? (syntax-local-value #'S (lambda () #f)))
-         #'(match-p x (struct S (p ...)) success failure)
+         #'(match-p x (STRUCT S (p ...)) success failure)
          (raise-syntax-error #f "bad minimatch form" stx #'S))]
     [(match-p x s success failure)
      (prefab-struct-key (syntax-e #'s))
@@ -99,11 +97,8 @@
     [(match-p* ((x1 p1) . rest) success failure)
      (match-p x1 p1 (match-p* rest success failure) failure)]))
 
-#;
-(define-syntax struct
-  (lambda (stx)
-    (raise-syntax-error #f "illegal use of keyword" stx)))
-
 (define-syntax ?
   (lambda (stx)
     (raise-syntax-error #f "illegal use of minimatch form '?'" stx)))
+
+(define-syntax STRUCT #f) ;; internal keyword

collects/syntax/parse/private/rep-data.rkt

@@ -5,6 +5,7 @@
          syntax/private/id-table
          racket/syntax
          syntax/parse/private/residual-ct ;; keep abs. path
+         unstable/struct
          "minimatch.rkt"
          "kws.rkt"
          "rep-attrs.rkt"
@@ -126,23 +127,23 @@ expressions are duplicated, and may be evaluated in different scopes.
   ;; So blame-declare? only applies to stxclass declares
   (let ([val (declenv-lookup env id #:use-conventions? #f)])
     (match val
-      [(struct den:lit (_i _e _ip _lp))
+      [(den:lit _i _e _ip _lp)
        (wrong-syntax id "identifier previously declared as literal")]
-      [(struct den:magic-class (name _c _a _r))
+      [(den:magic-class name _c _a _r)
        (if (and blame-declare? stxclass-name)
            (wrong-syntax name
                          "identifier previously declared with syntax class ~a"
                          stxclass-name)
            (wrong-syntax (if blame-declare? name id)
                          "identifier previously declared"))]
-      [(struct den:class (name _c _a))
+      [(den:class name _c _a)
        (if (and blame-declare? stxclass-name)
            (wrong-syntax name
                          "identifier previously declared with syntax class ~a"
                          stxclass-name)
            (wrong-syntax (if blame-declare? name id)
                          "identifier previously declared"))]
-      [(struct den:parser (_p _a _sp _c _dc?))
+      [(den:parser _p _a _sp _c _dc?)
        (wrong-syntax id "(internal error) late unbound check")]
       ['#f (void)])))
 

collects/syntax/parse/private/rep.rkt

@@ -258,11 +258,11 @@
 ;; FIXME: replace with txlift mechanism
 (define (create-aux-def entry)
   (match entry
-    [(struct den:lit (_i _e _ip _lp))
+    [(den:lit _i _e _ip _lp)
      (values entry null)]
-    [(struct den:magic-class (name class argu role))
+    [(den:magic-class name class argu role)
      (values entry null)]
-    [(struct den:class (name class argu))
+    [(den:class name class argu)
      ;; FIXME: integrable syntax classes?
      (cond [(identifier? name)
             (let* ([pos-count (length (arguments-pargs argu))]
@@ -283,9 +283,9 @@
               (values (make den:delayed #'parser class)
                       (list #`(define-values (parser)
                                 (curried-stxclass-parser #,class #,argu)))))])]
-    [(struct den:parser (_p _a _sp _c _dc?))
+    [(den:parser _p _a _sp _c _dc?)
      (values entry null)]
-    [(struct den:delayed (_p _c))
+    [(den:delayed _p _c)
      (values entry null)]))
 
 (define (append-lits+litsets lits litsets)
@@ -361,18 +361,18 @@
     (create-action:and
      (for/list ([side (in-list sides)])
        (match side
-         [(make clause:fail condition message)
+         [(clause:fail condition message)
           (create-action:post
            (create-action:fail condition message))]
-         [(make clause:with wpat expr defs)
+         [(clause:with wpat expr defs)
           (let ([ap (create-action:post
                      (create-action:parse wpat expr))])
             (if (pair? defs)
                 (create-action:and (list (create-action:do defs) ap))
                 ap))]
-         [(make clause:attr attr expr)
+         [(clause:attr attr expr)
           (create-action:bind (list side))]
-         [(make clause:do stmts)
+         [(clause:do stmts)
           (create-action:do stmts)]))))
   (define dummy-pattern
     (and (pair? sides)
@@ -607,18 +607,18 @@
 (define (parse-pat:id id decls allow-head?)
   (define entry (declenv-lookup decls id))
   (match entry
-    [(struct den:lit (internal literal input-phase lit-phase))
+    [(den:lit internal literal input-phase lit-phase)
      (create-pat:literal literal input-phase lit-phase)]
-    [(struct den:magic-class (name class argu role))
+    [(den:magic-class name class argu role)
      (let* ([pos-count (length (arguments-pargs argu))]
             [kws (arguments-kws argu)]
             [sc (get-stxclass/check-arity class class pos-count kws)])
        (parse-pat:var* id allow-head? id sc argu "." role #f))]
-    [(struct den:class (_n _c _a))
+    [(den:class _n _c _a)
      (error 'parse-pat:id
             "(internal error) decls had leftover stxclass entry: ~s"
             entry)]
-    [(struct den:parser (parser attrs splicing? commit? delimit-cut?))
+    [(den:parser parser attrs splicing? commit? delimit-cut?)
      (check-no-delimit-cut-in-not id delimit-cut?)
      (cond [splicing?
             (unless allow-head?
@@ -626,7 +626,7 @@
             (parse-pat:id/h id parser no-arguments attrs commit? "." #f)]
            [else
             (parse-pat:id/s id parser no-arguments attrs commit? "." #f)])]
-    [(struct den:delayed (parser class))
+    [(den:delayed parser class)
      (let ([sc (get-stxclass class)])
        (parse-pat:var* id allow-head? id sc no-arguments "." #f parser))]
     ['#f
@@ -994,15 +994,15 @@
 
 (define (check-list-pattern pattern stx)
   (match pattern
-    [(make pat:datum _base '())
+    [(pat:datum _base '())
      #t]
-    [(make pat:head _base _head tail)
+    [(pat:head _base _head tail)
      (check-list-pattern tail stx)]
-    [(make pat:action _base _action tail)
+    [(pat:action _base _action tail)
      (check-list-pattern tail stx)]
-    [(make pat:dots _base _head tail)
+    [(pat:dots _base _head tail)
      (check-list-pattern tail stx)]
-    [(make pat:pair _base _head tail)
+    [(pat:pair _base _head tail)
      (check-list-pattern tail stx)]
     [_
      (wrong-syntax stx "expected proper list pattern")]))