Simon Peyton Jones pushed to branch wip/ani/no-ds-flag-cache at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • compiler/GHC/Tc/Gen/App.hs
    ... ... @@ -350,7 +350,7 @@ Unify result type /before/ typechecking the args
    350 350
     
    
    351 351
     The latter is much better. That is why we call `checkResultTy` before tcValArgs.
    
    352 352
     -}
    
    353
    --- CAUTION: Any changes to tcApp should be reflected in tcExprSigma
    
    353
    +
    
    354 354
     tcApp :: HsExpr GhcRn
    
    355 355
           -> ExpRhoType   -- When checking, -XDeepSubsumption <=> deeply skolemised
    
    356 356
           -> TcM (HsExpr GhcTc)
    
    ... ... @@ -459,11 +459,15 @@ checkResultTy :: HsExpr GhcRn
    459 459
                                 --   expose foralls, but maybe not /deeply/ instantiated
    
    460 460
                   -> ExpRhoType -- Expected type; this is deeply skolemised
    
    461 461
                   -> TcM HsWrapper
    
    462
    -checkResultTy rn_expr _ _ app_res_rho (Infer inf_res)
    
    463
    -  = do { ds_flag <- getDeepSubsumptionFlag
    
    462
    +checkResultTy rn_expr (tc_fun,_) _ app_res_rho (Infer inf_res)
    
    463
    +  = do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun
    
    464
    +                    -- We must deeply-instantiate data constructors
    
    465
    +                    -- E.g.  data T = MkT Int int
    
    466
    +                    --       f = K 3
    
    467
    +                    -- We must infer f :: Int ->{many} T
    
    468
    +                    --       and not f :: Int ->{one}  T
    
    464 469
            ; fillInferResult ds_flag (exprCtOrigin rn_expr) app_res_rho inf_res }
    
    465 470
     
    
    466
    -
    
    467 471
     checkResultTy rn_expr (tc_fun, fun_loc) inst_args app_res_rho (Check res_ty)
    
    468 472
     -- Unify with expected type from the context
    
    469 473
     -- See Note [Unify with expected type before typechecking arguments]