commit 45003e6e4215e0302bff81fe8540e6030358a6e8
parent 6a8ffed72055c0833ed313fc5383dcf3aaf5a690
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Sun, 22 Jan 2017 18:11:52 +0100
Implemented current-pvars
Diffstat:
7 files changed, 118 insertions(+), 30 deletions(-)
diff --git a/.travis.yml b/.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 .
diff --git a/current-pvars.rkt b/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)))
+\ No newline at end of file
diff --git a/info.rkt b/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")
diff --git a/main.rkt b/main.rkt
@@ -1,2 +1,3 @@
-#lang reprovide
-"parse.rkt"
-\ No newline at end of file
+#lang racket/base
+(require "parse.rkt")
+(provide (all-from-out "parse.rkt"))
+\ No newline at end of file
diff --git a/parse/private/runtime.rkt b/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.
diff --git a/scribblings/stxparse-info.scrbl b/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.}
+\ No newline at end of file
diff --git a/test/test-current-pvars.rkt b/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)
+ '())
+\ No newline at end of file
