[Git][ghc/ghc][wip/spj-apporv-Oct24] rename HsThingRn to SrcCodeOrigin

24 Jun 2025

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


Commits:
da6e83b0 by Apoorv Ingle at 2025-06-24T00:17:51-05:00
rename HsThingRn to SrcCodeOrigin

- - - - -


7 changed files:

- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs


Changes:

=====================================
compiler/GHC/Hs.hs
=====================================
@@ -150,16 +150,8 @@ data HsParsedModule = HsParsedModule {
        -- them change (#3589)
   }

--- All the various located syntax things that sets the user context code in TcLclEnv
--- data SrcCodeOrigin  =
---     ExprThing (HsExpr GhcRn)
---   | PatThing (LPat GhcRn)
---   | StmtThing (ExprLStmt GhcRn) HsDoFlavour
-
--- I'm a looking at a generated thing or am I a user written thing?
-data SrcCodeCtxt = UserCode | GeneratedCode HsThingRn
-
--- mkSrcCodeOrigin :: HsThingRn -> SrcCodeOrigin
--- mkSrcCodeOrigin (OrigExpr e) = ExprThing e
--- mkSrcCodeOrigin (OrigPat p) = PatThing p
--- mkSrcCodeOrigin (OrigStmt s f) = StmtThing e f
+-- Used in TcLclCtxt.tcl_in_gen_code to mark if the current expression
+-- is a user generated code or a compiler generated expansion of some user written code
+data SrcCodeCtxt
+  = UserCode
+  | GeneratedCode SrcCodeOrigin


=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -672,12 +672,13 @@ type instance XXExpr GhcTc = XXExprGhcTc
 -- | The different source constructs that we use to instantiate the "original" field
 --   in an `XXExprGhcRn original expansion`
 --   See Note [Handling overloaded and rebindable constructs] in `GHC.Rename.Expr`
-data HsThingRn = OrigExpr (HsExpr GhcRn)                -- ^ The source, user written, expression
-               | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from
-               | OrigPat  (LPat GhcRn)                  -- ^ Used for failable patterns that trigger MonadFail constraints
+data SrcCodeOrigin
+  = OrigExpr (HsExpr GhcRn)                -- ^ The source, user written, expression
+  | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from
+  | OrigPat  (LPat GhcRn)                  -- ^ Used for failable patterns that trigger MonadFail constraints
 
 data XXExprGhcRn
-  = ExpandedThingRn { xrn_orig     :: HsThingRn       -- The original source thing to be used for error messages
+  = ExpandedThingRn { xrn_orig     :: SrcCodeOrigin       -- The original source thing to be used for error messages
                     , xrn_expanded :: HsExpr GhcRn    -- The compiler generated expanded thing
                     }
 
@@ -718,7 +719,7 @@ data XXExprGhcTc
 
   | ExpandedThingTc                         -- See Note [Rebindable syntax and XXExprGhcRn]
                                             -- See Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
-         { xtc_orig     :: HsThingRn        -- The original user written thing
+         { xtc_orig     :: SrcCodeOrigin        -- The original user written thing
          , xtc_expanded :: HsExpr GhcTc }   -- The expanded typechecked expression
 
   | ConLikeTc      -- Result of typechecking a data-con
@@ -752,10 +753,10 @@ mkExpandedExprTc
   :: HsExpr GhcRn           -- ^ source expression
   -> HsExpr GhcTc           -- ^ expanded typechecked expression
   -> HsExpr GhcTc           -- ^ suitably wrapped 'XXExprGhcRn'
-mkExpandedExprTc oExpr eExpr = XExpr (ExpandedThingTc (OrigExpr oExpr) eExpr)
+mkExpandedExprTc oExpr eExpr = mkExpandedTc (OrigExpr oExpr) eExpr
 
 mkExpandedTc
-  :: HsThingRn        -- ^ source do statement
+  :: SrcCodeOrigin          -- ^ source, user written do statement/expression
   -> HsExpr GhcTc           -- ^ expanded typechecked expression
   -> HsExpr GhcTc           -- ^ suitably wrapped 'XXExprGhcRn'
 mkExpandedTc o e = XExpr (ExpandedThingTc o e)
@@ -1020,7 +1021,7 @@ ppr_expr (XExpr x) = case ghcPass @p of
   GhcRn -> ppr x
   GhcTc -> ppr x
 
-instance Outputable HsThingRn where
+instance Outputable SrcCodeOrigin where
   ppr thing
     = case thing of
         OrigExpr x    -> ppr_builder "<OrigExpr>:" x
@@ -1087,7 +1088,7 @@ ppr_infix_expr_tc (HsTick {})                = Nothing
 ppr_infix_expr_tc (HsBinTick {})             = Nothing
 ppr_infix_expr_tc (HsRecSelTc f)            = Just (pprInfixOcc f)
 
-ppr_infix_hs_expansion :: HsThingRn -> Maybe SDoc
+ppr_infix_hs_expansion :: SrcCodeOrigin -> Maybe SDoc
 ppr_infix_hs_expansion (OrigExpr e) = ppr_infix_expr e
 ppr_infix_hs_expansion _            = Nothing
 
@@ -1195,7 +1196,7 @@ hsExprNeedsParens prec = go
     go_x_rn (PopErrCtxt a)               = hsExprNeedsParens prec a
     go_x_rn (HsRecSelRn{})               = False
 
-    hsExpandedNeedsParens :: HsThingRn -> Bool
+    hsExpandedNeedsParens :: SrcCodeOrigin -> Bool
     hsExpandedNeedsParens (OrigExpr e) = hsExprNeedsParens prec e
     hsExpandedNeedsParens _            = False
 
@@ -1248,7 +1249,7 @@ isAtomicHsExpr (XExpr x)
     go_x_rn (PopErrCtxt a)              = isAtomicHsExpr a
     go_x_rn (HsRecSelRn{})              = True
 
-    isAtomicExpandedThingRn :: HsThingRn -> Bool
+    isAtomicExpandedThingRn :: SrcCodeOrigin -> Bool
     isAtomicExpandedThingRn (OrigExpr e) = isAtomicHsExpr e
     isAtomicExpandedThingRn _            = False
 


=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -591,7 +591,7 @@ deriving instance Eq (IE GhcTc)
 
 -- ---------------------------------------------------------------------
 
-deriving instance Data HsThingRn
+deriving instance Data SrcCodeOrigin
 deriving instance Data XXExprGhcRn
 deriving instance Data a => Data (WithUserRdr a)
 


=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -611,7 +611,7 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts))
                     ListComp -> Just $ BinBox QualBinBox
                     _        -> Nothing
 
--- addTickHsExpanded :: HsThingRn -> HsExpr GhcTc -> TM (HsExpr GhcTc)
+-- addTickHsExpanded :: SrcCodeOrigin -> HsExpr GhcTc -> TM (HsExpr GhcTc)
 -- addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of
 --   -- We always want statements to get a tick, so we can step over each one.
 --   -- To avoid duplicates we blacklist SrcSpans we already inserted here.


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -5306,11 +5306,9 @@ pprArising :: CtLoc -> SDoc
 -- We've done special processing for TypeEq, KindEq, givens
 pprArising ct_loc
   | suppress_origin   = empty
-  | in_generated_code = pprCtOrigin orig -- TODO ANI: maybe should go way
   | otherwise         = pprCtOrigin orig
   where
     orig = ctLocOrigin ct_loc
-    in_generated_code = ctLocEnvInGeneratedCode (ctLocEnv ct_loc)
     suppress_origin
       | isGivenOrigin orig = True
       | otherwise          = case orig of


=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -763,18 +763,18 @@ exprCtOrigin (HsHole _)          = Shouldn'tHappenOrigin "hole 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 {})) = Shouldn'tHappenOrigin "XExpr ExpandedThingRn"
+exprCtOrigin (XExpr (ExpandedThingRn o _)) = srcCodeOriginCtOrigin o
 exprCtOrigin (XExpr (PopErrCtxt e)) = exprCtOrigin e
 exprCtOrigin (XExpr (HsRecSelRn f))  = OccurrenceOfRecSel (foExt f)
 
-hsThingCtOrigin :: HsThingRn -> CtOrigin
-hsThingCtOrigin (OrigExpr e) = exprCtOrigin e
-hsThingCtOrigin (OrigStmt{}) = DoStmtOrigin
-hsThingCtOrigin (OrigPat p) = DoPatOrigin p
+srcCodeOriginCtOrigin :: SrcCodeOrigin -> CtOrigin
+srcCodeOriginCtOrigin (OrigExpr e) = exprCtOrigin e
+srcCodeOriginCtOrigin (OrigStmt{}) = DoStmtOrigin
+srcCodeOriginCtOrigin (OrigPat p) = DoPatOrigin p
 
 srcCodeCtxtCtOrigin :: HsExpr GhcRn -> SrcCodeCtxt -> CtOrigin
 srcCodeCtxtCtOrigin e UserCode = exprCtOrigin e
-srcCodeCtxtCtOrigin _ (GeneratedCode e) = hsThingCtOrigin e
+srcCodeCtxtCtOrigin _ (GeneratedCode e) = srcCodeOriginCtOrigin e
 
 -- | Extract a suitable CtOrigin from a MatchGroup
 matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin


=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -990,9 +990,9 @@ getSrcCodeCtxt = getLclEnvSrcCodeCtxt <$> getLclEnv
 -- | Mark the inner computation as being done inside generated code.
 --
 -- See Note [Error contexts in generated code]
-setInGeneratedCode :: HsThingRn -> TcRn a -> TcRn a
-setInGeneratedCode syntax_thing thing_inside =
-  updLclCtxt (setLclCtxtSrcCodeCtxt (GeneratedCode syntax_thing)) thing_inside
+setInGeneratedCode :: SrcCodeOrigin -> TcRn a -> TcRn a
+setInGeneratedCode scOrig thing_inside =
+  updLclCtxt (setLclCtxtSrcCodeCtxt (GeneratedCode scOrig)) thing_inside
 
 setSrcSpanA :: EpAnn ann -> TcRn a -> TcRn a
 setSrcSpanA l = setSrcSpan (locA l)



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

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

    

Apoorv Ingle (＠ani)

tags

participants (1)