[Git][ghc/ghc][wip/jade/ast] Moved HsRecSel to the XConstructors.

Hassan Al-Awwadi (@hassan.awwadi) gitlab at gitlab.haskell.org
Sun Sep 29 17:56:33 UTC 2024



Hassan Al-Awwadi pushed to branch wip/jade/ast at Glasgow Haskell Compiler / GHC


Commits:
7c89f357 by Hassan Al-Awwadi at 2024-09-29T19:55:38+02:00
Moved HsRecSel to the XConstructors.

FieldOcc types kept in Language.Haskell though because they are also used by  HsRecUpdField in L.H.S.Pat.hs

- - - - -


13 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/Language/Haskell/Syntax/Expr.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -514,6 +514,10 @@ data XXExprGhcRn
                                                    -- Does not presist post renaming phase
                                                    -- See Part 3. of Note [Expanding HsDo with XXExprGhcRn]
                                                    -- in `GHC.Tc.Gen.Do`
+  | HsRecSelRn  (FieldOcc GhcRn)   -- ^ Variable pointing to record selector
+                           -- See Note [Non-overloaded record field selectors] and
+                           -- Note [Record selectors in the AST]
+
 
 
 -- | Wrap a located expression with a `PopErrCtxt`
@@ -594,6 +598,11 @@ data XXExprGhcTc
      Int                                -- module-local tick number for True
      Int                                -- module-local tick number for False
      (LHsExpr GhcTc)                    -- sub-expression
+  
+  | HsRecSelTc  (FieldOcc GhcTc) -- ^ Variable pointing to record selector
+                             -- See Note [Non-overloaded record field selectors] and
+                             -- Note [Record selectors in the AST]
+
 
 -- | Build a 'XXExprGhcRn' out of an extension constructor,
 --   and the two components of the expansion: original and
@@ -655,7 +664,6 @@ ppr_expr :: forall p. (OutputableBndrId p)
          => HsExpr (GhcPass p) -> SDoc
 ppr_expr (HsVar _ (L _ v))   = pprPrefixOcc v
 ppr_expr (HsUnboundVar _ uv) = pprPrefixOcc uv
-ppr_expr (HsRecSel _ f)      = pprPrefixOcc f
 ppr_expr (HsIPVar _ v)       = ppr v
 ppr_expr (HsOverLabel s l) = case ghcPass @p of
                GhcPs -> helper s
@@ -874,11 +882,13 @@ instance Outputable HsThingRn where
         OrigExpr x -> ppr_builder "<OrigExpr>:" x
         OrigStmt x -> ppr_builder "<OrigStmt>:" x
         OrigPat x  -> ppr_builder "<OrigPat>:" x
+        
     where ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens (ppr x))) (ppr x)
 
 instance Outputable XXExprGhcRn where
   ppr (ExpandedThingRn o e) = ifPprDebug (braces $ vcat [ppr o, ppr e]) (ppr o)
   ppr (PopErrCtxt e)        = ifPprDebug (braces (text "<PopErrCtxt>" <+> ppr e)) (ppr e)
+  ppr (HsRecSelRn f)        = pprPrefixOcc f
 
 instance Outputable XXExprGhcTc where
   ppr (WrapExpr co_fn e)
@@ -907,10 +917,11 @@ instance Outputable XXExprGhcTc where
             ppr tickIdFalse,
             text ">(",
             ppr exp, text ")"]
+  ppr (HsRecSelTc f)      = pprPrefixOcc f
+
 
 ppr_infix_expr :: forall p. (OutputableBndrId p) => HsExpr (GhcPass p) -> Maybe SDoc
 ppr_infix_expr (HsVar _ (L _ v))    = Just (pprInfixOcc v)
-ppr_infix_expr (HsRecSel _ f)       = Just (pprInfixOcc f)
 ppr_infix_expr (HsUnboundVar _ occ) = Just (pprInfixOcc occ)
 ppr_infix_expr (XExpr x)            = case ghcPass @p of
                                         GhcRn -> ppr_infix_expr_rn x
@@ -919,7 +930,8 @@ ppr_infix_expr _ = Nothing
 
 ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc
 ppr_infix_expr_rn (ExpandedThingRn thing _) = ppr_infix_hs_expansion thing
