diff options
author | Dr. ERDI Gergo <gergo@erdi.hu> | 2014-08-29 21:15:22 +0800 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2014-10-27 11:04:20 -0500 |
commit | fd15d5c637a09fef913a74fc1424e3c28b1db91f (patch) | |
tree | 17401410e54a1278ccad2cbc4a57754dc1e0e5eb | |
parent | 86d240b356b9d7b595da98ec286754c8f86e45e1 (diff) | |
download | haskell-fd15d5c637a09fef913a74fc1424e3c28b1db91f.tar.gz |
Include pattern synonyms as AConLikes in the type environment,
even for simplified/boot ModDetails (fixes #9417)
(cherry picked from commit f0db1857b053597e9ac43d9ce578e5f5fa0545cb)
-rw-r--r-- | compiler/basicTypes/PatSyn.lhs | 8 | ||||
-rw-r--r-- | 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 32908f6c6d..aa5a86aa13 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 ef7661a016..5d2b6faa42 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} |