diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/basicTypes/Id.hs | 5 | ||||
| -rw-r--r-- | compiler/typecheck/TcPatSyn.hs | 7 |
2 files changed, 9 insertions, 3 deletions
diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index fa34a4fd78..ccd6c9b494 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -314,6 +314,7 @@ We use mkExportedLocalId for things like - Dictionary functions (DFunId) - Wrapper and matcher Ids for pattern synonyms - Default methods for classes + - Pattern-synonym matcher and builder Ids - etc They marked as "exported" in the sense that they should be kept alive @@ -329,7 +330,9 @@ of reasons: dependency analysis (e.g. CoreFVs.exprFreeVars). * Look them up in the current substitution when we come across - occurrences of them (in Subst.lookupIdSubst) + occurrences of them (in Subst.lookupIdSubst). Lacking this we + can get an out-of-date unfolding, which can in turn make the + simplifier go into an infinite loop (Trac #9857) * Ensure that for dfuns that the specialiser does not float dict uses above their defns, which would prevent good simplifications happening. diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 9cc49111ac..65339818fe 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -26,6 +26,7 @@ import Outputable import FastString import Var import Id +import IdInfo( IdDetails(..) ) import TcBinds import BasicTypes import TcSimplify @@ -254,7 +255,8 @@ tcPatSynMatcher (L loc name) lpat ; let matcher_tau = mkFunTys [pat_ty, cont_ty, fail_ty] res_ty matcher_sigma = mkSigmaTy (res_tv:univ_tvs) req_theta matcher_tau - matcher_id = mkVanillaGlobal matcher_name matcher_sigma + matcher_id = mkExportedLocalId VanillaId matcher_name matcher_sigma + -- See Note [Exported LocalIds] in Id cont_dicts = map nlHsVar prov_dicts cont' = mkLHsWrap (mkWpLet prov_ev_binds) $ @@ -326,7 +328,8 @@ mkPatSynBuilderId dir (L _ name) qtvs theta arg_tys pat_ty | otherwise = do { builder_name <- newImplicitBinder name mkDataConWorkerOcc ; let builder_sigma = mkSigmaTy qtvs theta (mkFunTys builder_arg_tys pat_ty) - builder_id = mkVanillaGlobal builder_name builder_sigma + builder_id = mkExportedLocalId VanillaId builder_name builder_sigma + -- See Note [Exported LocalIds] in Id ; return (Just (builder_id, need_dummy_arg)) } where builder_arg_tys | need_dummy_arg = [voidPrimTy] |