From a9c8f48832e25ca1c2e67dbb3c9f3f4106e25cba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Thu, 20 Oct 2016 00:53:37 +0200 Subject: [PATCH] Initial commit --- .gitignore | 6 ++ .travis.yml | 60 +++++++++++++++ LICENSE.txt | 11 +++ README.md | 3 + info.rkt | 10 +++ main.rkt | 127 ++++++++++++++++++++++++++++++++ scribblings/auto-syntax-e.scrbl | 50 +++++++++++++ 7 files changed, 267 insertions(+) create mode 100644 .gitignore create mode 100644 .travis.yml create mode 100644 LICENSE.txt create mode 100644 README.md create mode 100644 info.rkt create mode 100644 main.rkt create mode 100644 scribblings/auto-syntax-e.scrbl diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1a59348 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +*~ +\#* +.\#* +.DS_Store +compiled/ +/doc/ diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..bc5112b --- /dev/null +++ b/.travis.yml @@ -0,0 +1,60 @@ +language: c + +# Based from: https://github.com/greghendershott/travis-racket + +# Optional: Remove to use Travis CI's older infrastructure. +sudo: false + +env: + global: + # Supply a global RACKET_DIR environment variable. This is where + # Racket will be installed. A good idea is to use ~/racket because + # that doesn't require sudo to install and is therefore compatible + # with Travis CI's newer container infrastructure. + - RACKET_DIR=~/racket + matrix: + # Supply at least one RACKET_VERSION environment variable. This is + # used by the install-racket.sh script (run at before_install, + # below) to select the version of Racket to download and install. + # + # 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 + +matrix: + allow_failures: +# - env: RACKET_VERSION=HEAD + fast_finish: true + +before_install: +- git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket +- cat ~/travis-racket/install-racket.sh | bash # pipe to bash not sh! +- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us + +install: + - raco pkg install --deps search-auto + +before_script: + +# Here supply steps such as raco make, raco test, etc. You can run +# `raco pkg install --deps search-auto` to install any required +# packages without it getting stuck on a confirmation prompt. +script: + - raco test -x -p auto-syntax-e + - raco setup --check-pkg-deps --pkgs auto-syntax-e; + - raco pkg install doc-coverage + - raco doc-coverage auto-syntax-e + +after_success: + - raco pkg install --deps search-auto cover cover-coveralls + - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage . diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..4ffe8ba --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,11 @@ +auto-syntax-e +Copyright (c) 2016 georges + +This package is distributed under the GNU Lesser General Public +License (LGPL). This means that you can link auto-syntax-e into proprietary +applications, provided you follow the rules stated in the LGPL. You +can also modify this package; if you distribute a modified version, +you must distribute it under the terms of the LGPL, which in +particular means that you must release the source code for the +modified software. See http://www.gnu.org/copyleft/lesser.html +for more information. diff --git a/README.md b/README.md new file mode 100644 index 0000000..1f10440 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +auto-syntax-e +============= +README text here. diff --git a/info.rkt b/info.rkt new file mode 100644 index 0000000..98e4a92 --- /dev/null +++ b/info.rkt @@ -0,0 +1,10 @@ +#lang info +(define collection "auto-syntax-e") +(define deps '("base" + "rackunit-lib")) +(define build-deps '("scribble-lib" + "racket-doc")) +(define scribblings '(("scribblings/auto-syntax-e.scrbl" ()))) +(define pkg-desc "Description Here") +(define version "0.0") +(define pkg-authors '(georges)) diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..35a271c --- /dev/null +++ b/main.rkt @@ -0,0 +1,127 @@ +#lang racket/base + +(require racket/match + syntax/parse + (for-syntax racket/base + racket/syntax + racket/list + racket/struct + syntax/parse + racket/private/sc) + ;; attribute-mapping? is provided for-syntax + (only-in syntax/parse/private/residual attribute-mapping?)) + +(provide auto-with-syntax) +(provide auto-syntax) + +(define (leaves->datum e depth) + (if (> depth 0) + (map (λ (eᵢ) (leaves->datum eᵢ (sub1 depth))) e) + (if (syntax? e) + (syntax->datum e) + e))) + + +(define-syntax (to-datum stx) + (syntax-case stx () + [(_ id) + (syntax-pattern-variable? (syntax-local-value #'id (λ () #f))) + (begin + (let* ([mapping (syntax-local-value #'id)] + [valvar (syntax-mapping-valvar mapping)] + [depth (syntax-mapping-depth mapping)]) + (if (attribute-mapping? (syntax-local-value valvar (λ () #f))) + #`(leaves->datum (attribute id) #,depth) + #`(leaves->datum #,valvar #,depth))))])) + +(begin-for-syntax + (define-values (struct:auto-pvar + make-auto-pvar + auto-pvar? + auto-pvar-ref + auto-pvar-set!) + (make-struct-type 'auto-pvar + (eval #'struct:syntax-mapping + (module->namespace 'racket/private/sc)) + 0 + 0 + #f + null + (current-inspector) + (λ (self stx) + #`(to-datum #,stx))))) + +(define-for-syntax (syntax->tree/ids e) + (cond [(identifier? e) e] + [(syntax? e) (syntax->tree/ids (syntax-e e))] + [(pair? e) (cons (syntax->tree/ids (car e)) + (syntax->tree/ids (cdr e)))] + [(vector? e) (map syntax->tree/ids (vector->list e))] + [(box? e) (syntax->tree/ids (unbox e))] + [(prefab-struct-key e) (map syntax->tree/ids (struct->list e))] + [else e])) + +(define-for-syntax (syntax->ids e) + (filter identifier? (flatten (syntax->tree/ids e)))) + +(define-syntax auto-syntax + (syntax-parser + [(_ (id ...) body ...) + #:with (pvar-id ...) (filter (λ (id) + (syntax-pattern-variable? + (syntax-local-value id (λ () #f)))) + (syntax->list #'(id ...))) + (with-disappeared-uses + (record-disappeared-uses (syntax->list #'(pvar-id ...))) + #'(let-syntax ([pvar-id + (make-set!-transformer + (let ([mapping (syntax-local-value + (quote-syntax pvar-id))]) + (make-auto-pvar (syntax-mapping-depth mapping) + (syntax-mapping-valvar mapping))))] + ...) + body ...))])) + +(define-syntax auto-with-syntax + (syntax-parser + [(_ ([pat e] ...) body ...) + #:with (id ...) (syntax->ids #'(pat ...)) + #'(with-syntax ([pat e] ...) + (auto-syntax (id ...) + body ...))])) + +(module+ test + (require rackunit + syntax/parse) + (check-equal? (match (auto-with-syntax ([x #'123]) + (list (add1 x) #'x)) + [(list a (? syntax? b)) + (list a (syntax-e b))] + [_ 'error]) + '(124 123)) + + (check-equal? (match (syntax-parse #'(1 2 3) + [(x:nat y:nat ...) + (auto-syntax (x y) + (list (map add1 (cons x y)) #'(x y ...)))]) + [(list a (? syntax? b)) + (list a (syntax->datum b))] + [_ 'error]) + '((2 3 4) (1 2 3))) + + (check-equal? (match (syntax-parse #'(1 2 3) + [({~seq x:nat {~optional y:nat}} ...) + (auto-syntax (x y) + (list (map cons x y) + (attribute x) + (attribute y)))]) + [(list a + (list (? syntax? b₁) (? syntax? b₂)) + (list (? syntax? c₁) (and #f c₂))) + (list a + (list (syntax->datum b₁) (syntax->datum b₂)) + (list (syntax->datum c₁) c₂))] + [_ 'error]) + '([(1 . 2) (3 . #f)] + [1 3] + [2 #f]))) diff --git a/scribblings/auto-syntax-e.scrbl b/scribblings/auto-syntax-e.scrbl new file mode 100644 index 0000000..9975647 --- /dev/null +++ b/scribblings/auto-syntax-e.scrbl @@ -0,0 +1,50 @@ +#lang scribble/manual +@require[scribble/example + @for-label[auto-syntax-e + racket/base + syntax/parse]] + +@title{auto-syntax-e} +@author{georges} + +@defmodule[auto-syntax-e] + +This package allows using syntax pattern variables outside of syntax +templates: when @racket[_x] is bound as a syntax pattern variable, writing +@racket[_x] then becomes roughly equivalent to +@racket[(syntax->datum #'_x-ddd)], where @racket[_x-ddd] is @racket[x] wrapped +under the appropriate number of ellipses. If the pattern variable is bound by +@racket[syntax-parse] and contains non-syntax parts (e.g. it was bound within +an @racket[~optional] clause, or using @racket[#:attr]), they are left +unchanged. + +@defform[(auto-with-syntax ([patᵢ eᵢ] ...) body ...)]{ + Like @racket[(with-syntax ([patᵢ eᵢ] ...) body ...)], but the syntax pattern + variables bound by the @racket[patᵢ ...] can be used outside of syntax patterns + (they are implicitly transformed using @racket[syntax->datum]): + + @examples[#:eval ((make-eval-factory '(auto-syntax-e))) + (auto-with-syntax ([x #'123]) + (list (add1 x) #'x))]} + +@defform[(auto-syntax (pvarᵢ ...) body ...)]{ + Re-binds the syntax pattern variables @racket[pvarᵢ ...], so that can be used + outside of syntax patterns like in @racket[auto-with-syntax]: + + @examples[#:eval ((make-eval-factory '(auto-syntax-e syntax/parse))) + (syntax-parse #'(1 2 3) + [(x:nat y:nat ...) + (auto-syntax (x y) + (list (map add1 (cons x y)) #'(x y ...)))]) + (syntax-parse #'(1 2 3) + [({~seq x:nat {~optional y:nat}} ...) + (auto-syntax (x y) + (list (map cons x y) + (attribute x) + (attribute y)))])] + + When one of the @racket[pvarᵢ ...] is not a syntax pattern variable, it is + ignored and the existing binding, if any, is left untouched. + + Note that it is not necessary to specify the ellipsis-depth of each + @racket[pvarᵢ].} \ No newline at end of file