suzanne.soy/stxparse-info
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Bugfix and tests for define/with-syntax

Browse Source
This commit is contained in:
Georges Dupéron 2017-01-26 17:35:22 +01:00
parent ad27231d00
commit bff27464a9
3 changed files with 178 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
case/syntax.rkt
View File

@ -47,7 +47,7 @@
(define-syntax pvar (define-syntax pvar
(make-syntax-mapping 'depth (quote-syntax valvar))) (make-syntax-mapping 'depth (quote-syntax valvar)))
... ...
(define-pvars (pvar ...)))))])) (define-pvars pvar ...))))]))
;; Ryan: alternative name: define/syntax-pattern ?? ;; Ryan: alternative name: define/syntax-pattern ??
;; auxiliary macro ;; auxiliary macro

17
parse/experimental/private/substitute.rkt
View File

@ -60,13 +60,16 @@ An VarRef is one of
;; Used to indicate absent pvar in template; ?? catches ;; Used to indicate absent pvar in template; ?? catches
;; Note: not an exn, don't need continuation marks ;; Note: not an exn, don't need continuation marks
(require (only-in rackunit require/expose)) (require (only-in rackunit require/expose))
(require/expose syntax/parse/experimental/private/substitute #;(require/expose syntax/parse/experimental/private/substitute
(absent-pvar (absent-pvar
absent-pvar? absent-pvar?
absent-pvar-ctx absent-pvar-ctx
absent-pvar-v absent-pvar-v
absent-pvar-wanted-list?)) absent-pvar-wanted-list?))
#;(struct absent-pvar (ctx v wanted-list?)) ;; this struct is only used in this file, and is not exported, so I guess it's
;; ok to not steal the struct from syntax/parse/experimental/private/substitute
;; Furthermore, the require/expose above does not work reliably.
(struct absent-pvar (ctx v wanted-list?))
;; ============================================================ ;; ============================================================

303
test/test-current-pvars.rkt
View File

