Applied changes requested by @rmculpepper for PR #1587

This commit is contained in:
Georges Dupéron 2017-01-22 23:18:19 +01:00
parent 28f1df4cff
commit 73e3f7915b
2 changed files with 86 additions and 87 deletions

View File

@ -50,92 +50,92 @@
(terx (1 (2 3)) (_:one _:two) "expected one") (terx (1 (2 3)) (_:one _:two) "expected one")
(terx ((1) 2) (_:one _:two) "expected two") (terx ((1) 2) (_:one _:two) "expected two")
(test-case "datum patterns" ;; datum patterns
(tok () () (tok () ()
'ok 'ok
#:pre [(_) 0] #:post []) #:pre [(_) 0] #:post [])
(tok "here" "here" (tok "here" "here"
'ok 'ok
#:pre ["there" #"here" 0] #:post []) #:pre ["there" #"here" 0] #:post [])
(tok #"byte" #"byte" (tok #"byte" #"byte"
'ok 'ok
#:pre [#"other" "byte" 0] #:post []) #:pre [#"other" "byte" 0] #:post [])
(tok 1 1 (tok 1 1
'ok) 'ok)
(tok 1 _ (tok 1 _
#t #t
#:pre [2] #:post []) #:pre [2] #:post [])
(tok #f #f (tok #f #f
'ok 'ok
#:pre [#t 0] #:post [_]) #:pre [#t 0] #:post [_])
(tok #\c #\c (tok #\c #\c
'ok 'ok
#:pre [#\d "c" 0] #:post [_]) #:pre [#\d "c" 0] #:post [_])
(tok #:kw #:kw (tok #:kw #:kw
'ok 'ok
#:pre [#:other {~datum kw} "kw" 0] #:post [_]) #:pre [#:other {~datum kw} "kw" 0] #:post [_])
(tok #rx".*" #rx".*" (tok #rx".*" #rx".*"
'ok 'ok
#:pre [#rx"." #px".*" #rx#".*" #px#".*"] #:post [_]) #:pre [#rx"." #px".*" #rx#".*" #px#".*"] #:post [_])
(tok #px".*" #px".*" (tok #px".*" #px".*"
'ok 'ok
#:pre [#px"." #rx".*" #rx#".*" #px#".*"] #:post [_]) #:pre [#px"." #rx".*" #rx#".*" #px#".*"] #:post [_])
(tok #rx#".*" #rx#".*" (tok #rx#".*" #rx#".*"
'ok 'ok
#:pre [#rx#"." #px#".*" #rx".*" #px".*"] #:post [_]) #:pre [#rx#"." #px#".*" #rx".*" #px".*"] #:post [_])
(tok #px#".*" #px#".*" (tok #px#".*" #px#".*"
'ok 'ok
#:pre [#px#"." #rx#".*" #rx".*" #px".*"] #:post [_]) #:pre [#px#"." #rx#".*" #rx".*" #px".*"] #:post [_])
(tok #&"box" #&"box" (tok #&"box" #&"box"
'ok 'ok
#:pre [#&"other" {~datum #&_} 0] #:post [_]) #:pre [#&"other" {~datum #&_} 0] #:post [_])
(tok #&_ #&_ (tok #&_ #&_
'ok 'ok
#:pre [{~datum #&other}] #:post [_]) #:pre [{~datum #&other}] #:post [_])
(tok #&xyz {~datum #&xyz} (tok #&xyz {~datum #&xyz}
'ok) 'ok)
(tok xyz {~datum xyz} (tok xyz {~datum xyz}
'ok) 'ok)
(tok (a . b) {~datum (a . b)} (tok (a . b) {~datum (a . b)}
'ok 'ok
#:pre [{~datum (_ . _)}] #:post [_]) #:pre [{~datum (_ . _)}] #:post [_])
(tok (a b c) {~datum (a b c)} (tok (a b c) {~datum (a b c)}
'ok 'ok
#:pre [{~datum (_ _ _)} {~datum (_ . _)}] #:post [_]) #:pre [{~datum (_ _ _)} {~datum (_ . _)}] #:post [_])
(tok #(1 2 3) {~datum #(1 2 3)} (tok #(1 2 3) {~datum #(1 2 3)}
'ok 'ok
#:pre [{~datum #(_ _ _)}] #:post [_]) #:pre [{~datum #(_ _ _)}] #:post [_])
(tok #hash([a . 1] [b . 2]) {~datum #hash([b . 2] [a . 1])} (tok #hash([a . 1] [b . 2]) {~datum #hash([b . 2] [a . 1])}
'ok 'ok
#:pre [{~datum #hash([_ . 1] [_ . 2])} #:pre [{~datum #hash([_ . 1] [_ . 2])}
{~datum #hash([a . _] [b . _])} {~datum #hash([a . _] [b . _])}
{~datum #hasheq([a . 1] [b . 2])} {~datum #hasheq([a . 1] [b . 2])}
{~datum #hasheqv([a . 1] [b . 2])}] {~datum #hasheqv([a . 1] [b . 2])}]
#:post [_]) #:post [_])
(tok #hasheq([a . 1] [b . 2]) {~datum #hasheq([b . 2] [a . 1])} (tok #hasheq([a . 1] [b . 2]) {~datum #hasheq([b . 2] [a . 1])}
'ok 'ok
#:pre [{~datum #hasheq([_ . 1] [_ . 2])} #:pre [{~datum #hasheq([_ . 1] [_ . 2])}
{~datum #hasheq([a . _] [b . _])} {~datum #hasheq([a . _] [b . _])}
{~datum #hash([a . 1] [b . 2])} {~datum #hash([a . 1] [b . 2])}
{~datum #hasheqv([a . 1] [b . 2])}] {~datum #hasheqv([a . 1] [b . 2])}]
#:post [_]) #:post [_])
(tok #hasheqv([a . 1] [b . 2]) {~datum #hasheqv([b . 2] [a . 1])} (tok #hasheqv([a . 1] [b . 2]) {~datum #hasheqv([b . 2] [a . 1])}
'ok 'ok
#:pre [{~datum #hasheqv([_ . 1] [_ . 2])} #:pre [{~datum #hasheqv([_ . 1] [_ . 2])}
{~datum #hasheqv([a . _] [b . _])} {~datum #hasheqv([a . _] [b . _])}
{~datum #hasheq([a . 1] [b . 2])} {~datum #hasheq([a . 1] [b . 2])}
{~datum #hash([a . 1] [b . 2])}] {~datum #hash([a . 1] [b . 2])}]
#:post [_]) #:post [_])
(tok #s(prefab-st x y z) {~datum #s(prefab-st x y z)} (tok #s(prefab-st x y z) {~datum #s(prefab-st x y z)}
'ok 'ok
#:pre [{~datum #s(prefab-st _ _ _)}] #:post [_]) #:pre [{~datum #s(prefab-st _ _ _)}] #:post [_])
(tok #s(prefab-st x y z) #s(prefab-st _ _ _) (tok #s(prefab-st x y z) #s(prefab-st _ _ _)
'ok) 'ok)
(terx 1 2 "literal 2") (terx 1 2 "literal 2")
(terx (1 2) 1 "literal 1") (terx (1 2) 1 "literal 1")
(terx (1 2) (1 1) "literal 1")) (terx (1 2) (1 1) "literal 1")
;; literal patterns ;; literal patterns
(test-case "literals: +" (test-case "literals: +"

View File

@ -4,8 +4,7 @@
racket/syntax racket/syntax
syntax/parse/private/minimatch syntax/parse/private/minimatch
racket/private/stx ;; syntax/stx racket/private/stx ;; syntax/stx
racket/private/sc racket/private/sc)
racket/struct)
syntax/parse/private/residual syntax/parse/private/residual
"private/substitute.rkt") "private/substitute.rkt")
(provide template (provide template
@ -410,7 +409,7 @@ instead of integers and integer vectors.
(and (pair? v) (quotable? (car v)) (quotable? (cdr v))) (and (pair? v) (quotable? (car v)) (quotable? (cdr v)))
(and (vector? v) (andmap quotable? (vector->list v))) (and (vector? v) (andmap quotable? (vector->list v)))
(and (hash? v) (andmap quotable? (hash->list v))) (and (hash? v) (andmap quotable? (hash->list v)))
(and (prefab-struct-key v) (andmap quotable? (struct->list v))))) (and (prefab-struct-key v) (andmap quotable? (cdr (vector->list (struct->vector v)))))))
(define (cons-guide g1 g2) (define (cons-guide g1 g2)
(if (and (eq? g1 '_) (eq? g2 '_)) '_ (cons g1 g2))) (if (and (eq? g1 '_) (eq? g2 '_)) '_ (cons g1 g2)))