-ppr_infix_expr_rn (PopErrCtxt (L _ a)) = ppr_infix_expr a
+ppr_infix_expr_rn (PopErrCtxt (L _ a))      = ppr_infix_expr a
+ppr_infix_expr_rn (HsRecSelRn f)            = Just (pprInfixOcc f)
 
 ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc
 ppr_infix_expr_tc (WrapExpr _ e)    = ppr_infix_expr e
@@ -927,6 +939,8 @@ ppr_infix_expr_tc (ExpandedThingTc thing _)  = ppr_infix_hs_expansion thing
 ppr_infix_expr_tc (ConLikeTc {})             = Nothing
 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 (OrigExpr e) = ppr_infix_expr e
@@ -1013,7 +1027,6 @@ hsExprNeedsParens prec = go
     go (HsProc{})                     = prec > topPrec
     go (HsStatic{})                   = prec >= appPrec
     go (RecordCon{})                  = False
-    go (HsRecSel{})                   = False
     go (HsProjection{})               = True
     go (HsGetField{})                 = False
     go (HsEmbTy{})                    = prec > topPrec
@@ -1030,10 +1043,12 @@ hsExprNeedsParens prec = go
     go_x_tc (ConLikeTc {})                   = False
     go_x_tc (HsTick _ (L _ e))               = hsExprNeedsParens prec e
     go_x_tc (HsBinTick _ _ (L _ e))          = hsExprNeedsParens prec e
+    go_x_tc (HsRecSelTc{})                   = False
 
     go_x_rn :: XXExprGhcRn -> Bool
     go_x_rn (ExpandedThingRn thing _)    = hsExpandedNeedsParens thing
     go_x_rn (PopErrCtxt (L _ a))         = hsExprNeedsParens prec a
+    go_x_rn (HsRecSelRn{})               = False
 
     hsExpandedNeedsParens :: HsThingRn -> Bool
     hsExpandedNeedsParens (OrigExpr e) = hsExprNeedsParens prec e
@@ -1071,21 +1086,22 @@ isAtomicHsExpr (HsOverLit {})    = True
 isAtomicHsExpr (HsIPVar {})      = True
 isAtomicHsExpr (HsOverLabel {})  = True
 isAtomicHsExpr (HsUnboundVar {}) = True
-isAtomicHsExpr (HsRecSel{})      = True
 isAtomicHsExpr (XExpr x)
   | GhcTc <- ghcPass @p          = go_x_tc x
   | GhcRn <- ghcPass @p          = go_x_rn x
   where
     go_x_tc :: XXExprGhcTc -> Bool
-    go_x_tc (WrapExpr _ e)                   = isAtomicHsExpr e
-    go_x_tc (ExpandedThingTc thing _)        = isAtomicExpandedThingRn thing
-    go_x_tc (ConLikeTc {})                   = True
-    go_x_tc (HsTick {}) = False
-    go_x_tc (HsBinTick {}) = False
+    go_x_tc (WrapExpr _ e)            = isAtomicHsExpr e
+    go_x_tc (ExpandedThingTc thing _) = isAtomicExpandedThingRn thing
+    go_x_tc (ConLikeTc {})            = True
+    go_x_tc (HsTick {})               = False
+    go_x_tc (HsBinTick {})            = False
+    go_x_tc (HsRecSelTc{})            = True
 
     go_x_rn :: XXExprGhcRn -> Bool
-    go_x_rn (ExpandedThingRn thing _)    = isAtomicExpandedThingRn thing
-    go_x_rn (PopErrCtxt (L _ a))         = isAtomicHsExpr a
+    go_x_rn (ExpandedThingRn thing _) = isAtomicExpandedThingRn thing
+    go_x_rn (PopErrCtxt (L _ a))      = isAtomicHsExpr a
+    go_x_rn (HsRecSelRn{})            = True
 
     isAtomicExpandedThingRn :: HsThingRn -> Bool
     isAtomicExpandedThingRn (OrigExpr e) = isAtomicHsExpr e


=====================================
compiler/GHC/Hs/Syn/Type.hs
=====================================
@@ -103,7 +103,6 @@ lhsExprType (L _ e) = hsExprType e
 hsExprType :: HsExpr GhcTc -> Type
 hsExprType (HsVar _ (L _ id)) = idType id
 hsExprType (HsUnboundVar (HER _ ty _) _) = ty
