Included upstream changes until 55dcdf553878f475fc4c59ba83556482d11499c9 (included)

parse.rkt

@@ -1,31 +1,10 @@
 #lang racket/base
-(require (for-syntax racket/base)
-         racket/contract/base
-         "parse/pre.rkt"
-         "parse/experimental/provide.rkt"
-         "parse/experimental/contract.rkt")
-(provide (except-out (all-from-out "parse/pre.rkt")
-                     static)
-         expr/c)
-(provide-syntax-class/contract
- [static (syntax-class/c [(-> any/c any/c) (or/c string? symbol? #f)])])
-
-(begin-for-syntax
-  (require racket/contract/base
-           syntax/parse/private/residual-ct)
-  (provide pattern-expander?
-           (contract-out
-            [pattern-expander
-             (-> (-> syntax? syntax?) pattern-expander?)]
-            [prop:pattern-expander
-             (struct-type-property/c (-> pattern-expander? (-> syntax? syntax?)))]
-            [syntax-local-syntax-parse-pattern-introduce
-             (-> syntax? syntax?)]))
-
-  (require (only-in (for-template syntax/parse) pattern-expander))
-  #;(define pattern-expander
-    (let ()
-      #;(struct pattern-expander (proc) #:transparent
-        #:omit-define-syntaxes
-        #:property prop:pattern-expander (λ (this) (pattern-expander-proc this)))
-      pattern-expander)))
+(#%require version-case
+           (for-syntax (only racket/base version)
+                       (only racket/base #%app #%datum))
+           stxparse-info/my-include)
+(version-case
+  [(version< (version) "7.3.0.1")
+    (my-include "parse.rkt-7-0-0-20")]
+  [else
+    (my-include "parse.rkt-7-3-0-1")])

parse.rkt-7-0-0-20

@@ -0,0 +1,31 @@
+#lang racket/base
+(require (for-syntax racket/base)
+         racket/contract/base
+         "parse/pre.rkt"
+         "parse/experimental/provide.rkt"
+         "parse/experimental/contract.rkt")
+(provide (except-out (all-from-out "parse/pre.rkt")
+                     static)
+         expr/c)
+(provide-syntax-class/contract
+ [static (syntax-class/c [(-> any/c any/c) (or/c string? symbol? #f)])])
+
+(begin-for-syntax
+  (require racket/contract/base
+           syntax/parse/private/residual-ct)
+  (provide pattern-expander?
+           (contract-out
+            [pattern-expander
+             (-> (-> syntax? syntax?) pattern-expander?)]
+            [prop:pattern-expander
+             (struct-type-property/c (-> pattern-expander? (-> syntax? syntax?)))]
+            [syntax-local-syntax-parse-pattern-introduce
+             (-> syntax? syntax?)]))
+
+  (require (only-in (for-template syntax/parse) pattern-expander))
+  #;(define pattern-expander
+    (let ()
+      #;(struct pattern-expander (proc) #:transparent
+        #:omit-define-syntaxes
+        #:property prop:pattern-expander (λ (this) (pattern-expander-proc this)))
+      pattern-expander)))

parse.rkt-7-3-0-1

@@ -0,0 +1,33 @@
+#lang racket/base
+(require (for-syntax racket/base)
+         racket/contract/base
+         "parse/pre.rkt"
+         "parse/experimental/provide.rkt"
+         "parse/experimental/contract.rkt")
+(provide (except-out (all-from-out "parse/pre.rkt")
+                     static)
+         expr/c)
+(provide-syntax-class/contract
+ [static (syntax-class/c [(-> any/c any/c) (or/c string? symbol? #f)])])
+
+(begin-for-syntax
+  (require racket/contract/base
+           syntax/parse/private/residual-ct)
+  (provide pattern-expander?
+           (contract-out
+            [prop:syntax-class
+             (struct-type-property/c (or/c identifier? (-> any/c identifier?)))]
+            [pattern-expander
+             (-> (-> syntax? syntax?) pattern-expander?)]
+            [prop:pattern-expander
+             (struct-type-property/c (-> pattern-expander? (-> syntax? syntax?)))]
+            [syntax-local-syntax-parse-pattern-introduce
+             (-> syntax? syntax?)]))
+
+  (require (only-in (for-template syntax/parse) pattern-expander))
+  #;(define pattern-expander
+    (let ()
+      #;(struct pattern-expander (proc) #:transparent
+        #:omit-define-syntaxes
+        #:property prop:pattern-expander (λ (this) (pattern-expander-proc this)))
+      pattern-expander)))

parse/debug.rkt

@@ -10,5 +10,7 @@
     (my-include "debug.rkt-6-12")]
   [(version< (version) "7.0.0.20")
     (my-include "debug.rkt-6-90-0-29")]
+  [(version< (version) "7.3.0.1")
+    (my-include "debug.rkt-7-0-0-20")]
   [else
-    (my-include "debug.rkt-7-0-0-20")])
+    (my-include "debug.rkt-7-3-0-1")])

parse/debug.rkt-7-3-0-1

@@ -0,0 +1,129 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     syntax/stx
+                     racket/syntax
+                     syntax/parse/private/rep-data
+                     "private/rep.rkt"
+                     syntax/parse/private/kws)
+         racket/list
+         racket/pretty
+         "../parse.rkt"
+         (except-in stxparse-info/parse/private/residual
+                    prop:syntax-class
+                    prop:pattern-expander
+                    syntax-local-syntax-parse-pattern-introduce)
+         "private/runtime.rkt"
+         "private/runtime-progress.rkt"
+         "private/runtime-report.rkt"
+         syntax/parse/private/kws)
+
+;; No lazy loading for this module's dependencies.
+
+(provide syntax-class-parse
+         syntax-class-attributes
+         syntax-class-arity
+         syntax-class-keywords
+
+         debug-rhs
+         debug-pattern
+         debug-parse
+         debug-syntax-parse!)
+
+(define-syntax (syntax-class-parse stx)
+  (syntax-case stx ()
+    [(_ s x arg ...)
+     (parameterize ((current-syntax-context stx))
+       (with-disappeared-uses
+        (let* ([argu (parse-argu (syntax->list #'(arg ...)) #:context stx)]
+               [stxclass
+                (get-stxclass/check-arity #'s stx
+                                          (length (arguments-pargs argu))
+                                          (arguments-kws argu))]
+               [attrs (stxclass-attrs stxclass)])
+          (with-syntax ([parser (stxclass-parser stxclass)]
+                        [argu argu]
+                        [(name ...) (map attr-name attrs)]
+                        [(depth ...) (map attr-depth attrs)])
+            #'(let ([fh (lambda (undos fs) fs)])
+                (app-argu parser x x (ps-empty x x) #f null fh fh #f
+                          (lambda (fh undos . attr-values)
+                            (map vector '(name ...) '(depth ...) attr-values))
+                          argu))))))]))
+
+(define-syntaxes (syntax-class-attributes
+                  syntax-class-arity
+                  syntax-class-keywords)
+  (let ()
+    (define ((mk handler) stx)
+      (syntax-case stx ()
+        [(_ s)
+         (parameterize ((current-syntax-context stx))
+           (with-disappeared-uses
+            (handler (get-stxclass #'s))))]))
+    (values (mk (lambda (s)
+                  (let ([attrs (stxclass-attrs s)])
+                    (with-syntax ([(a ...) (map attr-name attrs)]
+                                  [(d ...) (map attr-depth attrs)])
+                      #'(quote ((a d) ...))))))
+            (mk (lambda (s)
+                  (let ([a (stxclass-arity s)])
+                    #`(to-procedure-arity '#,(arity-minpos a) '#,(arity-maxpos a)))))
+            (mk (lambda (s)
+                  (let ([a (stxclass-arity s)])
+                    #`(values '#,(arity-minkws a) '#,(arity-maxkws a))))))))
+
+(define-syntax (debug-rhs stx)
+  (syntax-case stx ()
+    [(debug-rhs rhs)
+     (let ([rhs (parse-rhs #'rhs #f #:context stx)])
+       #`(quote #,rhs))]))
+
+(define-syntax (debug-pattern stx)
+  (syntax-case stx ()
+    [(debug-pattern p . rest)
+     (let-values ([(rest pattern defs)
+                   (parse-pattern+sides #'p #'rest
+                                        #:splicing? #f
+                                        #:decls (new-declenv null)
+                                        #:context stx)])
+       (unless (stx-null? rest)
+         (raise-syntax-error #f "unexpected terms" stx rest))
+       #`(quote ((definitions . #,defs)
+                 (pattern #,pattern))))]))
+
+(define-syntax-rule (debug-parse x p ...)
+  (let/ec escape
+    (parameterize ((current-failure-handler
+                    (lambda (_ fs)
+                      (define-values (raw-fs-sexpr maximal-fs-sexpr) (fs->sexprs fs))
+                      (escape
+                       `(parse-failure
+                         #:raw-failures
+                         ,raw-fs-sexpr
+                         #:maximal-failures
+                         ,maximal-fs-sexpr)))))
+      (syntax-parse x [p 'success] ...))))
+
+(define (fs->sexprs fs)
+  (let* ([raw-fs (map invert-failure (reverse (flatten fs)))]
+         [selected-groups (maximal-failures raw-fs)])
+    (values (failureset->sexpr raw-fs)
+            (let ([selected (map (lambda (fs)
+                                   (cons 'progress-class
+                                         (map failure->sexpr fs)))
+                                 selected-groups)])
+              (if (= (length selected) 1)
+                  (car selected)
+                  (cons 'union selected))))))
+
+(define (debug-syntax-parse!)
+  (define old-failure-handler (current-failure-handler))
+  (current-failure-handler
+   (lambda (ctx fs)
+     (define-values (raw-fs-sexpr maximal-fs-sexpr) (fs->sexprs fs))
+     (eprintf "*** syntax-parse debug info ***\n")
+     (eprintf "Raw failures:\n")
+     (pretty-write raw-fs-sexpr (current-error-port))
+     (eprintf "Maximal failures:\n")
+     (pretty-write maximal-fs-sexpr (current-error-port))
+     (old-failure-handler ctx fs))))

parse/experimental/contract.rkt

@@ -1,40 +1,10 @@
 #lang racket/base
-(require stxparse-info/parse/pre
-         "provide.rkt"
-         syntax/contract
-         (only-in stxparse-info/parse/private/residual ;; keep abs. path
-                  this-context-syntax
-                  this-role)
-         racket/contract/base)
-
-(define not-given (gensym))
-
-(define-syntax-class (expr/c ctc-stx
-                             #:positive [pos-blame 'use-site]
-                             #:negative [neg-blame 'from-macro]
-                             #:macro [macro-name #f]
-                             #:name [expr-name not-given]
-                             #:context [ctx #f])
-  #:attributes (c)
-  #:commit
-  (pattern y:expr
-           #:with
-           c (wrap-expr/c ctc-stx
-                          #'y
-                          #:positive pos-blame
-                          #:negative neg-blame
-                          #:name (if (eq? expr-name not-given)
-                                     this-role
-                                     expr-name)
-                          #:macro macro-name
-                          #:context (or ctx (this-context-syntax)))))
-
-(provide-syntax-class/contract
- [expr/c (syntax-class/c (syntax?)
-                         (#:positive (or/c syntax? string? module-path-index?
-                                           'from-macro 'use-site 'unknown)
-                          #:negative (or/c syntax? string? module-path-index?
-                                           'from-macro 'use-site 'unknown)
-                          #:name (or/c identifier? string? symbol? #f)
-                          #:macro (or/c identifier? string? symbol? #f)
-                          #:context (or/c syntax? #f)))])
+(#%require version-case
+           (for-syntax (only racket/base version)
+                       (only racket/base #%app #%datum))
+           stxparse-info/my-include)
+(version-case
+  [(version< (version) "7.3.0.1")
+    (my-include "contract.rkt-7-0-0-20")]
+  [else
+    (my-include "contract.rkt-7-3-0-1")])

parse/experimental/contract.rkt-7-0-0-20

@@ -0,0 +1,40 @@
+#lang racket/base
+(require stxparse-info/parse/pre
+         "provide.rkt"
+         syntax/contract
+         (only-in stxparse-info/parse/private/residual ;; keep abs. path
+                  this-context-syntax
+                  this-role)
+         racket/contract/base)
+
+(define not-given (gensym))
+
+(define-syntax-class (expr/c ctc-stx
+                             #:positive [pos-blame 'use-site]
+                             #:negative [neg-blame 'from-macro]
+                             #:macro [macro-name #f]
+                             #:name [expr-name not-given]
+                             #:context [ctx #f])
+  #:attributes (c)
+  #:commit
+  (pattern y:expr
+           #:with
+           c (wrap-expr/c ctc-stx
+                          #'y
+                          #:positive pos-blame
+                          #:negative neg-blame
+                          #:name (if (eq? expr-name not-given)
+                                     this-role
+                                     expr-name)
+                          #:macro macro-name
+                          #:context (or ctx (this-context-syntax)))))
+
+(provide-syntax-class/contract
+ [expr/c (syntax-class/c (syntax?)
+                         (#:positive (or/c syntax? string? module-path-index?
+                                           'from-macro 'use-site 'unknown)
+                          #:negative (or/c syntax? string? module-path-index?
+                                           'from-macro 'use-site 'unknown)
+                          #:name (or/c identifier? string? symbol? #f)
+                          #:macro (or/c identifier? string? symbol? #f)
+                          #:context (or/c syntax? #f)))])

parse/experimental/contract.rkt-7-3-0-1

@@ -0,0 +1,43 @@
+#lang racket/base
+(require stxparse-info/parse/pre
+         "provide.rkt"
+         syntax/contract
+         (only-in stxparse-info/parse/private/residual ;; keep abs. path
+                  this-context-syntax
+                  this-role)
+         racket/contract/base)
+
+(define not-given (gensym))
+
+(define-syntax-class (expr/c ctc-stx
+                             #:arg? [arg? #t]
+                             #:positive [pos-blame 'from-macro]
+                             #:negative [neg-blame 'use-site]
+                             #:macro [macro-name #f]
+                             #:name [expr-name not-given]
+                             #:context [ctx #f])
+  #:attributes (c)
+  #:commit
+  (pattern y:expr
+           #:with
+           c (wrap-expr/c ctc-stx
+                          #'y
+                          #:arg? arg?
+                          #:positive pos-blame
+                          #:negative neg-blame
+                          #:name (if (eq? expr-name not-given)
+                                     this-role
+                                     expr-name)
+                          #:macro macro-name
+                          #:context (or ctx (this-context-syntax)))))
+
+(provide-syntax-class/contract
+ [expr/c (syntax-class/c (syntax?)
+                         (#:arg? any/c
+                          #:positive (or/c syntax? string? module-path-index?
+                                           'from-macro 'use-site 'unknown)
+                          #:negative (or/c syntax? string? module-path-index?
+                                           'from-macro 'use-site 'unknown)
+                          #:name (or/c identifier? string? symbol? #f)
+                          #:macro (or/c identifier? string? symbol? #f)
+                          #:context (or/c syntax? #f)))])

parse/private/lib.rkt

@@ -8,5 +8,7 @@
     (my-include "lib.rkt-6-11")]
   [(version< (version) "6.90.0.29")
     (my-include "lib.rkt-6-12")]
+  [(version< (version) "7.0.0.20")
+    (my-include "lib.rkt-6-90-0-29")]
   [else
-    (my-include "lib.rkt-6-90-0-29")])
+    (my-include "lib.rkt-7-3-0-1")])

parse/private/lib.rkt-7-3-0-1

@@ -0,0 +1,96 @@
+#lang racket/base
+(require "sc.rkt"
+         syntax/parse/private/keywords
+         (only-in "residual.rkt" state-cons!)
+         (for-syntax syntax/parse/private/residual-ct)
+         (for-syntax racket/base))
+
+(provide identifier
+         boolean
+         str
+         character
+         keyword
+         number
+         integer
+         exact-integer
+         exact-nonnegative-integer
+         exact-positive-integer
+         
+         id
+         nat
+         char
+
+         expr
+         static)
+
+
+(define (expr-stx? x)
+  (not (keyword-stx? x)))
+
+(define ((stxof pred?) x) (and (syntax? x) (pred? (syntax-e x))))
+(define keyword-stx? (stxof keyword?))
+(define boolean-stx? (stxof boolean?))
+(define string-stx? (stxof string?))
+(define bytes-stx? (stxof bytes?))
+(define char-stx? (stxof char?))
+(define number-stx? (stxof number?))
+(define integer-stx? (stxof integer?))
+(define exact-integer-stx? (stxof exact-integer?))
+(define exact-nonnegative-integer-stx? (stxof exact-nonnegative-integer?))
+(define exact-positive-integer-stx? (stxof exact-positive-integer?))
+(define regexp-stx? (stxof regexp?))
+(define byte-regexp-stx? (stxof byte-regexp?))
+
+
+;; == Integrable syntax classes ==
+
+(define-integrable-syntax-class identifier (quote "identifier") identifier?)
+(define-integrable-syntax-class expr (quote "expression") expr-stx?)
+(define-integrable-syntax-class keyword (quote "keyword") keyword-stx?)
+(define-integrable-syntax-class boolean (quote "boolean") boolean-stx?)
+(define-integrable-syntax-class character (quote "character") char-stx?)
+(define-integrable-syntax-class number (quote "number") number-stx?)
+(define-integrable-syntax-class integer (quote "integer") integer-stx?)
+(define-integrable-syntax-class exact-integer (quote "exact-integer") exact-integer-stx?)
+(define-integrable-syntax-class exact-nonnegative-integer
+  (quote "exact-nonnegative-integer")
+  exact-nonnegative-integer-stx?)
+(define-integrable-syntax-class exact-positive-integer
+  (quote "exact-positive-integer")
+  exact-positive-integer-stx?)
+
+(define-integrable-syntax-class -string (quote "string") string-stx?)
+(define-integrable-syntax-class -bytes (quote "bytes") bytes-stx?)
+(define-integrable-syntax-class -regexp (quote "regexp") regexp-stx?)
+(define-integrable-syntax-class -byte-regexp (quote "byte-regexp") byte-regexp-stx?)
+
+;; Overloading the meaning of existing identifiers
+(begin-for-syntax
+  (set-box! alt-stxclass-mapping
+            (list (cons #'string (syntax-local-value #'-string))
+                  (cons #'bytes  (syntax-local-value #'-bytes))
+                  (cons #'regexp (syntax-local-value #'-regexp))
+                  (cons #'byte-regexp (syntax-local-value #'-byte-regexp)))))
+
+;; Aliases
+(define-syntax id (make-rename-transformer #'identifier))
+(define-syntax nat (make-rename-transformer #'exact-nonnegative-integer))
+(define-syntax char (make-rename-transformer #'character))
+(define-syntax str (make-rename-transformer #'-string))
+
+
+;; == Normal syntax classes ==
+
+(define notfound (box 'notfound))
+
+(define-syntax-class (static pred [name #f])
+  #:attributes (value)
+  #:description name
+  #:commit
+  (pattern x:id
+           #:fail-unless (syntax-transforming?)
+                         "not within the dynamic extent of a macro transformation"
+           #:attr value (syntax-local-value #'x (lambda () notfound))
+           #:fail-when (eq? (attribute value) notfound) #f
+           #:fail-unless (pred (attribute value)) #f
+           #:do [(state-cons! 'literals #'x)]))

parse/private/parse.rkt

@@ -10,5 +10,7 @@
     (my-include "parse.rkt-6-12")]
   [(version< (version) "7.0.0.20")
     (my-include "parse.rkt-6-90-0-29")]
+  [(version< (version) "7.3.0.1")
+    (my-include "parse.rkt-7-0-0-20")]
   [else
-    (my-include "parse.rkt-7-0-0-20")])
+    (my-include "parse.rkt-7-3-0-1")])

parse/private/rep.rkt

@@ -10,5 +10,7 @@
     (my-include "rep.rkt-6-12")]
   [(version< (version) "7.0.0.20")
     (my-include "rep.rkt-6-90-0-29")]
+  [(version< (version) "7.3.0.1")
+    (my-include "rep.rkt-7-0-0-20")]
   [else
-    (my-include "rep.rkt-7-0-0-20")])
+    (my-include "rep.rkt-7-3-0-1")])

scribblings/stxparse-info.scrbl

@@ -8,5 +8,7 @@
     (my-include "stxparse-info.scrbl-6-11")]
   [(version< (version) "6.90.0.29")
     (my-include "stxparse-info.scrbl-6-12")]
+  [(version< (version) "7.3.0.1")
+    (my-include "stxparse-info.scrbl-6-90-0-29")]
   [else
-    (my-include "stxparse-info.scrbl-6-90-0-29")])
+    (my-include "stxparse-info.scrbl-7-3-0-1")])

scribblings/stxparse-info.scrbl-7-3-0-1

@@ -0,0 +1,357 @@
+#lang scribble/manual
+@require[racket/require
+         @for-label[stxparse-info/parse
+                    stxparse-info/parse/experimental/template
+                    stxparse-info/case
+                    stxparse-info/current-pvars
+                    (subtract-in racket/syntax stxparse-info/case)
+                    (subtract-in racket/base stxparse-info/case)]
+         version-case
+         @for-syntax[racket/base]
+         "ovl.rkt"]
+
+@; Circumvent https://github.com/racket/scribble/issues/79
+@(require scribble/struct
+          scribble/decode)
+@(define (nested-inset . vs)
+   (nested #:style 'inset vs))
+
+@(version-case 
+  [(version< (version) "6.4")
+   ]
+  [else
+   (require scribble/example)
+   (define ev ((make-eval-factory '(racket))))])
+
+@title{@racketmodname[stxparse-info]: Track @racket[syntax-parse] and @racket[syntax-case] pattern vars}
+@author[@author+email["Georges Dupéron" "georges.duperon@gmail.com"]]
+
+Source code: @url{https://github.com/jsmaniac/stxparse-info}
+
+@defmodule[stxparse-info]
+
+This library provides some patched versions of @orig:syntax-parse and of the
+@orig:syntax-case family. These patched versions track which syntax pattern
+variables are bound. This allows some libraries to change the way syntax
+pattern variables work.
+
+For example, @tt{subtemplate} automatically derives temporary
+identifiers when a template contains @racket[yᵢ …], and @racket[xᵢ] is a
+pattern variable. To know from which @racket[varᵢ] the @racket[yᵢ …]
+identifiers must be derived, @tt{subtemplate} needs to know which
+syntax pattern variables are within scope.
+
+@section{Tracking currently-bound pattern variables with @racket[syntax-parse]}
+
+@defmodule[stxparse-info/parse]
+
+The module @racketmodname[stxparse-info/parse] provides patched versions of
+@orig:syntax-parse, @orig:syntax-parser and @orig:define/syntax-parse which
+track which syntax pattern variables are bound.
+
+@(ovl syntax/parse
+      syntax-parse
+      syntax-parser
+      define/syntax-parse)
+
+Additionally, the following identifiers are overridden as they are part of the
+duplicated implementation of @racketmodname[syntax/parse].
+
+@(ovl #:wrapper nested-inset
+      syntax/parse
+      ...+
+      attribute
+      boolean
+      char
+      character
+      define-conventions
+      define-eh-alternative-set
+      define-literal-set
+      define-splicing-syntax-class
+      define-syntax-class
+      exact-integer
+      exact-nonnegative-integer
+      exact-positive-integer
+      expr
+      expr/c
+      id
+      identifier
+      integer
+      kernel-literals
+      keyword
+      literal-set->predicate
+      nat
+      number
+      pattern
+      prop:syntax-class
+      static
+      str
+      syntax-parse-state-cons!
+      syntax-parse-state-ref
+      syntax-parse-state-set!
+      syntax-parse-state-update! 
+      syntax-parse-track-literals
+      this-syntax
+      ~!
+      ~and
+      ~between
+      ~bind
+      ~commit
+      ~datum
+      ~delimit-cut
+      ~describe
+      ~do
+      ~fail
+      ~literal
+      ~not
+      ~once
+      ~optional
+      ~or
+      ~parse
+      ~peek
+      ~peek-not
+      ~post
+      ~rest
+      ~seq
+      ~undo
+      ~var)
+
+@(version-case
+  [(version>= (version) "6.9.0.6")
+   (ovl #:wrapper nested-inset
+        syntax/parse
+        ~alt
+        ~or*)]
+  [else (begin)])
+
+@(ovl #:wrapper nested-inset
+      #:require (for-template syntax/parse)
+      syntax/parse
+      pattern-expander?
+      pattern-expander
+      prop:pattern-expander
+      syntax-local-syntax-parse-pattern-introduce)
+
+@section{Tracking currently-bound pattern variables with @racket[syntax-case]}
+
+@defmodule[stxparse-info/case]
+
+The module @racketmodname[stxparse-info/case] provides patched versions of
+@orig:syntax-case, @orig:syntax-case*, @orig:with-syntax,
+@orig:define/with-syntax, @orig:datum-case and @orig:with-datum which
+track which syntax or datum pattern variables are bound.
+
+@(ovl racket/base
+      syntax-case
+      syntax-case*
+      with-syntax)
+
+@(ovl syntax/datum
+      datum-case
+      with-datum)
+
+@(ovl racket/syntax
+      define/with-syntax)
+
+@section{Reading and updating the list of currently-bound pattern variables}
+
+@defmodule[stxparse-info/current-pvars] 
+
+@defproc[#:kind "procedure at phase 1"
+         (current-pvars) (listof identifier?)]{
+ This for-syntax procedure returns the list of syntax pattern variables which
+ are known to be bound. The most recently bound variables are at the beginning
+ of the list.
+
+ It is the responsibility of the reader to check that the identifiers are
+ bound, and that they are bound to syntax pattern variables, for example using
+ @racket[identifier-binding] and @racket[syntax-pattern-variable?]. This allows
+ libraries to also track variables bound by match-like forms, for example.}
+
+@defproc[#:kind "procedure at phase 1"
+         (current-pvars+unique) (listof (pairof identifier? identifier?))]{
+ This for-syntax procedure works like @racket[current-pvars], but associates
+ each syntax pattern variable with an identifier containing a unique symbol
+ which is generated at each execution of the code recording the pattern
+ variable via @racket[with-pvars] or @racket[define-pvars].
+
+ The @racket[car] of each pair in the returned list is the syntax pattern
+ variable (as produced by @racket[current-pvars]). It is the responsibility of
+ the reader to check that the identifiers present in the @racket[car] of each
+ element of the returned list are bound, and that they are bound to syntax
+ pattern variables, for example using @racket[identifier-binding] and
+ @racket[syntax-pattern-variable?]. This allows libraries to also track
+ variables bound by match-like forms, for example.
+
+ The @racket[cdr] of each pair is the identifier of a temporary variable.
+ Reading that temporary variable produces a @racket[gensym]-ed symbol, which
+ was generated at run-time at the point where @racket[with-pvars] or
+ @racket[define-pvars] was used to record the corresponding pattern variable.
+
+ This can be used to associate run-time data with each syntax pattern
+ variable, via a weak hash table created with @racket[make-weak-hasheq]. For
+ example, the @tt{subtemplate} library implicitly derives
+ identifiers (similarly to @racket[generate-temporaries]) for uses of
+ @racket[yᵢ ...] from a @racket[xᵢ] pattern variable bearing the same
+ subscript. The generated identifiers are associated with @racket[xᵢ] via this
+ weak hash table mechanism, so that two uses of @racket[yᵢ ...] within the
+ scope of the same @racket[xᵢ] binding derive the same identifiers.
+
+ The code @racket[(with-pvars (v) body)] roughly expands to:
+
+ @racketblock[
+ (let-values ([(tmp) (gensym 'v)])
+   (letrec-syntaxes+values ([(shadow-current-pvars)
+                             (list* (cons (quote-syntax v)
+                                          (quote-syntax tmp))
+                                    old-current-pvars)])
+     body))]
+
+ @bold{Caveat:} this entails that the fresh symbol stored in @racket[tmp] is
+ generated when @racket[with-pvars] or @racket[define-pvars] is called, not
+ when the syntax pattern variable is actually bound. For example:
+
+ @RACKETBLOCK[
+ (define-syntax (get-current-pvars+unique stx)
+   #`'#,(current-pvars+unique))
+              
+ (require racket/private/sc)
+ (let ([my-valvar (quote-syntax x)])
+   (let-syntax ([my-pvar (make-syntax-mapping 0 (quote-syntax my-valvar))])
+     (with-pvars (x)
+       (get-current-pvars+unique)) (code:comment "'([x . g123])")
+     (with-pvars (x)
+       (get-current-pvars+unique)))) (code:comment "'([x . g124])")]
+
+ Under normal circumstances, @racket[with-pvars] @racket[define-pvars] should
+ be called immediately after binding the syntax pattern variable, but the code
+ above shows that it is technically possible to do otherwise.
+
+ This caveat is not meant to dissuade the use of
+ @racket[current-pvars+unique], it rather serves as an explanation of the
+ behaviour encountered when @racket[with-pvars] or @racket[define-pvars] are
+ incorrectly used more than once to record the same pattern variable.}
+
+@defform[(with-pvars (pvar ...) . body)
+         #:contracts ([pvar identifier?])]{
+ Prepends the given @racket[pvar ...] to the list of pattern variables which
+ are known to be bound. The @racket[pvar ...] are prepended in reverse order,
+ so within the body of
+
+ @racketblock[(with-pvars (v₁ v₂ v₃) . body)]
+ 
+ a call to the for-syntax function @racket[(current-pvars)] returns:
+
+ @racketblock[(list* (quote-syntax v₃) (quote-syntax v₂) (quote-syntax v₁)
+                     old-current-pvars)]
+
+ This can be used to implement macros which work similarly to
+ @racket[syntax-parse] or @racket[syntax-case], and have them record the syntax
+ pattern variables which they bind.
+
+ Note that the identifiers @racket[pvar ...] must already be bound to syntax
+ pattern variables when @racket[with-pvars] is used, e.g.
+
+ @racketblock[
+ (let-syntax ([v₁ (make-syntax-mapping depth (quote-syntax valvar))]
+              [v₂ (make-syntax-mapping depth (quote-syntax valvar))])
+   (with-pvars (v₁ v₂)
+     code))]
+
+ instead of:
+
+ @racketblock[
+ (with-pvars (v₁ v₂)
+   (let-syntax ([v₁ (make-syntax-mapping depth (quote-syntax valvar))]
+                [v₂ (make-syntax-mapping depth (quote-syntax valvar))])
+     code))]}
+
+@defform[(define-pvars pvar ...)
+         #:contracts ([pvar identifier?])]{
+                                           
+ Prepends the given @racket[pvar ...] to the list of pattern variables which
+ are known to be bound, in the same way as @racket[with-pvars]. Whereas
+ @racket[with-pvars] makes the modified list visible in the @racket[_body],
+ @racket[define-pvars] makes the modified list visible in the statements
+ following @racket[define-pvars]. @racket[define-pvars] can be used multiple
+ times within the same @racket[let] or equivalent.
+
+ This can be used to implement macros which work similarly to
+ @racket[define/syntax-parse] or @racket[define/with-syntax], and have them
+ record the syntax pattern variables which they bind.
+
+ @(version-case 
+   [(version< (version) "6.4")
+    @RACKETBLOCK[
+ (let ()
+   (code:comment "Alternate version of define/syntax-parse which")
+   (code:comment "contains (define-pvars x) in its expanded form.")
+   (define/syntax-parse x #'1)
+   (define/syntax-parse y #'2)
+   (define-syntax (get-pvars stx)
+     #`'#,(current-pvars))
+   (get-pvars))
+ (code:comment "=> '(y x)")]]
+   [else
+    @examples[
+ #:eval ev
+ #:hidden
+ (require stxparse-info/parse
+          stxparse-info/current-pvars
+          racket/syntax
+          (for-syntax racket/base))]
+ 
+    @examples[
+ #:eval ev
+ #:escape UNSYNTAX
+ (eval:check
+  (let ()
+    (code:comment "Alternate version of define/syntax-parse which")
+    (code:comment "contains (define-pvars x) in its expanded form.")
+    (define/syntax-parse x #'1)
+    (define/syntax-parse y #'2)
+    (define-syntax (get-pvars stx)
+      #`'#,(current-pvars))
+    (get-pvars))
+  '(y x))]])}
+
+@section{Extensions to @racketmodname[syntax/parse/experimental/template]}
+
+@defmodule[stxparse-info/parse/experimental/template]
+
+@(orig syntax/parse/experimental/template
+       define-template-metafunction)
+
+@defidform[define-template-metafunction]{
+ Overloaded version of @orig:define-template-metafunction from
+ @racketmodname[syntax/parse/experimental/template].
+
+ Note that currently, template metafunctions defined via
+ @racketmodname[stxparse-info/parse/experimental/template] are not compatible
+ with the forms from @racketmodname[syntax/parse/experimental/template], and
+ vice versa. There is a pending Pull Request which would make the necessary
+ primitives from @racketmodname[syntax/parse/experimental/template] public, so
+ hopefully this problem will be solved in future versions.}
+
+@defform[(syntax-local-template-metafunction-introduce stx)]{
+ Like @racket[syntax-local-introduce], but for
+ @tech[#:doc '(lib "syntax/scribblings/syntax.scrbl")]{template metafunctions}.
+
+ This change is also available in the package
+ @racketmodname{backport-template-pr1514}. It has been submitted as a Pull
+ Request to Racket, but can already be used in
+ @racketmodname[stxparse-info/parse/experimental/template] right now.}
+
+@(ovl syntax/parse/experimental/template
+      template
+      quasitemplate
+      template/loc
+      quasitemplate/loc)
+
+Additionally, the following identifiers are overridden as they are part of the
+duplicated implementation of @racketmodname[syntax/parse].
+
+@(ovl #:wrapper nested-inset
+      syntax/parse/experimental/template
+      ??
+      ?@)