Simon Peyton Jones pushed to branch wip/ani/no-ds-flag-cache at Glasgow Haskell Compiler / GHC Commits: b5adc452 by Simon Peyton Jones at 2026-03-30T17:45:43+01:00 More wibbles - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - − compiler/GHC/Tc/Gen/App.hs-boot - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -11,7 +11,6 @@ module GHC.Tc.Gen.App ( tcApp - , tcExprSigma , tcExprPrag ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr ) @@ -165,34 +164,6 @@ Note [Instantiation variables are short lived] -} -{- ********************************************************************* -* * - tcInferSigma -* * -********************************************************************* -} - --- Very similar to tcApp, but returns a sigma (uninstantiated) type --- CAUTION: Any changes to tcApp should be reflected here --- cf. T19167. the head is an expanded expression applied to a type --- Caution: Currently we assume that the expression is compiler generated/expanded --- Because that is what T19167 test case expects. --- This function should go away after MR!15778 lands -tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) -tcExprSigma inst fun_orig rn_expr - = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr - ; do_ql <- wantQuickLook rn_fun - ; (tc_fun, fun_sigma) <- tcInferAppHead fun - ; inGenCode <- inGeneratedCode - ; traceTc "tcExprSigma" (vcat [ text "rn_expr:" <+> ppr rn_expr - , text "tc_fun" <+> ppr tc_fun - , text "inGeneratedCode:" <+> ppr inGenCode]) - ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_lspan) - tc_fun fun_sigma rn_args - ; tc_args <- tcValArgs do_ql (rn_fun, fun_lspan) inst_args - ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args - ; return (tc_expr, app_res_sigma) } - - {- ********************************************************************* * * Typechecking n-ary applications ===================================== compiler/GHC/Tc/Gen/App.hs-boot deleted ===================================== @@ -1,12 +0,0 @@ -module GHC.Tc.Gen.App where - -import GHC.Hs ( HsExpr ) -import GHC.Tc.Types ( TcM ) -import GHC.Tc.Types.Origin ( CtOrigin ) -import GHC.Tc.Utils.TcType ( TcSigmaType ) -import GHC.Hs.Extension ( GhcRn, GhcTc ) - - -import GHC.Prelude (Bool) - -tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -445,8 +445,7 @@ tcInferAppHead (fun,fun_lspan) do { mb_tc_fun <- tcInferAppHead_maybe fun ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) - Nothing -> tcInferExprSigma fun - + Nothing -> tcInferExprSigma fun } tcInferAppHead_maybe :: HsExpr GhcRn @@ -456,24 +455,11 @@ tcInferAppHead_maybe :: HsExpr GhcRn -- XExpr's although complicated needs to be looked through, useful for QL things when -- the argument is an XExpr tcInferAppHead_maybe fun = case fun of - HsVar _ nm - -> Just <$> tcInferId nm - ExprWithTySig _ e hs_ty - -> Just <$>tcExprWithSig e hs_ty - HsOverLit _ lit - -> Just <$> tcInferOverLit lit - XExpr (HsRecSelRn f) - -> Just <$> tcInferRecSelId f - --- XExpr (ExpandedThingRn (HSE o (L loc e))) --- -> setSrcSpan (locA loc) $ Just <$> --- do { (e', ty) <- tcExprSigma False (hsCtxtCtOrigin o) e --- ; return (mkExpandedTc o (L loc e'), ty) } --- -- We do not want to instantiate the type of the head as there may be --- -- visible type applications in the argument. --- -- c.f. T19167 - _ - -> return Nothing + HsVar _ nm -> Just <$> tcInferId nm + ExprWithTySig _ e hs_ty -> Just <$>tcExprWithSig e hs_ty + HsOverLit _ lit -> Just <$> tcInferOverLit lit + XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f + _ -> return Nothing {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1261,17 +1261,28 @@ we simply look to see if the hole is filled already. But consider case x of True -> True - False -> error "urk" + False -> undefined and suppose we call `tcInferSigma` on this expression, so that the `ir_inst` field of the expected result type is `IIF_Sigma`. The danger is that we'll fill the hole with `Bool` (from the `True`) and then reject when we try to -unify that with `forall a. a->a`, from the call to `error`. +unify that with `forall a. a->a`, from the call to `undefined`. + +Another example: + case x of + True -> (e1 :: forall a b. a->b) + False -> (e3 :: forall b a. a->b) To avoid this, we never infer a sigma-type from a multi-branch `case`. Instead we just zap the `IIF_Sigma` to `IIF_DeepRho` when walking inside the branches of multi-arm case-expression, or an if-expression. See calls to `adjustExpTypeForCaseBranches`. +This does mean that this would work: + (let x = 77+55 in h x x) @Int +where + h :: Int -> Int -> forall a. a->a +The `@Int` would instantiate the `forall a`. + Note that case e of True -> hr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5adc452444e2fd8ea668fac5bd67fca... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5adc452444e2fd8ea668fac5bd67fca... You're receiving this email because of your account on gitlab.haskell.org.