[Git][ghc/ghc][wip/spj-apporv-Oct24] remove special case of tcbody from tcLambdaMatches

[Apoorv Ingle (@ani)]

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC


Commits:
4f8e1bd7 by Apoorv Ingle at 2025-03-10T17:44:52-05:00
remove special case of tcbody from tcLambdaMatches

- - - - -


5 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Types/Origin.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -531,13 +531,6 @@ type instance XXExpr GhcTc = XXExprGhcTc
 data HsThingRn = OrigExpr (HsExpr GhcRn)                -- ^ The source, user written, expression
                | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from
 
-isHsThingRnExpr, isHsThingRnStmt :: HsThingRn -> Bool
-isHsThingRnExpr (OrigExpr{}) = True
-isHsThingRnExpr _ = False
-
-isHsThingRnStmt (OrigStmt{}) = True
-isHsThingRnStmt _ = False
-
 data XXExprGhcRn
   = ExpandedThingRn { xrn_orig     :: HsThingRn       -- The original source thing to be used for error messages
                     , xrn_expanded :: HsExpr GhcRn    -- The compiler generated expanded thing


=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -1172,9 +1172,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     -- we have to compare the wrappers
     exp (XExpr (WrapExpr h e)) (XExpr (WrapExpr h' e')) =
       wrap h h' && exp e e'
-    exp (XExpr (ExpandedThingTc o x)) (XExpr (ExpandedThingTc o' x'))
-      | isHsThingRnExpr o
-      , isHsThingRnExpr o'
+    exp (XExpr (ExpandedThingTc _ x)) (XExpr (ExpandedThingTc _ x'))
       = exp x x'
     exp (HsVar _ i) (HsVar _ i') =  i == i'
     exp (XExpr (ConLikeTc c _ _)) (XExpr (ConLikeTc c' _ _)) = c == c'


=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -1252,5 +1252,4 @@ addExprCtxt e thing_inside
    -- when we don't want to say "In the expression: _",
    -- because it is mentioned in the error message itself
       HsUnboundVar {} -> thing_inside
-      XExpr (ExpandedThingRn {}) -> thing_inside
       _ -> addErrCtxt (ExprCtxt e) thing_inside


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -79,7 +79,7 @@ import GHC.Types.Name
 import GHC.Types.Name.Reader (LocalRdrEnv)
 import GHC.Types.Id
 import GHC.Types.SrcLoc
-import GHC.Types.Basic( VisArity, isDoExpansionGenerated )
+import GHC.Types.Basic( VisArity )
 
 import qualified GHC.Data.List.NonEmpty as NE
 
@@ -155,21 +155,13 @@ tcLambdaMatches e lam_variant matches invis_pat_tys res_ty
 
         ; (wrapper, r)
             <- matchExpectedFunTys herald GenSigCtxt arity res_ty $ \ pat_tys rhs_ty ->
-               tcMatches tc_body (invis_pat_tys ++ pat_tys) rhs_ty matches
+               tcMatches tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches
 
         ; return (wrapper, r) }
   where
     herald = ExpectedFunTyLam lam_variant e
              -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify
 
-    tc_body | isDoExpansionGenerated (mg_ext matches)
-              -- See Part 3. B. of Note [Expanding HsDo with XXExprGhcRn] in
-              -- `GHC.Tc.Gen.Do`. Testcase: Typeable1
-            = tcBodyNC -- NB: Do not add any error contexts
-                       -- It has already been done
-            | otherwise
-            = tcBody
-
 {-
 @tcCaseMatches@ doesn't do the argument-count check because the
 parser guarantees that each equation has exactly one argument.
@@ -371,12 +363,6 @@ tcBody body res_ty
         ; tcPolyLExpr body res_ty
         }
 
-tcBodyNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
-tcBodyNC body res_ty
-  = do  { traceTc "tcBodyNC" (ppr res_ty)
-        ; tcMonoExprNC body res_ty
-        }
-
 {-
 ************************************************************************
 *                                                                      *


=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -755,8 +755,7 @@ exprCtOrigin (HsEmbTy {})        = Shouldn'tHappenOrigin "type expression"
 exprCtOrigin (HsForAll {})       = Shouldn'tHappenOrigin "forall telescope"    -- See Note [Types in terms]
 exprCtOrigin (HsQual {})         = Shouldn'tHappenOrigin "constraint context"  -- See Note [Types in terms]
 exprCtOrigin (HsFunArr {})       = Shouldn'tHappenOrigin "function arrow"      -- See Note [Types in terms]
-exprCtOrigin (XExpr (ExpandedThingRn thing _)) | OrigExpr a <- thing = exprCtOrigin a
-                                               | OrigStmt _ _ <- thing = DoOrigin
+exprCtOrigin (XExpr (ExpandedThingRn{})) = Shouldn'tHappenOrigin "XExpr ExpandedThingRn"
 exprCtOrigin (XExpr (PopErrCtxt {})) = Shouldn'tHappenOrigin "PopErrCtxt"
 exprCtOrigin (XExpr (HsRecSelRn f))  = OccurrenceOfRecSel (foExt f)
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f8e1bd782203b0d11a25d2536103fa0c3c53395

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f8e1bd782203b0d11a25d2536103fa0c3c53395
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250310/bfd536fd/attachment-0001.html>