diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Gen/Head.hs | 15 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Instantiate.hs | 13 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Zonk.hs | 10 |
3 files changed, 18 insertions, 20 deletions
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs index cd43111123..78f9b0265a 100644 --- a/compiler/GHC/Tc/Gen/Head.hs +++ b/compiler/GHC/Tc/Gen/Head.hs @@ -6,6 +6,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] +{-# LANGUAGE DisambiguateRecordFields #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -74,7 +75,6 @@ import GHC.Types.SrcLoc import GHC.Utils.Misc import GHC.Data.Maybe import GHC.Utils.Outputable as Outputable -import GHC.Utils.Panic import GHC.Utils.Panic.Plain import Control.Monad @@ -633,8 +633,8 @@ CLong, as it should. tcInferOverLit :: HsOverLit GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) tcInferOverLit lit@(OverLit { ol_val = val - , ol_witness = HsVar _ (L loc from_name) - , ol_ext = rebindable }) + , ol_ext = OverLitRn { ol_rebindable = rebindable + , ol_from_fun = L loc from_name } }) = -- Desugar "3" to (fromInteger (3 :: Integer)) -- where fromInteger is gotten by looking up from_name, and -- the (3 :: Integer) is returned by mkOverLit @@ -651,8 +651,10 @@ tcInferOverLit lit@(OverLit { ol_val = val HsLit noAnn hs_lit from_expr = mkHsWrap (wrap2 <.> wrap1) $ HsVar noExtField (L loc from_id) - lit' = lit { ol_witness = HsApp noAnn (L (l2l loc) from_expr) lit_expr - , ol_ext = OverLitTc rebindable res_ty } + witness = HsApp noAnn (L (l2l loc) from_expr) lit_expr + lit' = lit { ol_ext = OverLitTc { ol_rebindable = rebindable + , ol_witness = witness + , ol_type = res_ty } } ; return (HsOverLit noAnn lit', res_ty) } where orig = LiteralOrigin lit @@ -660,9 +662,6 @@ tcInferOverLit lit@(OverLit { ol_val = val herald = sep [ text "The function" <+> quotes (ppr from_name) , text "is applied to"] -tcInferOverLit lit - = pprPanic "tcInferOverLit" (ppr lit) - {- ********************************************************************* * * diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs index a80dfb71a5..73c62839e3 100644 --- a/compiler/GHC/Tc/Utils/Instantiate.hs +++ b/compiler/GHC/Tc/Utils/Instantiate.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DisambiguateRecordFields #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -677,8 +678,8 @@ newNonTrivialOverloadedLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (HsOverLit GhcTc) newNonTrivialOverloadedLit - lit@(OverLit { ol_val = val, ol_witness = HsVar _ (L _ meth_name) - , ol_ext = rebindable }) res_ty + lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable (L _ meth_name) }) + res_ty = do { hs_lit <- mkOverLit val ; let lit_ty = hsLitType hs_lit ; (_, fi') <- tcSyntaxOp orig (mkRnSyntaxExpr meth_name) @@ -686,14 +687,12 @@ newNonTrivialOverloadedLit \_ _ -> return () ; let L _ witness = nlHsSyntaxApps fi' [nlHsLit hs_lit] ; res_ty <- readExpType res_ty - ; return (lit { ol_witness = witness - , ol_ext = OverLitTc rebindable res_ty }) } + ; return (lit { ol_ext = OverLitTc { ol_rebindable = rebindable + , ol_witness = witness + , ol_type = res_ty } }) } where orig = LiteralOrigin lit -newNonTrivialOverloadedLit lit _ - = pprPanic "newNonTrivialOverloadedLit" (ppr lit) - ------------ mkOverLit ::OverLitVal -> TcM (HsLit GhcTc) mkOverLit (HsIntegral i) diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index 49d2885c5e..963fe9f9b1 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -122,15 +122,14 @@ to short-cut the process for built-in types. We can do this in two places; -} tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc)) -tcShortCutLit lit@(OverLit { ol_val = val, ol_ext = rebindable }) exp_res_ty +tcShortCutLit lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable _}) exp_res_ty | not rebindable , Just res_ty <- checkingExpType_maybe exp_res_ty = do { dflags <- getDynFlags ; let platform = targetPlatform dflags ; case shortCutLit platform val res_ty of Just expr -> return $ Just $ - lit { ol_witness = expr - , ol_ext = OverLitTc False res_ty } + lit { ol_ext = OverLitTc False expr res_ty } Nothing -> return Nothing } | otherwise = return Nothing @@ -1088,10 +1087,11 @@ zonkCoFn env (WpMultCoercion co) = do { co' <- zonkCoToCo env co ------------------------------------------------------------------------- zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc) -zonkOverLit env lit@(OverLit {ol_ext = OverLitTc r ty, ol_witness = e }) +zonkOverLit env lit@(OverLit {ol_ext = x@OverLitTc { ol_witness = e, ol_type = ty } }) = do { ty' <- zonkTcTypeToTypeX env ty ; e' <- zonkExpr env e - ; return (lit { ol_witness = e', ol_ext = OverLitTc r ty' }) } + ; return (lit { ol_ext = x { ol_witness = e' + , ol_type = ty' } }) } ------------------------------------------------------------------------- zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc) |