-hsExprType (HsRecSel _ (FieldOcc _ id)) = idType (unLoc id)
 hsExprType (HsOverLabel v _) = dataConCantHappen v
 hsExprType (HsIPVar v _) = dataConCantHappen v
 hsExprType (HsOverLit _ lit) = overLitType lit
@@ -154,6 +153,7 @@ hsExprType (XExpr (ExpandedThingTc _ e))  = hsExprType e
 hsExprType (XExpr (ConLikeTc con _ _)) = conLikeType con
 hsExprType (XExpr (HsTick _ e)) = lhsExprType e
 hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e
+hsExprType (XExpr (HsRecSelTc (FieldOcc _ id))) = idType (unLoc id)
 
 arithSeqInfoType :: ArithSeqInfo GhcTc -> Type
 arithSeqInfoType asi = mkListTy $ case asi of


=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -261,36 +261,6 @@ dsLExpr (L loc e) = putSrcSpanDsA loc $ dsExpr e
 dsExpr :: HsExpr GhcTc -> DsM CoreExpr
 dsExpr (HsVar    _ (L _ id))           = dsHsVar id
 
-{- Record selectors are warned about if they are not
-present in all of the parent data type's constructor,
-or always in case of pattern synonym record selectors
-(regulated by a flag). However, this only produces
-a warning if it's not a part of a record selector
-application. For example:
-
-        data T = T1 | T2 {s :: Bool}
-        f x = s x -- the warning from this case will be supressed
-
-See the `HsApp` case for where it is filtered out
--}
-dsExpr (HsRecSel _ (FieldOcc _ (L _ id)))
-  = do { let name = getName id
-             RecSelId {sel_cons = (_, cons_wo_field)}
-                  = idDetails id
-       ; cons_trimmed <- trim_cons cons_wo_field
-       ; unless (null cons_wo_field) $ diagnosticDs
-             $ DsIncompleteRecordSelector name cons_trimmed (cons_trimmed /= cons_wo_field)
-                 -- This only produces a warning if it's not a part of a
-                 -- record selector application (e.g. `s a` where `s` is a selector)
-                 -- See the `HsApp` case for where it is filtered out
-       ; dsHsVar id }
-  where
-    trim_cons :: [ConLike] -> DsM [ConLike]
-    trim_cons cons_wo_field = do
-      dflags <- getDynFlags
-      let maxConstructors = maxUncoveredPatterns dflags
-      return $ take maxConstructors cons_wo_field
-
 
 dsExpr (HsUnboundVar (HER ref _ _) _)  = dsEvTerm =<< readMutVar ref
         -- See Note [Holes] in GHC.Tc.Types.Constraint
@@ -336,6 +306,35 @@ dsExpr e@(XExpr ext_expr_tc)
         do { assert (exprType e2 `eqType` boolTy)
             mkBinaryTickBox ixT ixF e2
           }
+        {- Record selectors are warned about if they are not
+        present in all of the parent data type's constructor,
+        or always in case of pattern synonym record selectors
+        (regulated by a flag). However, this only produces
+        a warning if it's not a part of a record selector
+        application. For example:
+
+                data T = T1 | T2 {s :: Bool}
+                f x = s x -- the warning from this case will be supressed
+
+        See the `HsApp` case for where it is filtered out
+        -}
+      (HsRecSelTc (FieldOcc _ (L _ id))) -> 
+        do { let  name = getName id
+                  RecSelId {sel_cons = (_, cons_wo_field)} = idDetails id
+            ; cons_trimmed <- trim_cons cons_wo_field
+            ; unless (null cons_wo_field) $ diagnosticDs
+                  $ DsIncompleteRecordSelector name cons_trimmed (cons_trimmed /= cons_wo_field)
+                      -- This only produces a warning if it's not a part of a
+                      -- record selector application (e.g. `s a` where `s` is a selector)
+                      -- See the `HsApp` case for where it is filtered out
+            ; dsHsVar id }
+          where
+            trim_cons :: [ConLike] -> DsM [ConLike]
+            trim_cons cons_wo_field = do
+              dflags <- getDynFlags
+              let maxConstructors = maxUncoveredPatterns dflags
+              return $ take maxConstructors cons_wo_field
+
 
 -- Strip ticks due to #21701, need to be invariant about warnings we produce whether
 -- this is enabled or not.


