HsPat: Assume that no spliced patterns are irrefutable
authorBen Gamari <bgamari.foss@gmail.com>
Thu, 20 Jul 2017 23:24:00 +0000 (19:24 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 20 Jul 2017 23:24:01 +0000 (19:24 -0400)
This is a conservative assumption which will limit some uses of spliced
patterns, but it fixes #13984.

Test Plan: Validate

Reviewers: RyanGlScott, AaronFriel, austin

Reviewed By: RyanGlScott

Subscribers: rwbarton, thomie

GHC Trac Issues: #13984

Differential Revision: https://phabricator.haskell.org/D3766

compiler/hsSyn/HsPat.hs
testsuite/tests/typecheck/should_compile/T13984.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index 93ad9ec..f7d1876 100644 (file)
@@ -620,7 +620,7 @@ isIrrefutableHsPat pat
     go1 (SigPatOut pat _)   = go pat
     go1 (TuplePat pats _ _) = all go pats
     go1 (SumPat pat _ _  _) = go pat
-    go1 (ListPat {}) = False
+    go1 (ListPat {})        = False
     go1 (PArrPat {})        = False     -- ?
 
     go1 (ConPatIn {})       = False     -- Conservative
@@ -632,15 +632,13 @@ isIrrefutableHsPat pat
     go1 (ConPatOut{ pat_con = L _ (PatSynCon _pat) })
         = False -- Conservative
 
-    go1 (LitPat {})    = False
-    go1 (NPat {})      = False
-    go1 (NPlusKPat {}) = False
+    go1 (LitPat {})         = False
+    go1 (NPat {})           = False
+    go1 (NPlusKPat {})      = False
 
-    -- Both should be gotten rid of by renamer before
-    -- isIrrefutablePat is called
-    go1 (SplicePat {})     = urk pat
-
-    urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
+    -- We conservatively assume that no TH splices are irrefutable
+    -- since we cannot know until the splice is evaluated.
+    go1 (SplicePat {})      = False
 
 hsPatNeedsParens :: Pat a -> Bool
 hsPatNeedsParens (NPlusKPat {})      = True
diff --git a/testsuite/tests/typecheck/should_compile/T13984.hs b/testsuite/tests/typecheck/should_compile/T13984.hs
new file mode 100644 (file)
index 0000000..a17e48c
--- /dev/null
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Panic where
+
+import Language.Haskell.TH
+
+expr :: IO Exp
+expr = runQ $ do
+  name <- newName "foo"
+  [| do $(varP name) <- pure (); pure () |]
index ee37b9a..2ce4e91 100644 (file)
@@ -570,3 +570,4 @@ test('T13879', normal, compile, [''])
 test('T13881', normal, compile, [''])
 test('T13915a', normal, multimod_compile, ['T13915a', '-v0'])
 test('T13915b', normal, compile, [''])
+test('T13984', normal, compile, [''])