diff options
Diffstat (limited to 'compiler/GHC/Tc/Gen/Match.hs')
| -rw-r--r-- | compiler/GHC/Tc/Gen/Match.hs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index 8e97476211..a92e015ac7 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -79,7 +79,7 @@ import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name import GHC.Types.Id import GHC.Types.SrcLoc -import GHC.Types.Basic (Origin (..)) +import GHC.Types.Basic (Origin (..), GenReason (..)) import qualified GHC.LanguageExtensions as LangExt import Control.Monad @@ -1256,7 +1256,7 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) expand_stmts <- expand_do_stmts do_or_lc lstmts return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ e - , mkHsLam [pat] (noLocA $ PopSrcSpan expand_stmts) -- (\ x -> stmts') + , mkHsLamDoExp [pat] (noLocA $ PopSrcSpan expand_stmts) -- (\ x -> stmts') ] expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = @@ -1298,7 +1298,7 @@ expand_do_stmts do_or_lc do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) - , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> + , mkHsLamDoExp [ mkBigLHsVarPatTup all_ids ] -- (\ x -> (noLocA $ PopSrcSpan expand_stmts) -- stmts') ] where @@ -1316,7 +1316,7 @@ expand_do_stmts do_or_lc do_block :: LHsExpr GhcRn do_block = wrapGenSpan $ HsDo noExtField (DoExpr Nothing) $ do_stmts mfix_expr :: LHsExpr GhcRn - mfix_expr = mkHsLam [ wrapGenSpan (LazyPat noExtField $ mkBigLHsVarPatTup all_ids) ] $ do_block + mfix_expr = mkHsLamDoExp [ wrapGenSpan (LazyPat noExtField $ mkBigLHsVarPatTup all_ids) ] $ do_block -- LazyPat becuase we do not want to eagerly evaluate the pattern -- and potentially loop forever @@ -1391,7 +1391,7 @@ mk_failable_lexpr_tcm pat lexpr fail_op = ; if b -- don't decorate with fail statement if -- 1) the pattern is irrefutable - then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) + then return $ mkHsLamDoExp [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } @@ -1401,7 +1401,7 @@ mk_failable_lexpr_tcm pat lexpr fail_op = mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ + return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ (noLocA [ mkHsCaseAlt pat (noLocA $ PopSrcSpan lexpr) -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op |