=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1544,7 +1544,6 @@ repE (HsVar _ (L _ x)) =
 repE (HsIPVar _ n) = rep_implicit_param_name n >>= repImplicitParamVar
 repE (HsOverLabel _ s) = repOverLabel s
 
-repE (HsRecSel _ (FieldOcc _ (L _ x))) = repE (HsVar noExtField (noLocA x))
 
         -- Remember, we're desugaring renamer output here, so
         -- HsOverlit can definitely occur
@@ -1719,6 +1718,8 @@ repE e@(XExpr (ExpandedThingRn o x))
   = notHandled (ThExpressionForm e)
 
 repE (XExpr (PopErrCtxt (L _ e))) = repE e
+repE (XExpr (HsRecSelRn (FieldOcc _ (L _ x)))) = repE (HsVar noExtField (noLocA x))
+
 repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e)
 repE e@(HsTypedBracket{})   = notHandled (ThExpressionForm e)
 repE e@(HsUntypedBracket{}) = notHandled (ThExpressionForm e)


=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -476,7 +476,6 @@ addBinTickLHsExpr boxLabel e@(L pos e0)
 addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
 addTickHsExpr e@(HsVar _ (L _ id))  = do freeVar id; return e
 addTickHsExpr e@(HsUnboundVar {})   = return e
-addTickHsExpr e@(HsRecSel _ (FieldOcc _ id))   = do freeVar (unLoc id); return e
 
 addTickHsExpr e@(HsIPVar {})            = return e
 addTickHsExpr e@(HsOverLit {})          = return e
@@ -603,6 +602,8 @@ addTickHsExpr (XExpr (HsTick t e)) =
         liftM (XExpr . HsTick t) (addTickLHsExprNever e)
 addTickHsExpr (XExpr (HsBinTick t0 t1 e)) =
         liftM (XExpr . HsBinTick t0 t1) (addTickLHsExprNever e)
+        
+addTickHsExpr e@(XExpr (HsRecSelTc (FieldOcc _ id)))   = do freeVar (unLoc id); return e
 
 addTickHsExpr (HsDo srcloc cxt (L l stmts))
   = do { (stmts', _) <- addTickLStmts' forQual stmts (return ())


=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -1205,9 +1205,6 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
              -- Patch up var location since typechecker removes it
         ]
       HsUnboundVar _ _ -> []  -- there is an unbound name here, but that causes trouble
-      HsRecSel _ fld ->
-        [ toHie $ RFC RecFieldOcc Nothing (L mspan fld)
-        ]
       HsOverLabel {} -> []
       HsIPVar _ _ -> []
       HsOverLit _ o ->
@@ -1355,23 +1352,29 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
         ]
       HsGetField {} -> []
       HsProjection {} -> []
-      XExpr x
-        | HieTc <- hiePass @p
-        -> case x of
-             WrapExpr w a
-               -> [ toHie $ L mspan a
-                  , toHie (L mspan w) ]
-             ExpandedThingTc _ e
-               -> [ toHie (L mspan e) ]
-             ConLikeTc con _ _
-               -> [ toHie $ C Use $ L mspan $ conLikeName con ]
-             HsTick _ expr
-               -> [ toHie expr
-                  ]
-             HsBinTick _ _ expr
-               -> [ toHie expr
-                  ]
-        | otherwise -> []
+      XExpr x -> case hiePass @p of 
+        HieTc -> case x of
+          WrapExpr w a
+            -> [ toHie $ L mspan a
+               , toHie (L mspan w) ]
+          ExpandedThingTc _ e
+            -> [ toHie (L mspan e) ]
+          ConLikeTc con _ _
+            -> [ toHie $ C Use $ L mspan $ conLikeName con ]
+          HsTick _ expr
+            -> [ toHie expr
+               ]
+          HsBinTick _ _ expr
+            -> [ toHie expr
+               ]
+          HsRecSelTc fld 
+            -> [ toHie $ RFC RecFieldOcc Nothing (L mspan fld)
+               ]
+        HieRn -> case x of 
+          HsRecSelRn fld 
+            -> [ toHie $ RFC RecFieldOcc Nothing (L mspan fld)
+               ]
+          _ -> []
 
 -- NOTE: no longer have the location
 instance HiePass p => ToHie (HsTupArg (GhcPass p)) where


