diff options
Diffstat (limited to 'compiler/deSugar/DsBinds.hs')
| -rw-r--r-- | compiler/deSugar/DsBinds.hs | 16 |
1 files changed, 9 insertions, 7 deletions
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 26aebe9363..2a0abca5de 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -11,6 +11,7 @@ lower levels it is preserved with @let@/@letrec@s). -} {-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec, dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds, dsMkUserRule @@ -73,7 +74,7 @@ import Control.Monad -- | Desugar top level binds, strict binds are treated like normal -- binds since there is no good time to force before first usage. -dsTopLHsBinds :: LHsBinds Id -> DsM (OrdList (Id,CoreExpr)) +dsTopLHsBinds :: LHsBinds GhcTc -> DsM (OrdList (Id,CoreExpr)) dsTopLHsBinds binds -- see Note [Strict binds checks] | not (isEmptyBag unlifted_binds) || not (isEmptyBag bang_binds) @@ -102,7 +103,7 @@ dsTopLHsBinds binds -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] -dsLHsBinds :: LHsBinds Id -> DsM ([Id], [(Id,CoreExpr)]) +dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { MASSERT( allBag (not . isUnliftedHsBind . unLoc) binds ) ; ds_bs <- mapBagM dsLHsBind binds @@ -110,14 +111,14 @@ dsLHsBinds binds id ([], []) ds_bs) } ------------------------ -dsLHsBind :: LHsBind Id +dsLHsBind :: LHsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs loc $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). dsHsBind :: DynFlags - -> HsBind Id + -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) -- ^ The Ids of strict binds, to be forced in the body of the -- binding group see Note [Desugar Strict binds] and all @@ -275,7 +276,7 @@ dsHsBind dflags ,(poly_tup_id, poly_tup_rhs) : concat export_binds_s) } where - inline_env :: IdEnv Id -- Maps a monomorphic local Id to one with + inline_env :: IdEnv Id -- Maps a monomorphic local Id to one with -- the inline pragma from the source -- The type checker put the inline pragma -- on the *global* Id, so we need to transfer it @@ -302,7 +303,7 @@ dsHsBind dflags [] lcls -- find exports or make up new exports for force variables - get_exports :: [Id] -> DsM ([Id], [ABExport Id]) + get_exports :: [Id] -> DsM ([Id], [ABExport GhcTc]) get_exports lcls = foldM (\(glbls, exports) lcl -> case lookupVarEnv global_env lcl of @@ -373,7 +374,8 @@ dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind" -- the unfolding in the interface file is made in `TidyPgm.addExternal` -- using this information. ------------------------ -makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr) +makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr + -> (Id, CoreExpr) makeCorePair dflags gbl_id is_default_method dict_arity rhs | is_default_method -- Default methods are *always* inlined = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs) |