diff options
| author | Apoorv Ingle <apoorv-ingle@uiowa.edu> | 2023-03-24 20:12:15 -0500 |
|---|---|---|
| committer | Apoorv Ingle <apoorv-ingle@uiowa.edu> | 2023-04-20 19:06:32 -0500 |
| commit | 54a24d20b86d3f881363b77451bb8a41193ed668 (patch) | |
| tree | 8925f30cdccf173e598ab0c7a4f6a71895b76280 | |
| parent | d587a706cbdef340d5a54c582e4bef14864e1911 (diff) | |
| download | haskell-54a24d20b86d3f881363b77451bb8a41193ed668.tar.gz | |
do not add explicit return for `mfix` mdo blocks. This whole last stmt business is very messy.
| -rw-r--r-- | compiler/GHC/HsToCore/Docs.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Match.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Module.hs | 4 |
3 files changed, 9 insertions, 8 deletions
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs index f162dadaf5..40771d4998 100644 --- a/compiler/GHC/HsToCore/Docs.hs +++ b/compiler/GHC/HsToCore/Docs.hs @@ -345,11 +345,11 @@ subordinates env instMap decl = case decl of InstD _ (ClsInstD _ d) -> let data_fams = do DataFamInstDecl { dfid_eqn = - FamEqn { feqn_tycon = L l _ - , feqn_rhs = defn }} <- unLoc <$> cid_datafam_insts d + (FamEqn { feqn_tycon = L l _ + , feqn_rhs = defn } :: FamEqn GhcRn (HsDataDefn GhcRn))} <- unLoc <$> cid_datafam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn ty_fams = do - TyFamInstDecl { tfid_eqn = FamEqn { feqn_tycon = L l _ } } <- unLoc <$> cid_tyfam_insts d + TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ } :: FamEqn GhcRn (LHsType GhcRn)) } <- unLoc <$> cid_tyfam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] in data_fams ++ ty_fams diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index b63d4a431d..ab5247a34e 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -1296,14 +1296,15 @@ expand_do_stmts do_or_lc return_stmt :: ExprLStmt GhcRn return_stmt = noLocA $ LastStmt noExtField - (mkHsApp (noLocA return_fun) - $ mkBigLHsTup (map nlHsVar all_ids) noExtField) + (-- mkHsApp (noLocA return_fun) + -- $ + mkBigLHsTup (map nlHsVar all_ids) noExtField) Nothing (SyntaxExprRn return_fun) do_stmts :: XRec GhcRn [ExprLStmt GhcRn] do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] do_block :: LHsExpr GhcRn - do_block = noLocA $ HsDo noExtField (DoExpr Nothing) $ do_stmts + do_block = noLocA $ HsDo noExtField (MDoExpr Nothing) $ do_stmts mfix_expr :: LHsExpr GhcRn mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index 1b02340061..935270497c 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -704,7 +704,7 @@ tcRnHsBootDecls hsc_src decls , hs_defds = def_decls , hs_ruleds = rule_decls , hs_annds = _ - , hs_valds = XValBindsLR (NValBinds val_binds val_sigs) }) + , hs_valds = (XValBindsLR (NValBinds val_binds val_sigs) :: HsValBinds GhcRn ) }) <- rnTopSrcDecls first_group -- The empty list is for extra dependencies coming from .hs-boot files @@ -1602,7 +1602,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, -- and import the supporting declarations traceTc "Tc3" empty ; (tcg_env, inst_infos, th_bndrs, - XValBindsLR (NValBinds deriv_binds deriv_sigs)) + (XValBindsLR (NValBinds deriv_binds deriv_sigs) :: HsValBinds GhcRn)) <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ; updLclEnv (\tcl_env -> tcl_env { tcl_th_bndrs = th_bndrs `plusNameEnv` tcl_th_bndrs tcl_env }) $ |