=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -339,7 +339,7 @@ rnExpr (HsVar _ (L l v))
                   ; this_mod <- getModule
                   ; when (nameIsLocalOrFrom this_mod sel_name) $
                       checkThLocalName sel_name
-                  ; return (HsRecSel noExtField (FieldOcc v  (L l sel_name)), unitFV sel_name)
+                  ; return (XExpr (HsRecSelRn (FieldOcc v  (L l sel_name))), unitFV sel_name)
                   }
             | nm == nilDataConName
               -- Treat [] as an ExplicitList, so that
@@ -416,8 +416,8 @@ rnExpr (OpApp _ e1 op e2)
         -- more, so I've removed the test.  Adding HsPars in GHC.Tc.Deriv.Generate
         -- should prevent bad things happening.
         ; fixity <- case op' of
-              L _ (HsVar _ (L _ n)) -> lookupFixityRn n
-              L _ (HsRecSel _ f)    -> lookupFieldFixityRn f
+              L _ (HsVar _ (L _ n))      -> lookupFixityRn n
+              L _ (XExpr (HsRecSelRn f)) -> lookupFieldFixityRn f
               _ -> return (Fixity minPrecedence InfixL)
                    -- c.f. lookupFixity for unbound
 
@@ -588,7 +588,6 @@ rnExpr (RecordUpd { rupd_expr = L l expr, rupd_flds = rbinds })
                          (mkRecordDotUpd getField setField (L l e) us)
                         , plusFVs [fv_getField, fv_setField, fv_e, fv_us] ) }
 
