From 3b9354f16b4e3a7d8e6587a61cc17567455ed4e7 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@ccs.neu.edu>
Date: Wed, 9 Nov 2016 19:46:03 -0500
Subject: [PATCH] Handle quasi-list patterns better inside prefab struct
 patterns.

Reported by William Bowman.
---
 pkgs/racket-test/tests/match/examples.rkt    |  6 +++++
 racket/collects/racket/match/parse-quasi.rkt | 28 +++++++++++++-------
 2 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/pkgs/racket-test/tests/match/examples.rkt b/pkgs/racket-test/tests/match/examples.rkt
index d5eff15695..b91f021445 100644
--- a/pkgs/racket-test/tests/match/examples.rkt
+++ b/pkgs/racket-test/tests/match/examples.rkt
@@ -747,6 +747,12 @@
            [(cons a b) #:when (= a b) 1]
            [_ 0]))
 
+   (test-case "prefab structs and list-rest"
+              (match #s(meow 1)
+                [`#s(meow ,@(list-rest a))
+                 a])
+              (list 1))
+
    (test-case
     "robby's slow example"
     (define v
diff --git a/racket/collects/racket/match/parse-quasi.rkt b/racket/collects/racket/match/parse-quasi.rkt
index 9aac1b25c5..a944520321 100644
--- a/racket/collects/racket/match/parse-quasi.rkt
+++ b/racket/collects/racket/match/parse-quasi.rkt
@@ -25,12 +25,22 @@
         [(Null? p1) p2]
         [else (error 'match "illegal input to append-pats")]))
 
+(define hard-case?
+  (lambda (p)
+    (or (ddk? p)
+        (syntax-case p (unquote-splicing)
+          [(unquote-splicing . _) #t]
+          [_ #f]))))
+
 ;; parse stx as a quasi-pattern
 ;; parse parses unquote
 (define (parse-quasi stx parse)
   (define (pq s) (parse-quasi s parse))
   (syntax-case stx (quasiquote unquote quote unquote-splicing)
     [(unquote p) (parse #'p)]
+    [((unquote-splicing p))
+     (let ([pat (parameterize ([in-splicing? #t]) (parse #'p))])
+       pat)]
     [((unquote-splicing p) . rest)
      (let ([pat (parameterize ([in-splicing? #t]) (parse #'p))]
            [rpat (pq #'rest)])
@@ -60,18 +70,16 @@
      (let ([key (prefab-struct-key (syntax-e #'struct))]
            [pats (cdr (vector->list (struct->vector (syntax-e #'struct))))])
        (make-And (list (make-Pred #`(struct-type-make-predicate (prefab-key->struct-type '#,key #,(length pats))))
-                       (make-App #'struct->vector
-                                 (list (make-Vector (cons (make-Dummy #f) (map pq pats)))))))
-       #;
-       (make-PrefabStruct key (map pq pats)))]
+                       (if (ormap hard-case? pats)
+                           ;; hard cases
+                           (make-App #'(λ (v) (vector->list (struct->vector v)))
+                                     (list (make-Pair (make-Dummy #f) (pq pats))))
+                           ;; no hard cases, avoid creating a list
+                           (make-App #'struct->vector
+                                     (list (make-Vector (cons (make-Dummy #f) (map pq pats)))))))))]
     ;; the hard cases
     [#(p ...)
-     (ormap (lambda (p)
-              (or (ddk? p)
-                  (syntax-case p (unquote-splicing)
-                    [(unquote-splicing . _) #t]
-                    [_ #f])))
-            (syntax->list #'(p ...)))
+     (ormap hard-case? (syntax->list #'(p ...)))
      (make-And (list (make-Pred #'vector?)
                      (make-App #'vector->list
                                (list (pq (quasisyntax/loc stx (p ...)))))))]