Implemented current-pvars

.travis.yml

@@ -20,16 +20,16 @@ env:
     # Supply more than one RACKET_VERSION (as in the example below) to
     # create a Travis-CI build matrix to test against multiple Racket
     # versions.
-    - RACKET_VERSION=6.0
-    - RACKET_VERSION=6.1
-    - RACKET_VERSION=6.1.1
-    - RACKET_VERSION=6.2
-    - RACKET_VERSION=6.3
-    - RACKET_VERSION=6.4
-    - RACKET_VERSION=6.5
-    - RACKET_VERSION=6.6
-    - RACKET_VERSION=6.7
-    - RACKET_VERSION=HEAD
+    - RACKET_VERSION=6.0   RECENT=false
+    - RACKET_VERSION=6.1   RECENT=false
+    - RACKET_VERSION=6.1.1 RECENT=true
+    - RACKET_VERSION=6.2   RECENT=true
+    - RACKET_VERSION=6.3   RECENT=true
+    - RACKET_VERSION=6.4   RECENT=true
+    - RACKET_VERSION=6.5   RECENT=true
+    - RACKET_VERSION=6.6   RECENT=true
+    - RACKET_VERSION=6.7   RECENT=true
+    - RACKET_VERSION=HEAD  RECENT=true
 
 matrix:
   allow_failures:
@@ -51,8 +51,10 @@ before_script:
 # packages without it getting stuck on a confirmation prompt.
 script:
  - raco test -x -p stxparse-info
+ - raco setup --check-pkg-deps --pkgs stxparse-info
+ - raco pkg install --deps search-auto doc-coverage
+ - raco doc-coverage stxparse-info/current-pvars
+ - if $RECENT; then raco pkg install --deps search-auto cover cover-codecov; fi
+ - if $RECENT; then raco cover -b -f codecov -d $TRAVIS_BUILD_DIR/coverage .; fi
 
 after_success:
- - raco setup --check-pkg-deps --pkgs stxparse-info
- - raco pkg install --deps search-auto cover cover-coveralls
- - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage .

current-pvars.rkt

@@ -0,0 +1,24 @@
+#lang racket/base
+(require racket/stxparam
+         (for-syntax racket/base
+                     racket/contract))
+
+(provide (for-syntax (rename-out [get-current-pvars current-pvars]))
+         with-pvars)
+
+(define-syntax-parameter current-pvars '())
+
+(define-syntax (with-pvars stx)
+  (syntax-case stx ()
+    [(_ (pvar ...) . body)
+     (andmap identifier? (syntax->list #'(pvar ...)))
+     (with-syntax ([(reverse-pvar ...) (reverse (syntax->list #'(pvar ...)))])
+       #'(syntax-parameterize
+             ([current-pvars (list* (quote-syntax reverse-pvar) ...
+                                    (syntax-parameter-value #'current-pvars))])
+           . body))]))
+
+(begin-for-syntax
+  (define/contract (get-current-pvars)
+    (-> (listof identifier?))
+    (syntax-parameter-value #'current-pvars)))

info.rkt

@@ -1,8 +1,7 @@
 #lang info
 (define collection "stxparse-info")
 (define deps '("base"
-               "rackunit-lib"
-               "reprovide-lang"))
+               "rackunit-lib"))
 (define build-deps '("scribble-lib" "racket-doc"))
 (define scribblings '(("scribblings/stxparse-info.scrbl" ())))
 (define pkg-desc "Description Here")

main.rkt

@@ -1,2 +1,3 @@
-#lang reprovide
-"parse.rkt"
+#lang racket/base
+(require "parse.rkt")
+(provide (all-from-out "parse.rkt"))

parse/private/runtime.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require racket/stxparam
          stxparse-info/parse/private/residual ;; keep abs. path
+         stxparse-info/current-pvars
          (for-syntax racket/base
                      racket/list
                      syntax/kerncase
@@ -95,14 +96,15 @@ residual.rkt.
                     (map parse-attr (syntax->list #'(a ...)))])
        (with-syntax ([(vtmp ...) (generate-temporaries #'(name ...))]
                      [(stmp ...) (generate-temporaries #'(name ...))])
-         #'(letrec-syntaxes+values
-               ([(stmp) (make-attribute-mapping (quote-syntax vtmp)
-                                                'name 'depth 'syntax?)] ...)
-               ([(vtmp) value] ...)
+         #'(with-pvars (name ...)
              (letrec-syntaxes+values
-                 ([(name) (make-syntax-mapping 'depth (quote-syntax stmp))] ...)
-                 ()
-               . body))))]))
+                 ([(stmp) (make-attribute-mapping (quote-syntax vtmp)
+                                                  'name 'depth 'syntax?)] ...)
+                 ([(vtmp) value] ...)
+               (letrec-syntaxes+values
+                   ([(name) (make-syntax-mapping 'depth (quote-syntax stmp))] ...)
+                   ()
+                 . body)))))]))
 
 ;; (let-attributes* (([id num] ...) (expr ...)) expr) : expr
 ;; Special case: empty attrs need not match number of value exprs.

scribblings/stxparse-info.scrbl

@@ -1,10 +1,48 @@
 #lang scribble/manual
-@require[@for-label[stxparse-info
+@require[@for-label[stxparse-info/parse
+                    stxparse-info/current-pvars
                     racket/base]]
 
-@title{stxparse-info}
-@author{georges}
+@title{stxparse-info : tracking bound syntax pattern variables with
+ @racketmodname[syntax/parse]}
+@author[@author+email["Georges Dupéron" "georges.duperon@gmail.com"]]
 
-@defmodule[stxparse-info]
+@defmodule[stxparse-info/parse]
 
-Package Description Here
+The module @racketmodname[stxparse-info/parse] is a patched version of
+@racketmodname[syntax/parse] which tracks which syntax pattern variables are
+bound. This allows some libraries to change the way syntax pattern variables
+work.
+
+For example, @racketmodname[phc-graph/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, @racketmodname[phc-graph/subtemplate] needs to
+know which syntax pattern variables are within scope.
+
+@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.}
+
+@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.}

test/test-current-pvars.rkt

@@ -0,0 +1,19 @@
+#lang racket
+(require stxparse-info/parse
+         stxparse-info/current-pvars
+         racket/stxparam
+         rackunit)
+
+(define-syntax (list-pvars stx)
+  #`'#,(current-pvars))
+
+(check-equal? (list-pvars)
+              '())
+
+(check-equal? (syntax-parse #'(1 2 3 a b c)
+                [(x y:nat ... {~parse w (list-pvars)} z ...)
+                 (syntax->datum #`[w #,(list-pvars)])])
+              '([y x] [z w y x]))
+
+(check-equal? (list-pvars)
+              '())