WIP on #18247wip/T18247

It is related to deserialising data from a .hi file, I think the
correct solution is to dereference the Avails to the actual
declarations.

4 files changed, 278 insertions, 0 deletions

diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 9e7f1a4216..e7dc04ed09 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1644,6 +1644,7 @@ to_ie_post_rn_var (L l n)
 to_ie_post_rn :: (HasOccName name) => Located name -> LIEWrappedName name
 to_ie_post_rn (L l n)
   | isTcOcc occ && isSymOcc occ = L l (IEType (L l n))
+  | isDataOcc occ               = L l (IEPattern (L l n))
   | otherwise                   = L l (IEName (L l n))
   where occ = occName n
 
diff --git a/testsuite/tests/printer/T18247a.hs b/testsuite/tests/printer/T18247a.hs
new file mode 100644
index 0000000000..ec3e840525
--- /dev/null
+++ b/testsuite/tests/printer/T18247a.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module T18247a where
+
+import Control.Monad (guard)
+import qualified Data.Sequence as Seq
+
+import T18247b
+
+-- pattern P = 42
+
+useP P = 43
+
+--
+
+{-
+data Type = App String [Type]
+
+pattern Arrow :: Type -> Type -> Type
+pattern Arrow t1 t2 = App "->" [t1, t2]
+
+pattern Int = App "Int" []
+
+pattern Maybe t = App "Maybe" [t]
+
+-}
+
+collectArgs :: Type -> [Type]
+collectArgs (Arrow t1 t2) = t1 : collectArgs t2
+collectArgs _ = []
+
+isInt :: Type -> Bool
+isInt Int = True
+isInt _ = False
+
+isIntEndo :: Type -> Bool
+isIntEndo (Arrow Int Int) = True
+isIntEndo _ = False
+
+arrows :: [Type] -> Type -> Type
+arrows = flip $ foldr Arrow
+
+--
+{-
+
+pattern Empty <- (Seq.viewl -> Seq.EmptyL)
+pattern x :< xs <- (Seq.viewl -> x Seq.:< xs)
+pattern xs :> x <- (Seq.viewr -> xs Seq.:> x)
+-}
+
+viewPL (x :< Empty) = x
+viewPR (Empty :> y) = y
+
+--
+
+{-
+pattern Succ n <-
+  (\x -> (x -1) <$ guard (x > 0) -> Just n)
+  where
+    Succ n = n + 1
+-}
+
+fac (Succ n) = Succ n * fac n
+fac 0 = 1
+
+--
+
+{-
+data Showable where
+  MkShowable :: (Show a) => a -> Showable
+
+-- Required context is empty, but provided context is not
+pattern Sh :: () => (Show a) => a -> Showable
+pattern Sh x <- MkShowable x
+-}
+
+showable :: (Show a) => a -> Showable
+showable x = MkShowable x
+
+--
+
+{-
+-- Provided context is empty
+pattern One :: (Num a, Eq a) => a
+pattern One <- 1
+-}
+
+one One = 2
+
+--
+
+
+--pattern Pair x y <- [x, y]
+
+
+f (Pair True True) = True
+f _ = False
+
+g [True, True] = True
+g _ = False
+
+
+--
+{-
+data Nat = Z | S Nat deriving (Show)
+
+pattern Ess p = S p
+-}
+
+two = S ( S Z)
+
+--
+
+-- pattern Single x = [x]
+
+-- pattern Head x <- x : xs
+
+single (Single x) = x
+hd :: [a] -> a
+hd (Head x) = x
+
+--
+
+{-
+data T a where
+  MkT :: (Show b) => a -> b -> T a
+
+pattern ExNumPat x = MkT 42 x
+-}
+
+h :: (Num t, Eq t) => T t -> String
+h (ExNumPat x) = show x
diff --git a/testsuite/tests/printer/T18247b.hs b/testsuite/tests/printer/T18247b.hs
new file mode 100644
index 0000000000..6fc2aebd51
--- /dev/null
+++ b/testsuite/tests/printer/T18247b.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module T18247b where
+
+import Control.Monad (guard)
+import qualified Data.Sequence as Seq
+
+pattern P = 42
+
+--useP P = 43
+
+--
+
+data Type = App String [Type]
+
+pattern Arrow :: Type -> Type -> Type
+pattern Arrow t1 t2 = App "->" [t1, t2]
+
+pattern Int = App "Int" []
+
+pattern Maybe t = App "Maybe" [t]
+
+
+{-
+collectArgs :: Type -> [Type]
+collectArgs (Arrow t1 t2) = t1 : collectArgs t2
+collectArgs _ = []
+
+isInt :: Type -> Bool
+isInt Int = True
+isInt _ = False
+
+isIntEndo :: Type -> Bool
+isIntEndo (Arrow Int Int) = True
+isIntEndo _ = False
+
+arrows :: [Type] -> Type -> Type
+arrows = flip $ foldr Arrow
+-}
+
+--
+
+
+pattern Empty <- (Seq.viewl -> Seq.EmptyL)
+pattern x :< xs <- (Seq.viewl -> x Seq.:< xs)
+pattern xs :> x <- (Seq.viewr -> xs Seq.:> x)
+
+{-
+viewPL (x :< Empty) = x
+viewPR (Empty :> y) = y
+-}
+
+--
+
+
+pattern Succ n <-
+  (\x -> (x -1) <$ guard (x > 0) -> Just n)
+  where
+    Succ n = n + 1
+
+{-
+fac (Succ n) = Succ n * fac n
+fac 0 = 1
+-}
+
+--
+
+
+data Showable where
+  MkShowable :: (Show a) => a -> Showable
+
+-- Required context is empty, but provided context is not
+pattern Sh :: () => (Show a) => a -> Showable
+pattern Sh x <- MkShowable x
+
+{-
+showable :: (Show a) => a -> Showable
+showable x = MkShowable x
+-}
+
+--
+
+
+-- Provided context is empty
+pattern One :: (Num a, Eq a) => a
+pattern One <- 1
+
+
+-- one One = 2
+
+--
+
+
+pattern Pair x y <- [x, y]
+
+
+
+{-
+f (Pair True True) = True
+f _ = False
+
+g [True, True] = True
+g _ = False
+-}
+
+
+
+--
+
+data Nat = Z | S Nat deriving (Show)
+
+pattern Ess p = S p
+
+
+--two = S ( S Z)
+
+--
+
+pattern Single x = [x]
+
+pattern Head x <- x : xs
+
+{- single (Single x) = x
+hd :: [a] -> a
+hd (Head x) = x
+-}
+
+--
+
+
+data T a where
+  MkT :: (Show b) => a -> b -> T a
+
+pattern ExNumPat x = MkT 42 x
+
+{-
+h :: (Num t, Eq t) => T t -> String
+h (ExNumPat x) = show x
+-}
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index 597f83aa9c..daaf1e12a4 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -59,3 +59,5 @@ test('T14343b', normal, compile_fail, [''])
 test('T15761', normal, compile_fail, [''])
 test('T18052a', normal, compile,
      ['-ddump-simpl -ddump-types -dno-typeable-binds -dsuppress-uniques'])
+test('T18247a', normal, compile,
+     ['-ddump-minimal-imports -fforce-recomp -dsuppress-uniques'])