suzanne.soy/extensible-parser-specifications
1
0
Fork 0
Code Issues 2 Pull Requests Actions Packages Projects Releases Wiki Activity

Fix issues with #:define-syntax-class and #:define-splicing-syntax-class

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-26 01:22:55 +02:00
parent a8001c282b
commit 028e3fc1b7
1 changed files with 18 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
private/define-syntax+simple-api.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(provide define-syntax/parse+simple
(for-syntax define/syntax-parse+simple))
(for-syntax define/syntax-parse+simple))
(require phc-toolkit/untyped
syntax/parse/define
@ -16,10 +16,11 @@
(for-meta 2 racket/list)
(for-meta 2 racket/syntax)
(for-meta 2 syntax/parse)
(for-meta 2 syntax/parse/experimental/template)
(for-meta 2 phc-toolkit/untyped))
(define-syntax/parse (define-syntax/parse+simple
[name . args] . body)
[name . args] . body)
(with-format-ids/inject-binders
([name-forward #'name "~a-forward-attributes" #'name]
[tmp-forward #'tmp "~a-forward-attributes" #'tmp])
@ -34,21 +35,26 @@
(define-syntax (define/syntax-parse+simple stx)
(syntax-parse stx
[(_ (name:name-or-curry . args)
(~optional (~seq #:define-splicing-syntax-class define-class-name:id))
(~optional (~seq #:define-splicing-syntax-class define-splicing:id))
(~optional (~seq #:define-syntax-class define-class:id))
. body)
(let ()
(define introducer (make-syntax-introducer))
(define/with-syntax args-stxclass
(or (attribute define-class-name)
(or (attribute define-class)
(introducer (datum->syntax #'args 'args-stxclass) 'add)))
(define/with-syntax body-introduced
(introducer #'body 'add))
#'(begin
(define-splicing-syntax-class args-stxclass
#:auto-nested-attributes
(pattern (~seq . args)))
(define/syntax-parse+simple/stxclass [name args-stxclass]
. body-introduced)))]))
(template
(begin
(?? (define-splicing-syntax-class define-splicing
#:auto-nested-attributes
(pattern {~seq . args})))
(define-syntax-class args-stxclass
#:auto-nested-attributes
(pattern args))
(define/syntax-parse+simple/stxclass [name . args-stxclass]
. body-introduced))))]))
(define-for-syntax (change-name-or-curry stx new-name)
(if (identifier? stx)
@ -63,7 +69,7 @@
(define-syntax define/syntax-parse+simple/stxclass
(syntax-parser-with-arrows
[(_ [name:name-or-curry
(~var cls (static syntax/parse:stxclass? "a syntax class"))]
. (~var cls (static syntax/parse:stxclass? "a syntax class"))]
. body)
#:with colon-stxclass (format-id #'cls ":~a" #'cls)
#:with name-forward (format-id/record #'name.id
@ -88,7 +94,7 @@
(with-arrows
(syntax-parameterize ([stx (make-rename-transformer #'stx2)])
(syntax-parse stx2
[(_ colon-stxclass) . body]))))
[(_ . colon-stxclass) . body]))))
(define def-private-simple-api
(syntax-parameterize ([stx (make-rename-transformer #'stx/arg)])
(syntax-parse #'nothing