Store IfExtNames for PatSyn matchers and wrappers in interface file.

This way, the Ids for the matchers/wrappers are reused by importing
modules, and thus unfoldings are kept.

Also updates haddock submodule to accomodate tweaks in PatSyn representation

1 files changed, 16 insertions, 12 deletions

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index fb194e045c..5462667c5b 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -60,6 +60,7 @@ import HsBinds
 
 import Control.Monad
 import System.IO.Unsafe
+import Data.Maybe (isJust)
 
 infixl 3 &&&
 \end{code}
@@ -121,13 +122,16 @@ data IfaceDecl
                    ifExtName :: Maybe FastString }
 
   | IfacePatSyn { ifName          :: OccName,           -- Name of the pattern synonym
-                  ifPatHasWrapper :: Bool,
                   ifPatIsInfix    :: Bool,
+                  ifPatMatcher    :: IfExtName,
+                  ifPatWrapper    :: Maybe IfExtName,
+                  -- Everything below is redundant,
+                  -- but needed to implement pprIfaceDecl
                   ifPatUnivTvs    :: [IfaceTvBndr],
                   ifPatExTvs      :: [IfaceTvBndr],
                   ifPatProvCtxt   :: IfaceContext,
                   ifPatReqCtxt    :: IfaceContext,
-                  ifPatArgs       :: [IfaceIdBndr],
+                  ifPatArgs       :: [IfaceType],
                   ifPatTy         :: IfaceType }
 
 -- A bit of magic going on here: there's no need to store the OccName
@@ -187,7 +191,7 @@ instance Binary IfaceDecl where
         put_ bh a3
         put_ bh a4
 
-    put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9) = do
+    put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
         putByte bh 6
         put_ bh (occNameFS name)
         put_ bh a2
@@ -198,6 +202,7 @@ instance Binary IfaceDecl where
         put_ bh a7
         put_ bh a8
         put_ bh a9
+        put_ bh a10
 
     get bh = do
         h <- getByte bh
@@ -254,8 +259,9 @@ instance Binary IfaceDecl where
                     a7 <- get bh
                     a8 <- get bh
                     a9 <- get bh
+                    a10 <- get bh
                     occ <- return $! mkOccNameFS dataName a1
-                    return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9)
+                    return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
             _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
 
 data IfaceSynTyConRhs
@@ -1016,11 +1022,6 @@ ifaceDeclImplicitBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
     dc_occ = mkClassDataConOcc cls_tc_occ
     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
 
-ifaceDeclImplicitBndrs (IfacePatSyn{ ifName = ps_occ, ifPatHasWrapper = has_wrapper })
-  = [wrap_occ | has_wrapper]
-  where
-    wrap_occ = mkDataConWrapperOcc ps_occ  -- Id namespace
-
 ifaceDeclImplicitBndrs _ = []
 
 -- -----------------------------------------------------------------------------
@@ -1104,7 +1105,7 @@ pprIfaceDecl (IfaceAxiom {ifName = name, ifTyCon = tycon, ifAxBranches = branche
   = hang (ptext (sLit "axiom") <+> ppr name <> dcolon)
        2 (vcat $ map (pprAxBranch $ Just tycon) branches)
 
-pprIfaceDecl (IfacePatSyn { ifName = name, ifPatHasWrapper = has_wrap,
+pprIfaceDecl (IfacePatSyn { ifName = name, ifPatWrapper = wrapper,
                             ifPatIsInfix = is_infix,
                             ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs,
                             ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
@@ -1112,7 +1113,8 @@ pprIfaceDecl (IfacePatSyn { ifName = name, ifPatHasWrapper = has_wrap,
                             ifPatTy = ty })
   = pprPatSynSig name has_wrap args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt)
   where
-    args' = case (is_infix, map snd args) of
+    has_wrap = isJust wrapper
+    args' = case (is_infix, args) of
         (True, [left_ty, right_ty]) ->
             InfixPatSyn (pprParendIfaceType left_ty) (pprParendIfaceType right_ty)
         (_, tys) ->
@@ -1393,11 +1395,13 @@ freeNamesIfDecl d@IfaceAxiom{} =
   freeNamesIfTc (ifTyCon d) &&&
   fnList freeNamesIfAxBranch (ifAxBranches d)
 freeNamesIfDecl d@IfacePatSyn{} =
+  unitNameSet (ifPatMatcher d) &&&
+  maybe emptyNameSet unitNameSet (ifPatWrapper d) &&&
   freeNamesIfTvBndrs (ifPatUnivTvs d) &&&
   freeNamesIfTvBndrs (ifPatExTvs d) &&&
   freeNamesIfContext (ifPatProvCtxt d) &&&
   freeNamesIfContext (ifPatReqCtxt d) &&&
-  fnList freeNamesIfType (map snd (ifPatArgs d)) &&&
+  fnList freeNamesIfType (ifPatArgs d) &&&
   freeNamesIfType (ifPatTy d)
 
 freeNamesIfAxBranch :: IfaceAxBranch -> NameSet