-rnExpr (HsRecSel x _) = dataConCantHappen x
 
 rnExpr (ExprWithTySig _ expr pty)
   = do  { (pty', fvTy)    <- rnHsSigWcType ExprWithTySigCtx pty


=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -1467,10 +1467,10 @@ data NegationHandling = ReassociateNegation | KeepNegationIntact
 get_op :: LHsExpr GhcRn -> OpName
 -- An unbound name could be either HsVar or HsUnboundVar
 -- See GHC.Rename.Expr.rnUnboundVar
-get_op (L _ (HsVar _ n))         = NormalOp (unLoc n)
-get_op (L _ (HsUnboundVar _ uv)) = UnboundOp uv
-get_op (L _ (HsRecSel _ fld))    = RecFldOp fld
-get_op other                     = pprPanic "get_op" (ppr other)
+get_op (L _ (HsVar _ n))                 = NormalOp (unLoc n)
+get_op (L _ (HsUnboundVar _ uv))         = UnboundOp uv
+get_op (L _ (XExpr (HsRecSelRn fld)))    = RecFldOp fld
+get_op other                             = pprPanic "get_op" (ppr other)
 
 -- Parser left-associates everything, but
 -- derived instances may have correctly-associated things to


=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -293,7 +293,6 @@ tcExpr e@(HsApp {})              res_ty = tcApp e res_ty
 tcExpr e@(OpApp {})              res_ty = tcApp e res_ty
 tcExpr e@(HsAppType {})          res_ty = tcApp e res_ty
 tcExpr e@(ExprWithTySig {})      res_ty = tcApp e res_ty
-tcExpr e@(HsRecSel {})           res_ty = tcApp e res_ty
 
 tcExpr (XExpr e)                 res_ty = tcXExpr e res_ty
 
@@ -738,7 +737,6 @@ tcXExpr xe@(ExpandedThingRn o e') res_ty
   | OrigStmt ls@(L loc _) <- o
   = setSrcSpanA loc $
        mkExpandedStmtTc ls <$> tcApp (XExpr xe) res_ty
-
 tcXExpr xe res_ty = tcApp (XExpr xe) res_ty
 
 {-


=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -567,7 +567,7 @@ tcInferAppHead_maybe :: HsExpr GhcRn
 tcInferAppHead_maybe fun
   = case fun of
       HsVar _ (L _ nm)          -> Just <$> tcInferId nm
-      HsRecSel _ f              -> Just <$> tcInferRecSelId f
+      XExpr (HsRecSelRn f)      -> Just <$> tcInferRecSelId f
       ExprWithTySig _ e hs_ty   -> Just <$> tcExprWithSig e hs_ty
       HsOverLit _ lit           -> Just <$> tcInferOverLit lit
       _                         -> return Nothing
@@ -599,7 +599,7 @@ tcInferRecSelId :: FieldOcc GhcRn
                 -> TcM ( (HsExpr GhcTc, TcSigmaType))
 tcInferRecSelId (FieldOcc sel_name (L l n))
      = do { sel_id <- tc_rec_sel_id
-        ; let expr = HsRecSel noExtField (FieldOcc sel_name (L l sel_id))
+        ; let expr = XExpr (HsRecSelTc (FieldOcc sel_name (L l sel_id)))
         ; return $ (expr, idType sel_id)
         }
      where


=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -718,7 +718,6 @@ exprCtOrigin :: HsExpr GhcRn -> CtOrigin
 exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name
 exprCtOrigin (HsGetField _ _ (L _ f)) = HasFieldOrigin (field_label $ unLoc $ dfoLabel f)
 exprCtOrigin (HsUnboundVar {})    = Shouldn'tHappenOrigin "unbound variable"
-exprCtOrigin (HsRecSel _ f)       = OccurrenceOfRecSel (foExt f)
 exprCtOrigin (HsOverLabel _ l)  = OverLabelOrigin l
 exprCtOrigin (ExplicitList {})    = ListOrigin
 exprCtOrigin (HsIPVar _ ip)       = IPOccOrigin ip
@@ -759,6 +758,7 @@ exprCtOrigin (XExpr (ExpandedThingRn thing _)) | OrigExpr a <- thing = exprCtOri
                                                | OrigStmt _ <- thing = DoOrigin
                                                | OrigPat p  <- thing = DoPatOrigin p
 exprCtOrigin (XExpr (PopErrCtxt {})) = Shouldn'tHappenOrigin "PopErrCtxt"
+exprCtOrigin (XExpr (HsRecSelRn f))  = OccurrenceOfRecSel (foExt f)
 
 -- | Extract a suitable CtOrigin from a MatchGroup
 matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin


=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -935,9 +935,6 @@ zonkExpr (HsUnboundVar her occ)
            ty'  <- zonkTcTypeToTypeX ty
            return (HER ref ty' u)
 
-zonkExpr (HsRecSel _ (FieldOcc occ (L l v)))
-  = do { v' <- zonkIdOcc v
-       ; return (HsRecSel noExtField (FieldOcc occ (L l v'))) }
 
 zonkExpr (HsIPVar x _) = dataConCantHappen x
 
@@ -1098,6 +1095,10 @@ zonkExpr (XExpr (ConLikeTc con tvs tys))
     -- The tvs come straight from the data-con, and so are strictly redundant
     -- See Wrinkles of Note [Typechecking data constructors] in GHC.Tc.Gen.Head
 
+zonkExpr (XExpr (HsRecSelTc (FieldOcc occ (L l v))))
+  = do { v' <- zonkIdOcc v
+       ; return (XExpr (HsRecSelTc (FieldOcc occ (L l v')))) }
+
 zonkExpr (RecordUpd x _ _)  = dataConCantHappen x
 zonkExpr (HsGetField x _ _) = dataConCantHappen x
 zonkExpr (HsProjection x _) = dataConCantHappen x


=====================================
compiler/Language/Haskell/Syntax/Expr.hs
=====================================
@@ -351,10 +351,6 @@ data HsExpr p
                              --   solving. See Note [Holes] in GHC.Tc.Types.Constraint.
 
 
-  | HsRecSel  (XRecSel p)
-              (FieldOcc p) -- ^ Variable pointing to record selector
-                           -- See Note [Non-overloaded record field selectors] and
-                           -- Note [Record selectors in the AST]
 
   | HsOverLabel (XOverLabel p) FastString
      -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c89f35761a851f7a8be9f03d5b72f0bbfd8d17f
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/20240929/4bb12098/attachment-0001.html>


More information about the ghc-commits mailing list