suzanne.soy/subtemplate
1
0
Fork 0
Code Issues 2 Pull Requests Actions Packages Projects Releases Wiki Activity

Propper handling of omitted elements

Browse Source
This commit is contained in:
Georges Dupéron 2017-02-01 07:40:52 +01:00
parent a46326c300
commit 5580d9ee2c
4 changed files with 73 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
copy-attribute.rkt
View File

@ -53,9 +53,13 @@
#:with nested (nest-map (λ (pat) #`{~or #f ({~and #,pat} (... ...))})
(if (syntax-e #'syntax?)
#'{~or #f name}
;; variable with empty name, so that the attribute
;; Variable with empty name, so that the attribute
;; gets exported without a prefix.
#`{~or #f {~var #,(datum->syntax #'name '||)
;; Take care to keep the original srcloc,
;; otherwise error messages lack the proper srcloc
#`{~or #f {~var #,(datum->syntax #'name
'||
#'name)
extract-non-syntax}})
(syntax-e #'ellipsis-depth))
(if (syntax-e #'syntax?)

29
ddd.rkt
View File

@ -81,15 +81,22 @@
(quote-syntax #,(x-pvar-present-marker #'present-variables))
body))
(define (map#f* f l*)
(cond [(andmap (λ (l) (eq? l #f)) l*)
'(#f)]
[(andmap (or/c null? #f) l*)
'()]
[else (let ([cars (map (λ (l) (if l (car l) #f)) l*)]
[cdrs (map (λ (l) (if l (cdr l) #f)) l*)])
(cons (apply f cars)
(map#f* f cdrs)))]))
(define (=* . vs)
(if (< (length vs) 2)
#t
(apply = vs)))
(define (map#f* f attr-ids l*)
(for ([l (in-list l*)]
[attr-id (in-list attr-ids)])
(when (eq? l #f)
(raise-syntax-error (syntax-e attr-id)
"attribute contains an omitted element"
attr-id)))
(unless (apply =* (map length l*))
(raise-syntax-error 'ddd
"incompatible ellipis counts for template"))
(apply map f l*))
(define-syntax/case (ddd body) ()
(define/with-syntax (pvar …)
@ -159,9 +166,11 @@
[(list #f pv pvᵢ #t _) #`(attribute* #,pv)]
[(list #f pv pvᵢ #f _) #'#f])
present?+pvars)))
#'(map#f* (λ (iterated-pvarᵢ …)
(expanded-f filling-pvar …))
(list (quote-syntax iterated-pvar)
…)
(list (attribute* iterated-pvar)
…)))

52
test/test-ddd-forms.rkt
View File

@ -176,13 +176,13 @@
;; TODO: expr … inside begin and let
(check-equal? (syntax-case #'((1 2 3) (4 5)) ()
[((x …) …)
(let ()
(list (length (syntax->list #'(x …)))
(+ (syntax-e #'x) 3) …)
…)])
'([3 4 5 6]
[2 7 8]))
[((x …) …)
(let ()
(list (length (syntax->list #'(x …)))
(+ (syntax-e #'x) 3) …)
…)])
'([3 4 5 6]
[2 7 8]))
(check-equal? (syntax-parse #'([1 2 3] [4 5 6])
[([x …] …)
@ -212,16 +212,16 @@
;; Implicit apply with (+ y … …)
(check-equal? (syntax-parse #'([1 2 3] [4 5 6])
[([x …] …)
(define/with-syntax y (+ x 10)) … …
(+ y … …)])
81)
[([x …] …)
(define/with-syntax y (+ x 10)) … …
(+ y … …)])
81)
;; Implicit apply with (+ (* x 2) … …)
(check-equal? (syntax-parse #'([1 2 3] [4 5 6])
[([x …] …)
(+ (* x 2) … …)])
42)
[([x …] …)
(+ (* x 2) … …)])
42)
;; TODO: (define ) … … should register the variable with current-pvars.
#;(syntax-parse #'([1 2 3] [4 5 6])
@ -230,16 +230,16 @@
y … …])
;; omitted element in the tree = not ok under ellipses
(check-exn
#rx"attribute contains an omitted element"
(λ ()
(syntax-parse #'([1 2 3] #:kw [4 5 6])
[({~and {~or [x …] #:kw}} …)
((x …) …)])))
#lang racket
(require subtemplate/ddd-forms
stxparse-info/case
stxparse-info/parse
rackunit
syntax/macro-testing
phc-toolkit/untyped)
(syntax-parse #'([1 2 3] #:kw [4 5 6])
[({~and {~or [x …] #:kw}} …)
((x …) …)])
;; omitted element in the tree = ok as auto-syntax-e
(check-equal? (syntax-parse #'([1 2 3] #:kw [4 5 6])
[({~and {~or [x …] #:kw}} …)
(x …)])
'((1 2 3) #f (4 5 6)))

29
test/test-ddd.rkt
View File

@ -25,12 +25,12 @@
'(4 5 6))
(check-equal? (syntax-case #'(((1 2) (3)) ((4 5 6))) ()
[(((x …) …) …)
(ddd (list (length (syntax->list #'((x …) …)))
(length (syntax->list #'(x … …)))
(ddd (ddd (- (syntax-e #'x))))))])
'([2 3 ((-1 -2) (-3))]
[1 3 ((-4 -5 -6))]))
[(((x …) …) …)
(ddd (list (length (syntax->list #'((x …) …)))
(length (syntax->list #'(x … …)))
(ddd (ddd (- (syntax-e #'x))))))])
'([2 3 ((-1 -2) (-3))]
[1 3 ((-4 -5 -6))]))
(check-equal? (syntax-case #'([1 2 3] [a]) ()
[([x …] [y …])
@ -71,4 +71,19 @@
(ddd (list (length (syntax->list #'(x …)))
(ddd (+ (syntax-e #'x) 3))))])
'([3 (4 5 6)]
[2 (7 8)]))
[2 (7 8)]))
;; omitted element at the leaves = ok (should it be ok?)
(check-equal? (syntax-parse #'(1 #f 3)
[({~and {~or x:nat #f}} …)
(ddd x)])
'(1 #f 3))
;; omitted element in the tree = not ok
(check-exn
#rx"attribute contains an omitted element"
(λ ()
(syntax-parse #'((1 1) #f (1 2 1 1))
[({~and {~or (x:nat …) #f}} …)
(ddd (ddd x))])))