@ -1,5 +1,6 @@
#lang racket #lang racket
(require stxparse-info/parse (require stxparse-info/parse
stxparse-info/case
stxparse-info/current-pvars stxparse-info/current-pvars
racket/stxparam racket/stxparam
rackunit) rackunit)
@ -78,158 +79,188 @@
(syntax->datum (ref-nth-pvar 1)))]))]) (syntax->datum (ref-nth-pvar 1)))]))])
'(1 2 1))) '(1 2 1)))
;; tests for define/syntax-parse ;; Tests for syntax-case
(begin (begin
(check-equal? (syntax-parse #'1 (check-equal? (list-pvars)
[x '())
#:with y #'2
(define/syntax-parse z #'3) (check-equal? (syntax-case #'(1 (2 3) a b c) ()
[(x (y ...) z ...)
(list-pvars)]) (list-pvars)])
'(z y x)) '(z y x))
(check-equal? (syntax-parse #'1 (check-equal? (list-pvars)
[x '())
#:with y #'2
(define/syntax-parse z #'3)
(list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)))])
'(3 2 1))
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 (syntax->datum (ref-nth-pvar 0))])
(define/syntax-parse x #'3) 1)
(list-pvars)])
'(x y x))
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 (cons (syntax->datum (ref-nth-pvar 0))
(define/syntax-parse x #'3) (syntax-parse #'2
(list (syntax->datum (ref-nth-pvar 0)) [x
(syntax->datum (ref-nth-pvar 1)) (list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 2)))]) (syntax->datum (ref-nth-pvar 1)))]))])
'(3 2 1)) '(1 2 1)))
(check-equal? (syntax-parse #'1 ;; tests for define/syntax-parse and define/syntax-case
[x (define-syntax-rule (gen-test-define define/xxx)
#:with y #'2 (begin
(define/syntax-parse x #'3) (check-equal? (syntax-parse #'1
(define/syntax-parse y #'4) [x
(list (syntax->datum (ref-nth-pvar 0)) #:with y #'2
(syntax->datum (ref-nth-pvar 1)) (define/xxx z #'3)
(syntax->datum (ref-nth-pvar 2)) (list-pvars)])
(syntax->datum (ref-nth-pvar 3)))]) '(z y x))
'(4 3 2 1))
(check-equal? (syntax-parse #'1
[x
#:with y #'2
(define/xxx z #'3)
(list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)))])
'(3 2 1))
(check-equal? (syntax-parse #'1
[x
#:with y #'2
(define/xxx x #'3)
(list-pvars)])
'(x y x))
(check-equal? (syntax-parse #'1
[x
#:with y #'2
(define/xxx x #'3)
(list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)))])
'(3 2 1))
(check-equal? (syntax-parse #'1
[x
#:with y #'2
(define/xxx x #'3)
(define/xxx y #'4)
(list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2))
(syntax->datum (ref-nth-pvar 3)))])
'(4 3 2 1))
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 #:with y #'2
(define/syntax-parse x #'3) (define/xxx x #'3)
(define/syntax-parse y #'4) (define/xxx y #'4)
(define/syntax-parse z #'5) (define/xxx z #'5)
(list (syntax->datum (ref-nth-pvar 0)) (list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1)) (syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)) (syntax->datum (ref-nth-pvar 2))
(syntax->datum (ref-nth-pvar 3)) (syntax->datum (ref-nth-pvar 3))
(syntax->datum (ref-nth-pvar 4)))]) (syntax->datum (ref-nth-pvar 4)))])
'(5 4 3 2 1)) '(5 4 3 2 1))
(check-equal? (syntax-parse #'(1 2 3) (check-equal? (syntax-parse #'(1 2 3)
[(x y z) [(x y z)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(list (syntax->datum (ref-nth-pvar 0)) (list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1)) (syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)) (syntax->datum (ref-nth-pvar 2))
(syntax->datum (ref-nth-pvar 3)) (syntax->datum (ref-nth-pvar 3))
(syntax->datum (ref-nth-pvar 4)))]) (syntax->datum (ref-nth-pvar 4)))])
'(5 4 3 2 1)) '(5 4 3 2 1))
(check-equal? (syntax-parse #'(1 2 3) (check-equal? (syntax-parse #'(1 2 3)
[(x y z) [(x y z)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(list-pvars)]) (list-pvars)])
'(y x z y x)) '(y x z y x))
;; Test with nested let, less variables in the nested let ;; Test with nested let, less variables in the nested let
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(define/syntax-parse y #'3) (define/xxx y #'3)
(define/syntax-parse z #'4) (define/xxx z #'4)
(list (list-pvars) (list (list-pvars)
(let () (let ()
(define/syntax-parse w #'5) (define/xxx w #'5)
(define/syntax-parse x #'6) (define/xxx x #'6)
(list-pvars)) (list-pvars))
(list-pvars))) (list-pvars)))
'((z y x w) (x w z y x w) (z y x w))) '((z y x w) (x w z y x w) (z y x w)))
;; Test with nested let, more variables in the nested let ;; Test with nested let, more variables in the nested let
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(list (list-pvars) (list (list-pvars)
(let () (let ()
(define/syntax-parse w #'3) (define/xxx w #'3)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(define/syntax-parse z #'6) (define/xxx z #'6)
(list-pvars)) (list-pvars))
(list-pvars))) (list-pvars)))
'((x w) (z y x w x w) (x w))) '((x w) (z y x w x w) (x w)))
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(define/syntax-parse y #'3) (define/xxx y #'3)
(define/syntax-parse z #'4) (define/xxx z #'4)
(list (list-pvars) (list (list-pvars)
(syntax-parse #'5 (syntax-parse #'5
[k [k
(define/syntax-parse w #'5) (define/xxx w #'5)
(define/syntax-parse x #'6) (define/xxx x #'6)
(list-pvars)]) (list-pvars)])
(list-pvars))) (list-pvars)))
'((z y x w) (x w k z y x w) (z y x w))) '((z y x w) (x w k z y x w) (z y x w)))
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(list (list-pvars) (list (list-pvars)
(syntax-parse #'5 (syntax-parse #'5
[k [k
(define/syntax-parse w #'3) (define/xxx w #'3)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(define/syntax-parse z #'6) (define/xxx z #'6)
(list-pvars)]) (list-pvars)])
(list-pvars))) (list-pvars)))
'((x w) (z y x w k x w) (x w))) '((x w) (z y x w k x w) (x w)))
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(list (list-pvars) (list (list-pvars)
(syntax-parse #'5 (syntax-parse #'5
[k [k
(define/syntax-parse w #'3) (define/xxx w #'3)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(define/syntax-parse z #'6) (define/xxx z #'6)
(list (list-pvars) (list (list-pvars)
(syntax-parse #'5 (syntax-parse #'5
[k [k
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'4) (define/xxx y #'4)
(list-pvars)]) (list-pvars)])
(list-pvars))]) (list-pvars))])
(list-pvars))) (list-pvars)))
'((x w) '((x w)
((z y x w k x w) ((z y x w k x w)
(y x k z y x w k x w) (y x k z y x w k x w)
(z y x w k x w)) (z y x w k x w))
(x w)))) (x w)))))
(gen-test-define define/syntax-parse)
(gen-test-define define/with-syntax)