test-subtemplate.rkt (49220B)
1 #lang racket 2 (require subtemplate/private/template-subscripts 3 stxparse-info/parse 4 stxparse-info/parse/experimental/template 5 stxparse-info/case 6 phc-toolkit/untyped 7 rackunit 8 syntax/macro-testing) 9 10 #| 11 (define-syntax (tst stx) 12 (syntax-case stx () 13 [(_ tt) 14 #`'#,(find-subscript-binder #'tt #f)])) 15 16 (check-false (syntax-case #'(a b) () 17 [(_ x) 18 (tst x)])) 19 20 (check-equal? (syntax-parse 21 #'(a b c) 22 [(_ x yᵢ) 23 (list (tst x) 24 (tst wᵢ))]) 25 '(#f yᵢ)) 26 27 |# 28 29 (check-equal? (syntax->datum (syntax-parse #'(a b c d) 30 [(_ xⱼ zᵢ …) 31 (subtemplate foo)])) 32 'foo) 33 34 (check-equal? (syntax->datum (syntax-case #'(a b c d) () 35 [(_ xⱼ zᵢ …) 36 (subtemplate foo)])) 37 'foo) 38 39 (check-equal? (syntax->datum (syntax-parse #'(a b c d) 40 [(_ xⱼ zᵢ …) 41 (subtemplate xⱼ)])) 42 'b) 43 44 (check-equal? (syntax->datum (syntax-case #'(a b c d) () 45 [(_ xⱼ zᵢ …) 46 (subtemplate xⱼ)])) 47 'b) 48 49 (check-equal? (syntax->datum (syntax-parse #'(a b c d) 50 [(_ xⱼ zᵢ …) 51 (subtemplate (zᵢ …))])) 52 '(c d)) 53 54 (check-equal? (syntax->datum (syntax-case #'(a b c d) () 55 [(_ xⱼ zᵢ …) 56 (subtemplate (zᵢ …))])) 57 '(c d)) 58 59 (check-equal? (syntax->datum (syntax-parse #'(a b c d) 60 [(_ xⱼ zᵢ …) 61 (subtemplate (wᵢ …))])) 62 '(c/w d/w)) 63 64 (check-equal? (syntax->datum (syntax-case #'(a b c d) () 65 [(_ xⱼ zᵢ …) 66 (subtemplate (wᵢ …))])) 67 '(c/w d/w)) 68 69 (check-equal? (syntax->datum (syntax-parse #'(a b c d) 70 [(_ xⱼ zᵢ …) 71 (subtemplate (kⱼ wᵢ …))])) 72 '(b/k c/w d/w)) 73 74 (check-equal? (syntax->datum (syntax-case #'(a b c d) () 75 [(_ xⱼ zᵢ …) 76 (subtemplate (kⱼ wᵢ …))])) 77 '(b/k c/w d/w)) 78 79 (check-equal? (syntax->datum (syntax-parse #'(a b c d) 80 [(_ xⱼ zᵢ …) 81 (subtemplate (xⱼ kⱼ (zᵢ wᵢ) …))])) 82 '(b b/k (c c/w) (d d/w))) 83 84 (check-equal? (syntax->datum (syntax-case #'(a b c d) () 85 [(_ xⱼ zᵢ …) 86 (subtemplate (xⱼ kⱼ (wᵢ zᵢ) …))])) 87 '(b b/k (c/w c) (d/w d))) 88 89 ;; With yᵢ appearing twice: 90 (check-equal? (syntax->datum (syntax-case #'(a b c) () 91 [(xᵢ …) 92 (subtemplate (yᵢ … yᵢ …))])) 93 '(a/y b/y c/y a/y b/y c/y)) 94 95 96 97 98 (let () 99 (syntax-parse (syntax-parse #'(a b c d) 100 [(_ xⱼ zᵢ …) 101 (list (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …)) 102 (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …)))]) 103 [(([x1 w1] foo1 [z1 p1] [zz1 pp1]) 104 ([x2 w2] foo2 [z2 p2] [zz2 pp2])) 105 (check bound-identifier=? #'x1 #'x2)])) 106 107 (syntax-parse (syntax-parse #'(a b c d) 108 [(_ xⱼ zᵢ …) 109 (list (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …)) 110 (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …)))]) 111 [(([x1 w1] foo1 [z1 p1] [zz1 pp1]) 112 ([x2 w2] foo2 [z2 p2] [zz2 pp2])) 113 (check bound-identifier=? #'x1 #'x2) 114 (check bound-identifier=? #'w1 #'w2) 115 (check bound-identifier=? #'foo1 #'foo2) 116 (check bound-identifier=? #'z1 #'z2) 117 (check bound-identifier=? #'p1 #'p2) 118 (check bound-identifier=? #'zz1 #'zz2) 119 (check bound-identifier=? #'pp1 #'pp2) 120 121 (check bound-identifier=? #'x1 #'b) 122 (check bound-identifier=? #'z1 #'c) 123 (check bound-identifier=? #'zz1 #'d) 124 125 (check bound-identifier=? #'x2 #'b) 126 (check bound-identifier=? #'z2 #'c) 127 (check bound-identifier=? #'zz2 #'d) 128 129 ;; The *1 are all different: 130 (check bound-identifier=? #'x1 #'x1) 131 (check (∘ not bound-identifier=?) #'x1 #'w1) 132 (check (∘ not bound-identifier=?) #'x1 #'foo1) 133 (check (∘ not bound-identifier=?) #'x1 #'z1) 134 (check (∘ not bound-identifier=?) #'x1 #'p1) 135 (check (∘ not bound-identifier=?) #'x1 #'zz1) 136 (check (∘ not bound-identifier=?) #'x1 #'pp1) 137 138 (check (∘ not bound-identifier=?) #'w1 #'x1) 139 (check bound-identifier=? #'w1 #'w1) 140 (check (∘ not bound-identifier=?) #'w1 #'foo1) 141 (check (∘ not bound-identifier=?) #'w1 #'z1) 142 (check (∘ not bound-identifier=?) #'w1 #'p1) 143 (check (∘ not bound-identifier=?) #'w1 #'zz1) 144 (check (∘ not bound-identifier=?) #'w1 #'pp1) 145 146 (check (∘ not bound-identifier=?) #'foo1 #'x1) 147 (check (∘ not bound-identifier=?) #'foo1 #'w1) 148 (check bound-identifier=? #'foo1 #'foo1) 149 (check (∘ not bound-identifier=?) #'foo1 #'z1) 150 (check (∘ not bound-identifier=?) #'foo1 #'p1) 151 (check (∘ not bound-identifier=?) #'foo1 #'zz1) 152 (check (∘ not bound-identifier=?) #'foo1 #'pp1) 153 154 (check (∘ not bound-identifier=?) #'z1 #'x1) 155 (check (∘ not bound-identifier=?) #'z1 #'w1) 156 (check (∘ not bound-identifier=?) #'z1 #'foo1) 157 (check bound-identifier=? #'z1 #'z1) 158 (check (∘ not bound-identifier=?) #'z1 #'p1) 159 (check (∘ not bound-identifier=?) #'z1 #'zz1) 160 (check (∘ not bound-identifier=?) #'z1 #'pp1) 161 162 (check (∘ not bound-identifier=?) #'p1 #'x1) 163 (check (∘ not bound-identifier=?) #'p1 #'w1) 164 (check (∘ not bound-identifier=?) #'p1 #'foo1) 165 (check (∘ not bound-identifier=?) #'p1 #'z1) 166 (check bound-identifier=? #'p1 #'p1) 167 (check (∘ not bound-identifier=?) #'p1 #'zz1) 168 (check (∘ not bound-identifier=?) #'p1 #'pp1) 169 170 (check (∘ not bound-identifier=?) #'zz1 #'x1) 171 (check (∘ not bound-identifier=?) #'zz1 #'w1) 172 (check (∘ not bound-identifier=?) #'zz1 #'foo1) 173 (check (∘ not bound-identifier=?) #'zz1 #'z1) 174 (check (∘ not bound-identifier=?) #'zz1 #'p1) 175 (check bound-identifier=? #'zz1 #'zz1) 176 (check (∘ not bound-identifier=?) #'zz1 #'pp1) 177 178 (check (∘ not bound-identifier=?) #'pp1 #'x1) 179 (check (∘ not bound-identifier=?) #'pp1 #'w1) 180 (check (∘ not bound-identifier=?) #'pp1 #'foo1) 181 (check (∘ not bound-identifier=?) #'pp1 #'z1) 182 (check (∘ not bound-identifier=?) #'pp1 #'p1) 183 (check (∘ not bound-identifier=?) #'pp1 #'zz1) 184 (check bound-identifier=? #'pp1 #'pp1) 185 186 ;; The *2 are all different: 187 (check bound-identifier=? #'x2 #'x2) 188 (check (∘ not bound-identifier=?) #'x2 #'w2) 189 (check (∘ not bound-identifier=?) #'x2 #'foo2) 190 (check (∘ not bound-identifier=?) #'x2 #'z2) 191 (check (∘ not bound-identifier=?) #'x2 #'p2) 192 (check (∘ not bound-identifier=?) #'x2 #'zz2) 193 (check (∘ not bound-identifier=?) #'x2 #'pp2) 194 195 (check (∘ not bound-identifier=?) #'w2 #'x2) 196 (check bound-identifier=? #'w2 #'w2) 197 (check (∘ not bound-identifier=?) #'w2 #'foo2) 198 (check (∘ not bound-identifier=?) #'w2 #'z2) 199 (check (∘ not bound-identifier=?) #'w2 #'p2) 200 (check (∘ not bound-identifier=?) #'w2 #'zz2) 201 (check (∘ not bound-identifier=?) #'w2 #'pp2) 202 203 (check (∘ not bound-identifier=?) #'foo2 #'x2) 204 (check (∘ not bound-identifier=?) #'foo2 #'w2) 205 (check bound-identifier=? #'foo2 #'foo2) 206 (check (∘ not bound-identifier=?) #'foo2 #'z2) 207 (check (∘ not bound-identifier=?) #'foo2 #'p2) 208 (check (∘ not bound-identifier=?) #'foo2 #'zz2) 209 (check (∘ not bound-identifier=?) #'foo2 #'pp2) 210 211 (check (∘ not bound-identifier=?) #'z2 #'x2) 212 (check (∘ not bound-identifier=?) #'z2 #'w2) 213 (check (∘ not bound-identifier=?) #'z2 #'foo2) 214 (check bound-identifier=? #'z2 #'z2) 215 (check (∘ not bound-identifier=?) #'z2 #'p2) 216 (check (∘ not bound-identifier=?) #'z2 #'zz2) 217 (check (∘ not bound-identifier=?) #'z2 #'pp2) 218 219 (check (∘ not bound-identifier=?) #'p2 #'x2) 220 (check (∘ not bound-identifier=?) #'p2 #'w2) 221 (check (∘ not bound-identifier=?) #'p2 #'foo2) 222 (check (∘ not bound-identifier=?) #'p2 #'z2) 223 (check bound-identifier=? #'p2 #'p2) 224 (check (∘ not bound-identifier=?) #'p2 #'zz2) 225 (check (∘ not bound-identifier=?) #'p2 #'pp2) 226 227 (check (∘ not bound-identifier=?) #'zz2 #'x2) 228 (check (∘ not bound-identifier=?) #'zz2 #'w2) 229 (check (∘ not bound-identifier=?) #'zz2 #'foo2) 230 (check (∘ not bound-identifier=?) #'zz2 #'z2) 231 (check (∘ not bound-identifier=?) #'zz2 #'p2) 232 (check bound-identifier=? #'zz2 #'zz2) 233 (check (∘ not bound-identifier=?) #'zz2 #'pp2) 234 235 (check (∘ not bound-identifier=?) #'pp2 #'x2) 236 (check (∘ not bound-identifier=?) #'pp2 #'w2) 237 (check (∘ not bound-identifier=?) #'pp2 #'foo2) 238 (check (∘ not bound-identifier=?) #'pp2 #'z2) 239 (check (∘ not bound-identifier=?) #'pp2 #'p2) 240 (check (∘ not bound-identifier=?) #'pp2 #'zz2) 241 (check bound-identifier=? #'pp2 #'pp2)]) 242 243 (syntax-parse (syntax-parse #'(a b c) 244 [(xᵢ …) 245 (define flob (quasisubtemplate (zᵢ …))) 246 (quasisubtemplate (yᵢ … 247 #,flob 248 zᵢ …))]) 249 [(a1 b1 c1 (a2 b2 c2) a3 b3 c3) 250 (check bound-identifier=? #'a2 #'a3) 251 (check bound-identifier=? #'b2 #'b3) 252 (check bound-identifier=? #'c2 #'c3) 253 (check (∘ not bound-identifier=?) #'a1 #'a2) 254 (check (∘ not bound-identifier=?) #'b1 #'b2) 255 (check (∘ not bound-identifier=?) #'c1 #'c2)]) 256 257 (syntax-parse (syntax-parse #'(a b c) 258 [(xᵢ …) 259 (quasisubtemplate (yᵢ … 260 #,(quasisubtemplate (zᵢ …)) 261 zᵢ …))]) 262 [(a1 b1 c1 (a2 b2 c2) a3 b3 c3) 263 (check bound-identifier=? #'a2 #'a3) 264 (check bound-identifier=? #'b2 #'b3) 265 (check bound-identifier=? #'c2 #'c3) 266 (check (∘ not bound-identifier=?) #'a1 #'a2) 267 (check (∘ not bound-identifier=?) #'b1 #'b2) 268 (check (∘ not bound-identifier=?) #'c1 #'c2)]) 269 270 (syntax-parse (syntax-parse #'(a b c) 271 [(xᵢ …) 272 (define flob (syntax-parse #'d [d (quasisubtemplate (zᵢ …))])) 273 (quasisubtemplate (yᵢ … 274 #,flob 275 zᵢ …))]) 276 [(a1 b1 c1 (a2 b2 c2) a3 b3 c3) 277 (check bound-identifier=? #'a2 #'a3) 278 (check bound-identifier=? #'b2 #'b3) 279 (check bound-identifier=? #'c2 #'c3) 280 (check (∘ not bound-identifier=?) #'a1 #'a2) 281 (check (∘ not bound-identifier=?) #'b1 #'b2) 282 (check (∘ not bound-identifier=?) #'c1 #'c2)]) 283 284 (syntax-parse (syntax-parse #'(a b c) 285 [(xᵢ …) 286 (quasisubtemplate (yᵢ … 287 #,(syntax-parse #'d 288 [d (quasisubtemplate (zᵢ …))]) 289 zᵢ …))]) 290 [(a1 b1 c1 (a2 b2 c2) a3 b3 c3) 291 (check bound-identifier=? #'a2 #'a3) 292 (check bound-identifier=? #'b2 #'b3) 293 (check bound-identifier=? #'c2 #'c3) 294 (check (∘ not bound-identifier=?) #'a1 #'a2) 295 (check (∘ not bound-identifier=?) #'b1 #'b2) 296 (check (∘ not bound-identifier=?) #'c1 #'c2)]) 297 298 (syntax-parse (syntax-parse #'(a b c) 299 [(xᵢ …) 300 (quasisubtemplate (yᵢ … 301 #,(syntax-parse #'d 302 [d (quasisubtemplate (zᵢ …))]) 303 #,(syntax-parse #'d 304 [d (quasisubtemplate (zᵢ …))]) 305 zᵢ …))]) 306 [(a1 b1 c1 (a2 b2 c2) (a3 b3 c3) a4 b4 c4) 307 (check bound-identifier=? #'a2 #'a3) 308 (check bound-identifier=? #'b2 #'b3) 309 (check bound-identifier=? #'c2 #'c3) 310 311 (check bound-identifier=? #'a3 #'a4) 312 (check bound-identifier=? #'b3 #'b4) 313 (check bound-identifier=? #'c3 #'c4) 314 315 (check bound-identifier=? #'a2 #'a4) 316 (check bound-identifier=? #'b2 #'b4) 317 (check bound-identifier=? #'c2 #'c4) 318 319 (check (∘ not bound-identifier=?) #'a1 #'a2) 320 (check (∘ not bound-identifier=?) #'b1 #'b2) 321 (check (∘ not bound-identifier=?) #'c1 #'c2)]) 322 323 (syntax-parse (syntax-parse #'(a b c) 324 [(xᵢ …) 325 (quasisubtemplate (yᵢ … 326 #,(syntax-parse #'d 327 [d (quasisubtemplate (kᵢ …))]) 328 #,(syntax-parse #'d 329 [d (quasisubtemplate (kᵢ …))]) 330 zᵢ …))]) 331 [(a1 b1 c1 (a2 b2 c2) (a3 b3 c3) a4 b4 c4) 332 (check bound-identifier=? #'a2 #'a3) 333 (check bound-identifier=? #'b2 #'b3) 334 (check bound-identifier=? #'c2 #'c3) 335 336 (check (∘ not bound-identifier=?) #'a1 #'a2) 337 (check (∘ not bound-identifier=?) #'b1 #'b2) 338 (check (∘ not bound-identifier=?) #'c1 #'c2) 339 340 (check (∘ not bound-identifier=?) #'a2 #'a4) 341 (check (∘ not bound-identifier=?) #'b2 #'b4) 342 (check (∘ not bound-identifier=?) #'c2 #'c4) 343 344 (check (∘ not bound-identifier=?) #'a3 #'a4) 345 (check (∘ not bound-identifier=?) #'b3 #'b4) 346 (check (∘ not bound-identifier=?) #'c3 #'c4)]) 347 348 ;; Incompatible ellipsis counts 349 (begin 350 (check-exn #rx"incompatible ellipsis match counts for subscripted variables" 351 (λ () 352 (syntax-case #'([a b c] [d]) () 353 [([xᵢ …] [pᵢ …]) 354 (quasisubtemplate ([xᵢ …] [pᵢ …] [zᵢ …]))]))) 355 356 (check-equal? (syntax->datum 357 (syntax-case #'([a b c] [d]) () 358 [([xᵢ …] [pᵢ …]) 359 (quasisubtemplate ([xᵢ …] [pᵢ …]))])) 360 '([a b c] [d])) 361 362 (require (submod "../private/template-subscripts.rkt" test-private)) 363 (check-exn #rx"incompatible ellipsis match counts for subscripted variables" 364 (λ () 365 (generate-nested-ids 1 366 #'a 367 #'b 368 (λ (x) "fmt") 369 '((foo bar) (baz)) 370 (list #'x #'y) 371 #'(whole)))) 372 (check-equal? (map syntax-e 373 (generate-nested-ids 1 374 #'a 375 #'b 376 (λ (x) "fmt") 377 '((foo bar) (baz quux)) 378 (list #'x #'y) 379 #'(whole))) 380 '(fmt fmt))) 381 382 (syntax-parse (syntax-parse #'(a b c) 383 [(xᵢ …) 384 (quasisubtemplate (yᵢ … 385 #,(syntax-parse #'d 386 [zᵢ (quasisubtemplate (zᵢ))]) 387 #,(syntax-parse #'d 388 [zᵢ (quasisubtemplate (zᵢ))]) 389 zᵢ …))]) 390 [(y yy yyy (d1) (d2) z zz zzz) 391 (check bound-identifier=? #'d1 #'d2) 392 393 (check (∘ not bound-identifier=?) #'y #'yy) 394 (check (∘ not bound-identifier=?) #'y #'yyy) 395 (check (∘ not bound-identifier=?) #'y #'d1) 396 (check (∘ not bound-identifier=?) #'y #'d2) 397 (check (∘ not bound-identifier=?) #'y #'z) 398 (check (∘ not bound-identifier=?) #'y #'zz) 399 (check (∘ not bound-identifier=?) #'y #'zzz) 400 401 (check (∘ not bound-identifier=?) #'yy #'y) 402 (check (∘ not bound-identifier=?) #'yy #'yyy) 403 (check (∘ not bound-identifier=?) #'yy #'d1) 404 (check (∘ not bound-identifier=?) #'yy #'d2) 405 (check (∘ not bound-identifier=?) #'yy #'z) 406 (check (∘ not bound-identifier=?) #'yy #'zz) 407 (check (∘ not bound-identifier=?) #'yy #'zzz) 408 409 (check (∘ not bound-identifier=?) #'yyy #'y) 410 (check (∘ not bound-identifier=?) #'yyy #'yy) 411 (check (∘ not bound-identifier=?) #'yyy #'d1) 412 (check (∘ not bound-identifier=?) #'yyy #'d2) 413 (check (∘ not bound-identifier=?) #'yyy #'z) 414 (check (∘ not bound-identifier=?) #'yyy #'zz) 415 (check (∘ not bound-identifier=?) #'yyy #'zzz) 416 417 (check (∘ not bound-identifier=?) #'d1 #'y) 418 (check (∘ not bound-identifier=?) #'d1 #'yy) 419 (check (∘ not bound-identifier=?) #'d1 #'yyy) 420 ;(check (∘ not bound-identifier=?) #'d1 #'d2) 421 (check (∘ not bound-identifier=?) #'d1 #'z) 422 (check (∘ not bound-identifier=?) #'d1 #'zz) 423 (check (∘ not bound-identifier=?) #'d1 #'zzz) 424 425 (check (∘ not bound-identifier=?) #'d2 #'y) 426 (check (∘ not bound-identifier=?) #'d2 #'yy) 427 (check (∘ not bound-identifier=?) #'d2 #'yyy) 428 ;(check (∘ not bound-identifier=?) #'d2 #'d1) 429 (check (∘ not bound-identifier=?) #'d2 #'z) 430 (check (∘ not bound-identifier=?) #'d2 #'zz) 431 (check (∘ not bound-identifier=?) #'d2 #'zzz) 432 433 (check (∘ not bound-identifier=?) #'z #'y) 434 (check (∘ not bound-identifier=?) #'z #'yy) 435 (check (∘ not bound-identifier=?) #'z #'yyy) 436 (check (∘ not bound-identifier=?) #'z #'d1) 437 (check (∘ not bound-identifier=?) #'z #'d2) 438 (check (∘ not bound-identifier=?) #'z #'zz) 439 (check (∘ not bound-identifier=?) #'z #'zzz) 440 441 (check (∘ not bound-identifier=?) #'zz #'y) 442 (check (∘ not bound-identifier=?) #'zz #'yy) 443 (check (∘ not bound-identifier=?) #'zz #'yyy) 444 (check (∘ not bound-identifier=?) #'zz #'d1) 445 (check (∘ not bound-identifier=?) #'zz #'d2) 446 (check (∘ not bound-identifier=?) #'zz #'z) 447 (check (∘ not bound-identifier=?) #'zz #'zzz) 448 449 (check (∘ not bound-identifier=?) #'zzz #'y) 450 (check (∘ not bound-identifier=?) #'zzz #'yy) 451 (check (∘ not bound-identifier=?) #'zzz #'yyy) 452 (check (∘ not bound-identifier=?) #'zzz #'d1) 453 (check (∘ not bound-identifier=?) #'zzz #'d2) 454 (check (∘ not bound-identifier=?) #'zzz #'z) 455 (check (∘ not bound-identifier=?) #'zzz #'zz)]) 456 457 (syntax-parse (syntax-parse #'(a b c d) 458 [(_ xⱼ zᵢ …) 459 (list (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …)) 460 (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …)))]) 461 [(([x1 w1] foo1 [z1 p1] [zz1 pp1]) 462 ([x2 w2] foo2 [z2 p2] [zz2 pp2])) 463 (check bound-identifier=? #'x1 #'b) 464 (check bound-identifier=? #'foo1 #'foo) 465 (check bound-identifier=? #'z1 #'c) 466 (check bound-identifier=? #'zz1 #'d) 467 468 (check bound-identifier=? #'x2 #'b) 469 (check bound-identifier=? #'foo2 #'foo) 470 (check bound-identifier=? #'z2 #'c) 471 (check bound-identifier=? #'zz2 #'d) 472 473 (check bound-identifier=? #'x1 #'x2) 474 (check bound-identifier=? #'w1 #'w2) 475 (check bound-identifier=? #'foo1 #'foo2) 476 (check bound-identifier=? #'z1 #'z2) 477 (check bound-identifier=? #'p1 #'p2) 478 (check bound-identifier=? #'zz1 #'zz2) 479 (check bound-identifier=? #'pp1 #'pp2) 480 481 (check (∘ not bound-identifier=?) #'x1 #'w1) 482 (check (∘ not bound-identifier=?) #'x1 #'p1) 483 (check (∘ not bound-identifier=?) #'x1 #'pp1) 484 (check (∘ not bound-identifier=?) #'w1 #'x1) 485 (check (∘ not bound-identifier=?) #'w1 #'p1) 486 (check (∘ not bound-identifier=?) #'w1 #'pp1) 487 (check (∘ not bound-identifier=?) #'p1 #'x1) 488 (check (∘ not bound-identifier=?) #'p1 #'w1) 489 (check (∘ not bound-identifier=?) #'p1 #'pp1)]) 490 491 (syntax-parse (syntax-parse #'() 492 [() 493 (syntax-parse #'(a b) 494 [(zᵢ …) 495 (list (syntax-parse #'(e) 496 [(xⱼ) (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …))]) 497 (syntax-parse #'(e) ;; TODO: same test with f 498 [(xⱼ) (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …))]))])]) 499 [(([x1 w1] foo1 [z1 p1] [zz1 pp1]) 500 ([x2 w2] foo2 [z2 p2] [zz2 pp2])) 501 (check bound-identifier=? #'x1 #'e) 502 (check bound-identifier=? #'foo1 #'foo) 503 (check bound-identifier=? #'z1 #'a) 504 (check bound-identifier=? #'zz1 #'b) 505 506 (check bound-identifier=? #'x2 #'e) 507 (check bound-identifier=? #'foo2 #'foo) 508 (check bound-identifier=? #'z2 #'a) 509 (check bound-identifier=? #'zz2 #'b) 510 511 (check bound-identifier=? #'x1 #'x2) 512 (check (∘ not bound-identifier=?) #'w1 #'w2) ;; yes above, no here. 513 (check bound-identifier=? #'foo1 #'foo2) 514 (check bound-identifier=? #'z1 #'z2) 515 (check bound-identifier=? #'p1 #'p2) 516 (check bound-identifier=? #'zz1 #'zz2) 517 (check bound-identifier=? #'pp1 #'pp2) 518 519 (check (∘ not bound-identifier=?) #'x1 #'w1) 520 (check (∘ not bound-identifier=?) #'x1 #'p1) 521 (check (∘ not bound-identifier=?) #'x1 #'pp1) 522 (check (∘ not bound-identifier=?) #'w1 #'x1) 523 (check (∘ not bound-identifier=?) #'w1 #'p1) 524 (check (∘ not bound-identifier=?) #'w1 #'pp1) 525 (check (∘ not bound-identifier=?) #'p1 #'x1) 526 (check (∘ not bound-identifier=?) #'p1 #'w1) 527 (check (∘ not bound-identifier=?) #'p1 #'pp1)]) 528 529 (syntax-parse (syntax-parse #'() 530 [() 531 (syntax-parse #'(a b) 532 [(zᵢ …) 533 (list (syntax-parse #'(e) 534 [(xⱼ) (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …))]) 535 (syntax-parse #'(f) ;; above: was e, not f 536 [(xⱼ) (subtemplate ([xⱼ wⱼ] foo [zᵢ pᵢ] …))]))])]) 537 [(([x1 w1] foo1 [z1 p1] [zz1 pp1]) 538 ([x2 w2] foo2 [z2 p2] [zz2 pp2])) 539 (check bound-identifier=? #'x1 #'e) 540 (check bound-identifier=? #'foo1 #'foo) 541 (check bound-identifier=? #'z1 #'a) 542 (check bound-identifier=? #'zz1 #'b) 543 544 (check bound-identifier=? #'x2 #'f) ;; above: was e, not f 545 (check bound-identifier=? #'foo2 #'foo) 546 (check bound-identifier=? #'z2 #'a) 547 (check bound-identifier=? #'zz2 #'b) 548 549 (check (∘ not bound-identifier=?) #'x1 #'x2) ;; yes above, no here. 550 (check (∘ not bound-identifier=?) #'w1 #'w2) ;; yes above above, no here. 551 (check bound-identifier=? #'foo1 #'foo2) 552 (check bound-identifier=? #'z1 #'z2) 553 (check bound-identifier=? #'p1 #'p2) 554 (check bound-identifier=? #'zz1 #'zz2) 555 (check bound-identifier=? #'pp1 #'pp2) 556 557 (check (∘ not bound-identifier=?) #'x1 #'w1) 558 (check (∘ not bound-identifier=?) #'x1 #'p1) 559 (check (∘ not bound-identifier=?) #'x1 #'pp1) 560 (check (∘ not bound-identifier=?) #'w1 #'x1) 561 (check (∘ not bound-identifier=?) #'w1 #'p1) 562 (check (∘ not bound-identifier=?) #'w1 #'pp1) 563 (check (∘ not bound-identifier=?) #'p1 #'x1) 564 (check (∘ not bound-identifier=?) #'p1 #'w1) 565 (check (∘ not bound-identifier=?) #'p1 #'pp1)]) 566 567 (syntax-parse (syntax-parse #'() 568 [() 569 (syntax-parse #'(a b) 570 [(zᵢ …) 571 (list (syntax-parse #'(c d) 572 [(xᵢ …) 573 (subtemplate ([xᵢ wᵢ] … foo [zᵢ pᵢ] …))]) 574 (syntax-parse #'(cc dd) 575 [(xᵢ …) 576 (subtemplate ([xᵢ wᵢ] … foo [zᵢ pᵢ] …))]))])]) 577 [(([x1 w1] [xx1 ww1] foo1 [z1 p1] [zz1 pp1]) 578 ([x2 w2] [xx2 ww2] foo2 [z2 p2] [zz2 pp2])) 579 (check bound-identifier=? #'x1 #'c) 580 (check bound-identifier=? #'xx1 #'d) 581 (check bound-identifier=? #'foo1 #'foo) 582 (check bound-identifier=? #'z1 #'a) 583 (check bound-identifier=? #'zz1 #'b) 584 585 (check bound-identifier=? #'x2 #'cc) 586 (check bound-identifier=? #'xx2 #'dd) 587 (check bound-identifier=? #'foo2 #'foo) 588 (check bound-identifier=? #'z2 #'a) 589 (check bound-identifier=? #'zz2 #'b) 590 591 (check (∘ not bound-identifier=?) #'x1 #'x2) 592 (check (∘ not bound-identifier=?) #'xx1 #'xx2) 593 (check bound-identifier=? #'w1 #'w2) 594 (check bound-identifier=? #'ww1 #'ww2) 595 (check bound-identifier=? #'foo1 #'foo2) 596 (check bound-identifier=? #'z1 #'z2) 597 (check bound-identifier=? #'p1 #'p2) 598 (check bound-identifier=? #'zz1 #'zz2) 599 (check bound-identifier=? #'pp1 #'pp2) 600 601 (check (∘ not bound-identifier=?) #'x1 #'xx1) 602 (check (∘ not bound-identifier=?) #'x1 #'w1) 603 (check (∘ not bound-identifier=?) #'x1 #'p1) 604 (check (∘ not bound-identifier=?) #'x1 #'pp1) 605 (check (∘ not bound-identifier=?) #'xx1 #'x1) 606 (check (∘ not bound-identifier=?) #'xx1 #'w1) 607 (check (∘ not bound-identifier=?) #'xx1 #'p1) 608 (check (∘ not bound-identifier=?) #'xx1 #'pp1) 609 (check (∘ not bound-identifier=?) #'w1 #'xx1) 610 (check (∘ not bound-identifier=?) #'w1 #'x1) 611 (check (∘ not bound-identifier=?) #'w1 #'p1) 612 (check (∘ not bound-identifier=?) #'w1 #'pp1) 613 (check (∘ not bound-identifier=?) #'p1 #'xx1) 614 (check (∘ not bound-identifier=?) #'p1 #'x1) 615 (check (∘ not bound-identifier=?) #'p1 #'w1) 616 (check (∘ not bound-identifier=?) #'p1 #'pp1)]) 617 618 (check-exn #px"incompatible ellipsis match counts for subscripted variables" 619 (λ () 620 (syntax-parse #'() 621 [() 622 (syntax-parse #'(a b) 623 [(zᵢ …) 624 (list (syntax-parse #'(c) ;; one here, two above and below 625 [(xᵢ …) 626 (subtemplate ([xᵢ wᵢ] … foo [zᵢ pᵢ] …))]) 627 (syntax-parse #'(cc dd) 628 [(xᵢ …) 629 (subtemplate ([xᵢ wᵢ] … foo [zᵢ pᵢ] …))]))])]))) 630 631 ;; Test for arrows, with two maximal candidates tᵢ and zᵢ : 632 ;; the arrow should be drawn to the ᵢ in wᵢ and pᵢ from the ᵢ in the bindings 633 ;; for both tᵢ and zᵢ. For the uses of xᵢ, tᵢ and zᵢ, there should be only one 634 ;; arrow, drawn from the correponding binding. 635 (syntax-parse (syntax-parse #'() 636 [() 637 (syntax-parse #'([a b] [aa bb]) 638 [([tᵢ …] [zᵢ …]) 639 (list (syntax-parse #'(c d) 640 [(xᵢ …) 641 (subtemplate ([xᵢ wᵢ] … tᵢ … foo [zᵢ pᵢ] …))]) 642 (syntax-parse #'(cc dd) 643 [(xᵢ …) 644 (subtemplate ([xᵢ wᵢ] … tᵢ … foo [zᵢ pᵢ] …))]))])]) 645 [(([x1 w1] [xx1 ww1] t1 tt1 foo1 [z1 p1] [zz1 pp1]) 646 ([x2 w2] [xx2 ww2] t2 tt2 foo2 [z2 p2] [zz2 pp2])) 647 (check bound-identifier=? #'x1 #'c) 648 (check bound-identifier=? #'xx1 #'d) 649 (check bound-identifier=? #'x2 #'cc) 650 (check bound-identifier=? #'xx2 #'dd) 651 652 (check bound-identifier=? #'t1 #'a) 653 (check bound-identifier=? #'tt1 #'b) 654 (check bound-identifier=? #'t2 #'a) 655 (check bound-identifier=? #'tt2 #'b) 656 657 (check (∘ not bound-identifier=?) #'x1 #'x2) 658 (check bound-identifier=? #'w1 #'w2) 659 (check (∘ not bound-identifier=?) #'xx1 #'xx2) 660 (check bound-identifier=? #'ww1 #'ww2) 661 (check bound-identifier=? #'t1 #'t2) 662 (check bound-identifier=? #'tt1 #'tt2) 663 (check bound-identifier=? #'foo1 #'foo2) 664 (check bound-identifier=? #'z1 #'z2) 665 (check bound-identifier=? #'p1 #'p2) 666 (check bound-identifier=? #'zz1 #'zz2) 667 (check bound-identifier=? #'pp1 #'pp2)]) 668 669 ;; Check that the derived values are NOT cached across runs of the same 670 ;; pattern+template (GH bug #1). 671 (check-equal? (map (λ (v) 672 (syntax->datum 673 (syntax-parse v 674 [(xᵢ …) (subtemplate (yᵢ …))]))) 675 (list #'[] #'[a] #'[a b] #'[c d e f])) 676 '([] [a/y] [a/y b/y] [c/y d/y e/y f/y])) 677 678 (check-equal? (map (λ (v) 679 (syntax->datum 680 (syntax-parse v 681 [(xᵢ …) (subtemplate (xᵢ … yᵢ …))]))) 682 (list #'[] #'[a] #'[a b] #'[c d e f])) 683 '([] [a a/y] [a b a/y b/y] [c d e f c/y d/y e/y f/y])) 684 685 (check-equal? (map (λ (v) 686 (syntax->datum 687 (syntax-parse v 688 [(xᵢ …) (subtemplate ([xᵢ yᵢ] …))]))) 689 (list #'[] #'[a] #'[a b] #'[c d e f])) 690 '(() 691 ([a a/y]) 692 ([a a/y] [b b/y]) 693 ([c c/y] [d d/y] [e e/y] [f f/y]))) 694 695 ;; ~optional 696 (begin 697 ;; whole opt present, yᵢ ... ... 698 (check-equal? (syntax->datum 699 (syntax-parse #'([(1 2 3) (a b)]) 700 [({~optional ((xᵢ ...) ...)}) 701 (subtemplate {?? (yᵢ ... ...) empty})])) 702 '(1/y 2/y 3/y a/y b/y)) 703 704 ;; whole opt empty, yᵢ ... ... 705 (check-equal? (syntax->datum 706 (syntax-parse #'() 707 [({~optional ((xᵢ ...) ...)}) 708 (subtemplate {?? (yᵢ ... ...) empty})])) 709 'empty) 710 711 ;; whole opt present, ([xᵢ yᵢ] ...) ... 712 (check-equal? (syntax->datum 713 (syntax-parse #'([(1 2 3) (a b)]) 714 [({~optional ((xᵢ ...) ...)}) 715 (subtemplate {?? (([xᵢ yᵢ] ...) ...) empty})])) 716 '(([1 1/y] [2 2/y] [3 3/y]) ([a a/y] [b b/y]))) 717 718 ;; whole opt empty, ([xᵢ yᵢ] ...) ... 719 (check-equal? (syntax->datum 720 (syntax-parse #'() 721 [({~optional ((xᵢ ...) ...)}) 722 (subtemplate {?? (([xᵢ yᵢ] ...) ...) empty})])) 723 'empty) 724 725 ;; whole opt present, (yᵢ ...) ... 726 (check-equal? (syntax->datum 727 (syntax-parse #'([(1 2 3) (a b)]) 728 [({~optional ((xᵢ ...) ...)}) 729 (subtemplate {?? ((yᵢ ...) ...) empty})])) 730 '((1/y 2/y 3/y) (a/y b/y))) 731 732 ;; whole opt empty, (yᵢ ...) ... 733 (check-equal? (syntax->datum 734 (syntax-parse #'() 735 [({~optional ((xᵢ ...) ...)}) 736 (subtemplate {?? (yᵢ ... ...) empty})])) 737 'empty) 738 739 ;; level-1 opt, (?@ [xᵢ yᵢ] ...)/empty ... 740 (check-equal? (syntax->datum 741 (syntax-parse #'((1 2 3) #:kw (a b) #:kw) 742 [({~and {~or (xᵢ ...) #:kw}} ...) 743 (subtemplate ({?? (?@ [xᵢ yᵢ] ...) empty} ...))])) 744 '([1 1/y] [2 2/y] [3 3/y] empty [a a/y] [b b/y] empty)) 745 746 ;; level-1 opt, (?@ yᵢ ...)/empty ... 747 (check-equal? (syntax->datum 748 (syntax-parse #'((1 2 3) #:kw (a b) #:kw) 749 [({~and {~or (xᵢ ...) #:kw}} ...) 750 (subtemplate ({?? (?@ yᵢ ...) empty} ...))])) 751 '(1/y 2/y 3/y empty a/y b/y empty)) 752 753 ;; level-1 opt, ([xᵢ yᵢ] ...)/empty ... 754 (check-equal? (syntax->datum 755 (syntax-parse #'((1 2 3) #:kw (a b) #:kw) 756 [({~and {~or (xᵢ ...) #:kw}} ...) 757 (subtemplate ({?? ([xᵢ yᵢ] ...) empty} ...))])) 758 '(([1 1/y] [2 2/y] [3 3/y]) empty ([a a/y] [b b/y]) empty)) 759 760 ;; level-1 opt, (xᵢ ...)/empty ... 761 (check-equal? (syntax->datum 762 (syntax-parse #'((1 2 3) #:kw (a b) #:kw) 763 [({~and {~or (xᵢ ...) #:kw}} ...) 764 (quasisubtemplate 765 ({?? (xᵢ ...) empty} ...))])) 766 '((1 2 3) empty (a b) empty)) 767 768 ;; level-1 opt, (yᵢ ...)/empty ... 769 (check-equal? (syntax->datum 770 (syntax-parse #'((1 2 3) #:kw (a b) #:kw) 771 [({~and {~or (xᵢ ...) #:kw}} ...) 772 (subtemplate ({?? (yᵢ ...) empty} ...))])) 773 '((1/y 2/y 3/y) empty (a/y b/y) empty)) 774 775 ;; level-1 opt + same but with all #f filled in. 776 (begin 777 ;; level-1 opt + same but with all #f filled in. (wᵢ ...)/empty ... 778 (check-equal? (syntax->datum 779 (syntax-parse #'([(e f g) (h i) (j k) (l m n o)] 780 [(1 2 3) #:kw (a b) #:kw]) 781 [((({~and {~or wᵢ:id #:k}} ...) ...) 782 ({~and {~or (xᵢ ...) #:kw}} ...)) 783 (subtemplate ({?? (wᵢ ...) empty} ...))])) 784 '((e f g) 785 (h i) 786 (j k) 787 (l m n o))) 788 789 ;; level-1 opt + same but with some filled/missing. (wᵢ/empty ...) ... 790 (check-equal? (syntax->datum 791 (syntax-parse #'([(e f g) (h i) (j k) (l m n o)] 792 [(1 2 3) #:kw (a b) #:kw]) 793 [((({~and {~or wᵢ:id #:k}} ...) ...) 794 ({~and {~or (xᵢ ...) #:kw}} ...)) 795 (subtemplate (({?? wᵢ empty} ...) ...))])) 796 '((e f g) 797 (h i) 798 (j k) 799 (l m n o))) 800 801 ;; level-1 opt + same but with all #f filled in. ([wᵢ yᵢ] ...)/empty ... 802 (check-equal? (syntax->datum 803 (syntax-parse #'([(e f g) (h i) (j k) (l m n o)] 804 [(1 2 3) #:kw (a b) #:kw]) 805 [((({~and {~or wᵢ:id #:k}} ...) ...) 806 ({~and {~or (xᵢ ...) #:kw}} ...)) 807 (subtemplate ({?? ([wᵢ yᵢ] ...) empty} ...))])) 808 '(([e 1/y] [f 2/y] [g 3/y]) 809 ([h h/y] [i i/y]) 810 ([j a/y] [k b/y]) 811 ([l l/y] [m m/y] [n n/y] [o o/y]))) 812 813 ;; level-1 opt + same but with all #f filled in. (yᵢ ...)/empty ... 814 (check-equal? (syntax->datum 815 (syntax-parse #'([(e f g) (h i) (j k) (l m n o)] 816 [(1 2 3) #:kw (a b) #:kw]) 817 [((({~and {~or wᵢ:id #:k}} ...) ...) 818 ({~and {~or (xᵢ ...) #:kw}} ...)) 819 (subtemplate ({?? (yᵢ ...) empty} ...))])) 820 '((1/y 2/y 3/y) 821 (h/y i/y) 822 (a/y b/y) 823 (l/y m/y n/y o/y))) 824 825 ;; level-1 opt + same but with all #f filled in. (yᵢ ...)/empty ... 826 (check-equal? (syntax->datum 827 (syntax-parse #'([(e f g) (h i) (j k) (l m n o)] 828 [(1 2 3) #:kw (a b) #:kw]) 829 [((({~and {~or wᵢ:id #:k}} ...) ...) 830 ({~and {~or (xᵢ ...) #:kw}} ...)) 831 (subtemplate ({?? (?@ yᵢ ...) empty} ...))])) 832 '(1/y 2/y 3/y h/y i/y a/y b/y l/y m/y n/y o/y)) 833 834 ;; level-1 opt + same but with all #f filled in. ([wᵢ yᵢ/empty] ...) ... 835 (check-equal? (syntax->datum 836 (syntax-parse #'([(e f g) (h i) (j k) (l m n o)] 837 [(1 2 3) #:kw (a b) #:kw]) 838 [((({~and {~or wᵢ:id #:k}} ...) ...) 839 ({~and {~or (xᵢ ...) #:kw}} ...)) 840 (subtemplate (([wᵢ (?? yᵢ empty)] ...) ...))])) 841 '(([e 1/y] [f 2/y] [g 3/y]) 842 ([h h/y] [i i/y]) 843 ([j a/y] [k b/y]) 844 ([l l/y] [m m/y] [n n/y] [o o/y]))) 845 846 ;; level-1 opt + same but with all #f filled in. (yᵢ/empty ...) ... 847 (check-equal? (syntax->datum 848 (syntax-parse #'([(e f g) (h i) (j k) (l m n o)] 849 [(1 2 3) #:kw (a b) #:kw]) 850 [((({~and {~or wᵢ:id #:k}} ...) ...) 851 ({~and {~or (xᵢ ...) #:kw}} ...)) 852 (subtemplate (((?? yᵢ empty) ...) ...))])) 853 '((1/y 2/y 3/y) 854 (h/y i/y) 855 (a/y b/y) 856 (l/y m/y n/y o/y))) 857 858 ;; level-1 opt + same but with all #f filled in. yᵢ/empty ... ... 859 (check-equal? (syntax->datum 860 (syntax-parse #'([(e f g) (h i) (j k) (l m n o)] 861 [(1 2 3) #:kw (a b) #:kw]) 862 [((({~and {~or wᵢ:id #:k}} ...) ...) 863 ({~and {~or (xᵢ ...) #:kw}} ...)) 864 (subtemplate ((?? yᵢ empty) ... ...))])) 865 '(1/y 2/y 3/y 866 h/y i/y 867 a/y b/y 868 l/y m/y n/y o/y))) 869 870 871 ;; level-1 opt + same but with some level-1 #f filled in and some missing 872 (begin 873 ;; level-1 opt + same with some lvl1 filled/missing. (wᵢ ...)/empty ... 874 (check-equal? (syntax->datum 875 (syntax-parse #'([(e f g) #:k (j k) (l m n o)] 876 [(1 2 3) #:kw (a b) #:kw]) 877 [(({~and {~or (wᵢ ...) #:k}} ...) 878 ({~and {~or (xᵢ ...) #:kw}} ...)) 879 (subtemplate ({?? (wᵢ ...) empty} ...))])) 880 '((e f g) 881 empty 882 (j k) 883 (l m n o))) 884 885 ;; level-1 opt + same with some lvl1 filled/missing. (wᵢ/empty ...) ... 886 ;; Invalid because {?? wᵢ empty} ... means to iterate over the known 887 ;; elements of wᵢ, and put "empty" if one is absent. However, the whole 888 ;; sublist of wᵢ element is missing, so it does not really have a meaningful 889 ;; length for the ... 890 (check-exn 891 #rx"attribute contains non-(syntax|list) value.*#f" 892 (λ () 893 (convert-compile-time-error 894 (check-equal? (syntax->datum 895 (syntax-parse #'([(e f g) #:k (j k) (l m n o)] 896 [(1 2 3) #:kw (a b) #:kw]) 897 [(({~and {~or (wᵢ ...) #:k}} ...) 898 ({~and {~or (xᵢ ...) #:kw}} ...)) 899 (subtemplate (({?? wᵢ empty} ...) ...))])) 900 '((e f g) 901 empty 902 (j k) 903 (l m n o)))))) 904 905 ;; level-1 opt + same with some lvl1 filled/missing. ([wᵢ yᵢ] ...)/empty ... 906 (check-equal? (syntax->datum 907 (syntax-parse #'([(e f g) #:k (j k) (l m n o)] 908 [(1 2 3) #:kw (a b) #:kw]) 909 [(({~and {~or (wᵢ ...) #:k}} ...) 910 ({~and {~or (xᵢ ...) #:kw}} ...)) 911 (subtemplate ({?? ([wᵢ yᵢ] ...) empty} ...))])) 912 '(([e 1/y] [f 2/y] [g 3/y]) 913 empty 914 ([j a/y] [k b/y]) 915 ([l l/y] [m m/y] [n n/y] [o o/y]))) 916 917 ;; level-1 opt + same with some lvl1 #f filled in. (yᵢ ...)/empty ... 918 (check-equal? (syntax->datum 919 (syntax-parse #'([(e f g) #:k (j k) (l m n o)] 920 [(1 2 3) #:kw (a b) #:kw]) 921 [(({~and {~or (wᵢ ...) #:k}} ...) 922 ({~and {~or (xᵢ ...) #:kw}} ...)) 923 (subtemplate ({?? (yᵢ ...) empty} ...))])) 924 '((1/y 2/y 3/y) 925 empty 926 (a/y b/y) 927 (l/y m/y n/y o/y))) 928 929 ;; level-1 opt + same with some lvl1 #f filled in. (yᵢ ...)/empty ... 930 (check-equal? (syntax->datum 931 (syntax-parse #'([(e f g) #:k (j k) (l m n o)] 932 [(1 2 3) #:kw (a b) #:kw]) 933 [(({~and {~or (wᵢ ...) #:k}} ...) 934 ({~and {~or (xᵢ ...) #:kw}} ...)) 935 (subtemplate ({?? (?@ yᵢ ...) empty} ...))])) 936 '(1/y 2/y 3/y 937 empty 938 a/y b/y 939 l/y m/y n/y o/y)) 940 941 ;; level-1 opt + same with some lvl1 #f filled in. ([wᵢ yᵢ/empty] ...) ... 942 ;; Invalid because {?? wᵢ emptywi} ... means to iterate over the known 943 ;; elements of wᵢ, and put "empty" if one is absent. However, the whole 944 ;; sublist of wᵢ element is missing, so it does not really have a meaningful 945 ;; length for the ... 946 (check-exn 947 #rx"attribute contains non-(syntax|list) value.*#f" 948 (λ () 949 (convert-compile-time-error 950 (check-equal? (syntax->datum 951 (syntax-parse #'([(e f g) #:k (j k) (l m n o)] 952 [(1 2 3) #:kw (a b) #:kw]) 953 [(({~and {~or (wᵢ ...) #:k}} ...) 954 ({~and {~or (xᵢ ...) #:kw}} ...)) 955 (subtemplate 956 (([(?? wᵢ emptywi) (?? yᵢ empty)] ...) ...))])) 957 '(([e 1/y] [f 2/y] [g 3/y]) 958 ([emptywi empty] [emptywi empty]) 959 ([j a/y] [k b/y]) 960 ([l l/y] [m m/y] [n n/y] [o o/y])))))) 961 962 ;; level-1 opt + same with some lvl1 #f filled in. (yᵢ/empty ...) ... 963 ;; Invalid because {?? wᵢ empty} ... means to iterate over the known 964 ;; elements of wᵢ, and put "empty" if one is absent. However, the whole 965 ;; sublist of wᵢ element is missing, so it does not really have a meaningful 966 ;; length for the ... 967 (check-exn 968 #rx"attribute contains non-(syntax|list) value.*#f" 969 (λ () 970 (convert-compile-time-error 971 (check-equal? (syntax->datum 972 (syntax-parse #'([(e f g) #:k (j k) (l m n o)] 973 [(1 2 3) #:kw (a b) #:kw]) 974 [(({~and {~or (wᵢ ...) #:k}} ...) 975 ({~and {~or (xᵢ ...) #:kw}} ...)) 976 (subtemplate (((?? yᵢ empty) ...) ...))])) 977 '((1/y 2/y 3/y) 978 empty 979 (a/y b/y) 980 (l/y m/y n/y o/y)))))) 981 982 ;; level-1 opt + same with some lvl1 #f filled in. yᵢ/empty ... ... 983 ;; Invalid because {?? yᵢ empty} ... means to iterate over the known 984 ;; elements of wᵢ, and put "empty" if one is absent. However, the whole 985 ;; sublist of wᵢ element is missing, so it does not really have a meaningful 986 ;; length for the ... 987 (check-exn 988 #rx"attribute contains non-(syntax|list) value.*#f" 989 (λ () 990 (convert-compile-time-error 991 (check-equal? (syntax->datum 992 (syntax-parse #'([(e f g) #:k (j k) (l m n o)] 993 [(1 2 3) #:kw (a b) #:kw]) 994 [(({~and {~or (wᵢ ...) #:k}} ...) 995 ({~and {~or (xᵢ ...) #:kw}} ...)) 996 (subtemplate ((?? yᵢ empty) ... ...))])) 997 '(1/y 2/y 3/y 998 empty 999 a/y b/y 1000 l/y m/y n/y o/y)))))) 1001 1002 1003 ;; level-1 opt + same with some level-2 #f filled in and some missing 1004 (begin 1005 ;; level-1 opt + same with some lvl2 filled/missing. (wᵢ ...)/empty ... 1006 (check-match (syntax->datum 1007 (syntax-parse #'([(e f g) (h #:k) (j k) (l m n o)] 1008 [(1 2 3) #:kw (a b) #:kw]) 1009 [((({~and {~or wᵢ:id #:k}} ...) ...) 1010 ({~and {~or (xᵢ ...) #:kw}} ...)) 1011 (subtemplate ({?? (wᵢ ...) empty} ...))])) 1012 '((e f g) 1013 empty 1014 (j k) 1015 (l m n o))) 1016 1017 ;; level-1 opt + same with some lvl2 filled/missing. (wᵢ/empty ...) ... 1018 (check-match (syntax->datum 1019 (syntax-parse #'([(e f g) (h #:k) (j k) (l m n o)] 1020 [(1 2 3) #:kw (a b) #:kw]) 1021 [((({~and {~or wᵢ:id #:k}} ...) ...) 1022 ({~and {~or (xᵢ ...) #:kw}} ...)) 1023 (subtemplate (({?? wᵢ empty} ...) ...))])) 1024 '((e f g) 1025 (h empty) 1026 (j k) 1027 (l m n o))) 1028 1029 ;; level-1 opt + same with some lvl2 filled/missing. ([wᵢ yᵢ] ...)/empty ... 1030 (check-match (syntax->datum 1031 (syntax-parse #'([(e f g) (h #:k) (j k) (l m n o)] 1032 [(1 2 3) #:kw (a b) #:kw]) 1033 [((({~and {~or wᵢ:id #:k}} ...) ...) 1034 ({~and {~or (xᵢ ...) #:kw}} ...)) 1035 (subtemplate ({?? ([wᵢ yᵢ] ...) empty} ...))])) 1036 '(([e 1/y] [f 2/y] [g 3/y]) 1037 empty 1038 ([j a/y] [k b/y]) 1039 ([l l/y] [m m/y] [n n/y] [o o/y]))) 1040 1041 ;; level-1 opt + same but with some #f filled in. (yᵢ ...)/empty ... 1042 (check-match (syntax->datum 1043 (syntax-parse #'([(e f g) (h #:k) (j k) (l m n o)] 1044 [(1 2 3) #:kw (a b) #:kw]) 1045 [((({~and {~or wᵢ:id #:k}} ...) ...) 1046 ({~and {~or (xᵢ ...) #:kw}} ...)) 1047 (subtemplate ({?? (yᵢ ...) empty} ...))])) 1048 `((1/y 2/y 3/y) 1049 (h/y ,(? symbol? 1050 (app symbol->string (regexp #rx"xᵢ[0-9]+/y")))) 1051 (a/y b/y) 1052 (l/y m/y n/y o/y))) 1053 1054 ;; level-1 opt + same but with some #f filled in. (yᵢ ...)/empty ... 1055 (check-match (syntax->datum 1056 (syntax-parse #'([(e f g) (h #:k) (j k) (l m n o)] 1057 [(1 2 3) #:kw (a b) #:kw]) 1058 [((({~and {~or wᵢ:id #:k}} ...) ...) 1059 ({~and {~or (xᵢ ...) #:kw}} ...)) 1060 (subtemplate ({?? (?@ yᵢ ...) empty} ...))])) 1061 `(1/y 2/y 3/y 1062 h/y ,(? symbol? 1063 (app symbol->string (regexp #rx"xᵢ[0-9]+/y"))) 1064 a/y b/y 1065 l/y m/y n/y o/y)) 1066 1067 ;; level-1 opt + same but with some #f filled in. ([wᵢ yᵢ/empty] ...) ... 1068 (check-match (syntax->datum 1069 (syntax-parse #'([(e f g) (h #:k) (j k) (l m n o)] 1070 [(1 2 3) #:kw (a b) #:kw]) 1071 [((({~and {~or wᵢ:id #:k}} ...) ...) 1072 ({~and {~or (xᵢ ...) #:kw}} ...)) 1073 (subtemplate 1074 (([(?? wᵢ emptywi) (?? yᵢ empty)] ...) ...))])) 1075 `(([e 1/y] [f 2/y] [g 3/y]) 1076 ([h h/y] 1077 [emptywi 1078 ,(? symbol? 1079 (app symbol->string (regexp #rx"xᵢ[0-9]+/y")))]) 1080 ([j a/y] [k b/y]) 1081 ([l l/y] [m m/y] [n n/y] [o o/y]))) 1082 1083 ;; level-1 opt + same but with some #f filled in. (yᵢ/empty ...) ... 1084 (check-match (syntax->datum 1085 (syntax-parse #'([(e f g) (h #:k) (j k) (l m n o)] 1086 [(1 2 3) #:kw (a b) #:kw]) 1087 [((({~and {~or wᵢ:id #:k}} ...) ...) 1088 ({~and {~or (xᵢ ...) #:kw}} ...)) 1089 (subtemplate (((?? yᵢ empty) ...) ...))])) 1090 `((1/y 2/y 3/y) 1091 (h/y ,(? symbol? 1092 (app symbol->string (regexp #rx"xᵢ[0-9]+/y")))) 1093 (a/y b/y) 1094 (l/y m/y n/y o/y))) 1095 1096 ;; level-1 opt + same but with some #f filled in. yᵢ/empty ... ... 1097 (check-match (syntax->datum 1098 (syntax-parse #'([(e f g) (h #:k) (j k) (l m n o)] 1099 [(1 2 3) #:kw (a b) #:kw]) 1100 [((({~and {~or wᵢ:id #:k}} ...) ...) 1101 ({~and {~or (xᵢ ...) #:kw}} ...)) 1102 (subtemplate ((?? yᵢ empty) ... ...))])) 1103 `(1/y 2/y 3/y 1104 h/y ,(? symbol? 1105 (app symbol->string (regexp #rx"xᵢ[0-9]+/y"))) 1106 a/y b/y 1107 l/y m/y n/y o/y)))) 1108 1109 ;; Incompatible shapes of different derived attributes: 1110 (check-exn 1111 #rx"some derived variables do not have the same ellipsis shape" 1112 (λ () 1113 (convert-compile-time-error 1114 (syntax-parse #'([1 2 3] #f) 1115 [({~and {~or (xᵢ ...) #f}} ...) 1116 (subtemplate ({?? (yᵢ ...) _} ...)) ;; => ((1/y 2/y 3/y) _) 1117 (syntax-case #'([a b c] [d e]) () 1118 ;; introduces elements [d e] which were unknown when yᵢ was 1119 ;; generated: 1120 [((wᵢ ...) ...) 1121 ;; Would give ((a/z b/z c/z) (d/z e/z)), but this is 1122 ;; inconsistent with the shape of yᵢ. 1123 (subtemplate ({?? (zᵢ ...) _} ...))])])))) 1124 1125 ;; Incompatible shapes of the same attribute if it were generated at two 1126 ;; different points. 1127 (check-exn 1128 #rx"some derived variables do not have the same ellipsis shape" 1129 (λ () 1130 (syntax-parse #'([1 2 3] #f) 1131 [({~and {~or (xᵢ ...) #f}} ...) 1132 (subtemplate ({?? (yᵢ ...) _} ...)) ;; => ((1/y 2/y 3/y) _) 1133 (syntax-case #'([a b c] [d e]) () 1134 ;; introduces elements [d e] which were unknown when yᵢ was 1135 ;; generated: 1136 [((wᵢ ...) ...) 1137 ;; Would give ((a/z b/z c/z) (d/z e/z)), but this is 1138 ;; inconsistent with the shape of yᵢ. 1139 (subtemplate ({?? (yᵢ ...) _} ...))])])))