diff --git a/.travis.yml b/.travis.yml index e842acb..002fc22 100644 --- 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 new file mode 100644 index 0000000..985b014 --- /dev/null +++ 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 index 5f4270a..bb606ce 100644 --- 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 index e85c613..11552b5 100644 --- 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 index bc115bb..34e615a 100644 --- 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 index 1a23289..58cdf3f 100644 --- 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 new file mode 100644 index 0000000..60e058c --- /dev/null +++ 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