diff options
Diffstat (limited to 'compiler/GHC/Tc/Utils/Zonk.hs')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Zonk.hs | 48 |
1 files changed, 20 insertions, 28 deletions
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index 45e6ec9a02..b0af88d813 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -778,34 +778,11 @@ zonkExpr env (HsAppType ty e t) return (HsAppType new_ty new_e t) -- NB: the type is an HsType; can't zonk that! --- romes TODO: refactor common -zonkExpr env (HsTypedBracket (HsBracketTc hsb_thing ty wrap bs) body) - = do wrap' <- traverse zonkQuoteWrap wrap - bs' <- mapM (zonk_b env) bs - new_ty <- zonkTcTypeToTypeX env ty - return (HsTypedBracket (HsBracketTc hsb_thing new_ty wrap' bs') body) - where - zonkQuoteWrap (QuoteWrapper ev ty) = do - let ev' = zonkIdOcc env ev - ty' <- zonkTcTypeToTypeX env ty - return (QuoteWrapper ev' ty') - - zonk_b env' (PendingTcSplice n e) = do e' <- zonkLExpr env' e - return (PendingTcSplice n e') - -zonkExpr env (HsUntypedBracket (HsBracketTc hsb_thing ty wrap bs) body) - = do wrap' <- traverse zonkQuoteWrap wrap - bs' <- mapM (zonk_b env) bs - new_ty <- zonkTcTypeToTypeX env ty - return (HsUntypedBracket (HsBracketTc hsb_thing new_ty wrap' bs') body) - where - zonkQuoteWrap (QuoteWrapper ev ty) = do - let ev' = zonkIdOcc env ev - ty' <- zonkTcTypeToTypeX env ty - return (QuoteWrapper ev' ty') +zonkExpr env (HsTypedBracket hsb_tc body) + = (\x -> HsTypedBracket x body) <$> zonkBracket env hsb_tc - zonk_b env' (PendingTcSplice n e) = do e' <- zonkLExpr env' e - return (PendingTcSplice n e') +zonkExpr env (HsUntypedBracket hsb_tc body) + = (\x -> HsUntypedBracket x body) <$> zonkBracket env hsb_tc zonkExpr env (HsSpliceE _ (XSplice (HsSplicedT s))) = runTopSplice s >>= zonkExpr env @@ -1102,6 +1079,22 @@ zonkOverLit env lit@(OverLit {ol_ext = x@OverLitTc { ol_witness = e, ol_type = t , ol_type = ty' } }) } ------------------------------------------------------------------------- +zonkBracket :: ZonkEnv -> HsBracketTc -> TcM HsBracketTc +zonkBracket env (HsBracketTc hsb_thing ty wrap bs) + = do wrap' <- traverse zonkQuoteWrap wrap + bs' <- mapM (zonk_b env) bs + new_ty <- zonkTcTypeToTypeX env ty + return (HsBracketTc hsb_thing new_ty wrap' bs') + where + zonkQuoteWrap (QuoteWrapper ev ty) = do + let ev' = zonkIdOcc env ev + ty' <- zonkTcTypeToTypeX env ty + return (QuoteWrapper ev' ty') + + zonk_b env' (PendingTcSplice n e) = do e' <- zonkLExpr env' e + return (PendingTcSplice n e') + +------------------------------------------------------------------------- zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc) zonkArithSeq env (From e) @@ -1124,7 +1117,6 @@ zonkArithSeq env (FromThenTo e1 e2 e3) new_e3 <- zonkLExpr env e3 return (FromThenTo new_e1 new_e2 new_e3) - ------------------------------------------------------------------------- zonkStmts :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA => ZonkEnv |