Apoorv Ingle pushed to branch wip/ani/tc-expand at Glasgow Haskell Compiler / GHC

Commits:

3 changed files:

Changes:

  • compiler/GHC/Tc/Gen/App.hs
    ... ... @@ -14,7 +14,7 @@ module GHC.Tc.Gen.App
    14 14 
            , tcExprSigma
    15 15 
            , tcExprPrag ) where
    16 16
    17 
    -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr )
    17 
    +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyLExprNC )
    18 18
    19 19 
     import GHC.Hs
    20 20
    ... ... @@ -570,7 +570,7 @@ tcValArg do_ql _ _ (EWrap (EHsWrap w)) = do { whenQL do_ql $ qlMonoHsWrapper w
    570 570 
     tcValArg _     _ _ (EWrap ew)          = return (EWrap ew)
    571 571
    572 572 
     tcValArg do_ql pos (fun, fun_lspan) (EValArg { ea_loc_span  = lspan
    573 
    -                            , ea_arg    = larg@(L arg_loc arg)
    573 
    +                            , ea_arg    = larg@(L arg_loc _)
    574 574 
                                 , ea_arg_ty = sc_arg_ty })
    575 575 
       = addArgCtxt pos (fun, fun_lspan) larg $
    576 576 
         do { -- Crucial step: expose QL results before checking exp_arg_ty
    ... ... @@ -596,11 +596,11 @@ tcValArg do_ql pos (fun, fun_lspan) (EValArg { ea_loc_span = lspan
    596 596
    597 597 
              -- Now check the argument
    598 598 
            ; arg' <- tcScalingUsage mult $
    599 
    -                 tcPolyExpr arg (mkCheckExpType exp_arg_ty)
    599 
    +                 tcPolyLExprNC larg (mkCheckExpType exp_arg_ty)
    600 600 
            ; traceTc "tcValArg" $ vcat [ ppr arg'
    601 601 
                                        , text "}" ]
    602 602 
            ; return (EValArg { ea_loc_span = lspan
    603 
    -                         , ea_arg = L arg_loc arg'
    603 
    +                         , ea_arg = arg'
    604 604 
                              , ea_arg_ty = noExtField }) }
    605 605
    606 606 
     tcValArg _ pos (fun, fun_lspan) (EValArgQL {

  • compiler/GHC/Tc/Gen/Expr.hs
    ... ... @@ -123,30 +123,11 @@ tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType
    123 123
    124 124 
     tcPolyLExpr (L loc expr) res_ty
    125 125 
       = addLExprCtxt (locA loc) expr $  -- Note [Error contexts in generated code]
    126 
    -     do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty
    127 
    -        ; e <-
    128 
    -            mb_add_xexpr_wrap (ExprCtxt expr) did_expand $ mb_add_ctxt ctxt (locA loc') expanded_expr $
    129 
    -             case mb_ret_ty of
    130 
    -               Nothing -> tcPolyExpr expanded_expr res_ty
    131 
    -               Just ds_res_ty -> do expr' <- tcPolyExpr expanded_expr (Check ds_res_ty)
    132 
    -                                    tcWrapResult expr expr' ds_res_ty res_ty
    133 
    -        ; return (L loc' e)
    134 
    -        }
    135 
    -    where
    136 
    -      mb_add_ctxt :: Maybe HsCtxt -> SrcSpan -> HsExpr GhcRn -> TcM a -> TcM a
    137 
    -      mb_add_ctxt Nothing _ _ thing_inside
    138 
    -          = thing_inside
    139 
    -      mb_add_ctxt (Just ctxt) loc expanded_expr thing_inside
    140 
    -          = addExpansionErrCtxt ctxt $
    141 
    -               addLExprCtxt loc expanded_expr $
    142 
    -                thing_inside
    143 
    -
    144 
    -      mb_add_xexpr_wrap :: HsCtxt -> Bool -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    145 
    -      mb_add_xexpr_wrap hs_ctxt True thing_inside = mkExpandedTc hs_ctxt <$> setInGeneratedCode thing_inside
    146 
    -      mb_add_xexpr_wrap _ False thing_inside = thing_inside
    126 
    +    tcPolyLExprNC (L loc expr) res_ty
    147 127
    148 128 
     tcPolyLExprNC (L loc expr) res_ty
    149 
    -  = do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty
    129 
    +  = setSrcSpanA loc $
    130 
    +    do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty
    150 131 
            ; e <-
    151 132 
                 mb_add_xexpr_wrap (ExprCtxt expr) did_expand $ mb_add_ctxt ctxt (locA loc') expanded_expr $
    152 133 
                  case mb_ret_ty of
    ... ... @@ -313,30 +294,11 @@ tcMonoLExpr, tcMonoLExprNC
    313 294
    314 295 
     tcMonoLExpr (L loc expr) res_ty
    315 296 
       = addLExprCtxt (locA loc) expr $  -- Note [Error contexts in generated code]
    316 
    -     do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty
    317 
    -        ; e <-
    318 
    -            mb_add_xexpr_wrap (ExprCtxt expr) did_expand $ mb_add_ctxt ctxt (locA loc') expanded_expr $
    319 
    -             case mb_ret_ty of
    320 
    -               Nothing -> tcExpr expanded_expr res_ty
    321 
    -               Just ds_res_ty -> do expr' <- tcExpr expanded_expr (Check ds_res_ty)
    322 
    -                                    tcWrapResultMono expr expr' ds_res_ty res_ty
    323 
    -        ; return (L loc' e)
    324 
    -        }
    325 
    -    where
    326 
    -      mb_add_ctxt :: Maybe HsCtxt -> SrcSpan -> HsExpr GhcRn -> TcM a -> TcM a
    327 
    -      mb_add_ctxt Nothing _ _ thing_inside
    328 
    -          = thing_inside
    329 
    -      mb_add_ctxt (Just ctxt) loc expanded_expr thing_inside
    330 
    -          = addExpansionErrCtxt ctxt $
    331 
    -               addLExprCtxt loc expanded_expr $
    332 
    -                thing_inside
    333 
    -
    334 
    -      mb_add_xexpr_wrap :: HsCtxt -> Bool -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    335 
    -      mb_add_xexpr_wrap hs_ctxt True thing_inside = mkExpandedTc hs_ctxt <$> setInGeneratedCode thing_inside
    336 
    -      mb_add_xexpr_wrap _ False thing_inside = thing_inside
    297 
    +    tcMonoLExprNC (L loc expr) res_ty
    337 298
    338 299 
     tcMonoLExprNC (L loc expr) res_ty
    339 
    -  = do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty
    300 
    +  = setSrcSpanA loc $
    301 
    +    do { (L loc' expanded_expr, mb_ret_ty, ctxt, did_expand) <- tcExpandLExpr loc expr res_ty
    340 302 
            ; e <-
    341 303 
                 mb_add_xexpr_wrap (ExprCtxt expr) did_expand $ mb_add_ctxt ctxt (locA loc') expanded_expr $
    342 304 
                  case mb_ret_ty of

  • compiler/GHC/Tc/Gen/Expr.hs-boot
    ... ... @@ -24,7 +24,7 @@ tcCheckMonoExpr, tcCheckMonoExprNC ::
    24 24 
            -> TcRhoType
    25 25 
            -> TcM (LHsExpr GhcTc)
    26 26
    27 
    -tcPolyLExpr    :: LHsExpr GhcRn -> ExpSigmaType -> TcM (LHsExpr GhcTc)
    27 
    +tcPolyLExpr, tcPolyLExprNC    :: LHsExpr GhcRn -> ExpSigmaType -> TcM (LHsExpr GhcTc)
    28 28 
     tcPolyLExprSig :: LHsExpr GhcRn -> TcCompleteSig -> TcM (LHsExpr GhcTc)
    29 29
    30 30 
     tcPolyExpr :: HsExpr GhcRn -> ExpSigmaType -> TcM (HsExpr GhcTc)

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help