[commit: ghc] ghc-7.8: Include pattern synonyms as AConLikes in the type environment, even for simplified/boot ModDetails (fixes #9417) (fd15d5c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/fd15d5c637a09fef913a74fc1424e3c28b1db91f/ghc

>---------------------------------------------------------------

commit fd15d5c637a09fef913a74fc1424e3c28b1db91f
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Fri Aug 29 21:15:22 2014 +0800

    Include pattern synonyms as AConLikes in the type environment,
    even for simplified/boot ModDetails (fixes #9417)
    
    (cherry picked from commit f0db1857b053597e9ac43d9ce578e5f5fa0545cb)


>---------------------------------------------------------------

fd15d5c637a09fef913a74fc1424e3c28b1db91f
 compiler/basicTypes/PatSyn.lhs |  8 +-------
 compiler/main/TidyPgm.lhs      | 15 +++++++++------
 2 files changed, 10 insertions(+), 13 deletions(-)

diff --git a/compiler/basicTypes/PatSyn.lhs b/compiler/basicTypes/PatSyn.lhs
index 32908f6..aa5a86a 100644
--- a/compiler/basicTypes/PatSyn.lhs
+++ b/compiler/basicTypes/PatSyn.lhs
@@ -16,7 +16,7 @@ module PatSyn (
         patSynWrapper, patSynMatcher,
         patSynExTyVars, patSynSig,
         patSynInstArgTys, patSynInstResTy,
-        tidyPatSynIds, patSynIds
+        tidyPatSynIds
     ) where
 
 #include "HsVersions.h"
@@ -266,12 +266,6 @@ patSynWrapper = psWrapper
 patSynMatcher :: PatSyn -> Id
 patSynMatcher = psMatcher
 
-patSynIds :: PatSyn -> [Id]
-patSynIds (MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id })
-  = case mb_wrap_id of
-      Nothing      -> [match_id]
-      Just wrap_id -> [match_id, wrap_id]
-
 tidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn
 tidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id })
   = ps { psMatcher = tidy_fn match_id, psWrapper = fmap tidy_fn mb_wrap_id }
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index ef7661a..5d2b6fa 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -139,12 +139,12 @@ mkBootModDetailsTc hsc_env
         ; showPass dflags CoreTidy
 
         ; let { insts'      = map (tidyClsInstDFun globaliseAndTidyId) insts
-              ; pat_syns'   = map (tidyPatSynIds   globaliseAndTidyId) pat_syns
-              ; dfun_ids    = map instanceDFunId insts'
-              ; pat_syn_ids = concatMap patSynIds pat_syns'
               ; type_env1  = mkBootTypeEnv (availsToNameSet exports)
                                            (typeEnvIds type_env) tcs fam_insts
-              ; type_env'  = extendTypeEnvWithIds type_env1 (pat_syn_ids ++ dfun_ids)
+              ; pat_syns'   = map (tidyPatSynIds   globaliseAndTidyId) pat_syns
+              ; type_env2  = extendTypeEnvWithPatSyns pat_syns' type_env1
+              ; dfun_ids    = map instanceDFunId insts'
+              ; type_env'  = extendTypeEnvWithIds type_env2 dfun_ids
               }
         ; return (ModDetails { md_types     = type_env'
                              , md_insts     = insts'
@@ -357,8 +357,7 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                 -- This is really the only reason we keep mg_patsyns at all; otherwise
                 -- they could just stay in type_env
               ; tidy_patsyns = map (tidyPatSynIds (lookup_aux_id tidy_type_env)) patsyns
-              ; type_env2    = extendTypeEnvList type_env1
-                                    [AConLike (PatSynCon ps) | ps <- tidy_patsyns ]
+              ; type_env2    = extendTypeEnvWithPatSyns tidy_patsyns type_env1
 
               ; tidy_type_env = tidyTypeEnv omit_prags type_env2
 
@@ -454,6 +453,10 @@ trimThing (AnId id)
 
 trimThing other_thing
   = other_thing
+
+extendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv
+extendTypeEnvWithPatSyns tidy_patsyns type_env
+  = extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ]
 \end{code}
 
 \begin{code}