Apoorv Ingle pushed to branch wip/ani/T27156 at Glasgow Haskell Compiler / GHC
Commits:
-
e01782f2
by Apoorv Ingle at 2026-11-02T12:20:52-06:00
10 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Tc/Gen/Expand.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Zonk/Type.hs
- libraries/base/src/GHC/Essentials.hs
Changes:
| ... | ... | @@ -715,7 +715,6 @@ data XXExprGhcTc |
| 715 | 715 | | HsRecSelTc (FieldOcc GhcTc) -- ^ Variable pointing to record selector
|
| 716 | 716 | -- See Note [Non-overloaded record field selectors] and
|
| 717 | 717 | -- Note [Record selectors in the AST]
|
| 718 | - | ReSynBindsTc HsModuleName (HsExpr GhcTc)
|
|
| 719 | 718 | |
| 720 | 719 | {- *********************************************************************
|
| 721 | 720 | * *
|
| ... | ... | @@ -1091,8 +1090,6 @@ instance Outputable XXExprGhcTc where |
| 1091 | 1090 | ppr exp, text ")"]
|
| 1092 | 1091 | ppr (HsRecSelTc f) = pprPrefixOcc f
|
| 1093 | 1092 | |
| 1094 | - ppr (ReSynBindsTc m e) = text "{{" <+> ppr m <+> text "}}" <+> ppr e
|
|
| 1095 | - |
|
| 1096 | 1093 | ppr_infix_expr :: forall p. (OutputableBndrId p) => HsExpr (GhcPass p) -> Maybe SDoc
|
| 1097 | 1094 | ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)
|
| 1098 | 1095 | ppr_infix_expr (HsHole x) = Just $ pprInfixOcc $ case (ghcPass @p, x) of
|
| ... | ... | @@ -1121,7 +1118,6 @@ ppr_infix_expr_tc (ConLikeTc con) = Just (pprInfixOcc (conLikeName co |
| 1121 | 1118 | ppr_infix_expr_tc (HsTick {}) = Nothing
|
| 1122 | 1119 | ppr_infix_expr_tc (HsBinTick {}) = Nothing
|
| 1123 | 1120 | ppr_infix_expr_tc (HsRecSelTc f) = Just (pprInfixOcc f)
|
| 1124 | -ppr_infix_expr_tc (ReSynBindsTc _ e) = ppr_infix_expr e
|
|
| 1125 | 1121 | |
| 1126 | 1122 | ppr_infix_hs_expansion :: HsCtxt -> Maybe SDoc
|
| 1127 | 1123 | ppr_infix_hs_expansion (ExprCtxt e) = ppr_infix_expr e
|
| ... | ... | @@ -1215,7 +1211,6 @@ hsExprNeedsParens prec = go |
| 1215 | 1211 | go_x_tc (HsTick _ (L _ e)) = hsExprNeedsParens prec e
|
| 1216 | 1212 | go_x_tc (HsBinTick _ _ (L _ e)) = hsExprNeedsParens prec e
|
| 1217 | 1213 | go_x_tc (HsRecSelTc{}) = False
|
| 1218 | - go_x_tc (ReSynBindsTc _ e) = hsExprNeedsParens prec e
|
|
| 1219 | 1214 | |
| 1220 | 1215 | go_x_rn :: XXExprGhcRn -> Bool
|
| 1221 | 1216 | go_x_rn (ExpandedThingRn (HSE thing _)) = hsExpandedNeedsParens thing
|
| ... | ... | @@ -1269,7 +1264,6 @@ isAtomicHsExpr (XExpr x) |
| 1269 | 1264 | go_x_tc (HsTick {}) = False
|
| 1270 | 1265 | go_x_tc (HsBinTick {}) = False
|
| 1271 | 1266 | go_x_tc (HsRecSelTc{}) = True
|
| 1272 | - go_x_tc (ReSynBindsTc _ e) = isAtomicHsExpr e
|
|
| 1273 | 1267 | |
| 1274 | 1268 | go_x_rn :: XXExprGhcRn -> Bool
|
| 1275 | 1269 | go_x_rn (ExpandedThingRn (HSE thing _)) = isAtomicExpandedThingRn thing
|
| ... | ... | @@ -170,7 +170,6 @@ hsExprType (XExpr (ConLikeTc con)) = conLikeType con |
| 170 | 170 | hsExprType (XExpr (HsTick _ e)) = lhsExprType e
|
| 171 | 171 | hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e
|
| 172 | 172 | hsExprType (XExpr (HsRecSelTc (FieldOcc _ id))) = idType (unLoc id)
|
| 173 | -hsExprType (XExpr (ReSynBindsTc _ e)) = hsExprType e
|
|
| 174 | 173 | |
| 175 | 174 | arithSeqInfoType :: ArithSeqInfo GhcTc -> Type
|
| 176 | 175 | arithSeqInfoType asi = mkListTy $ case asi of
|
| ... | ... | @@ -310,10 +310,6 @@ dsExpr e@(XExpr ext_expr_tc) |
| 310 | 310 | ConLikeTc {} -> dsApp e
|
| 311 | 311 | |
| 312 | 312 | ExpandedThingTc (HSE _ e) -> dsLExpr e
|
| 313 | - ReSynBindsTc m e ->
|
|
| 314 | - do
|
|
| 315 | - tracePm "dsExpr XExpr" (ppr m)
|
|
| 316 | - dsExpr e --TODO ANI: This should never happen?
|
|
| 317 | 313 | |
| 318 | 314 | -- Hpc Support
|
| 319 | 315 | HsTick tickish e -> do
|
| ... | ... | @@ -708,9 +708,6 @@ addTickHsExpr (XExpr (HsBinTick t0 t1 e)) = |
| 708 | 708 | liftM (XExpr . HsBinTick t0 t1) (addTickLHsExprNever e)
|
| 709 | 709 | |
| 710 | 710 | addTickHsExpr e@(XExpr (HsRecSelTc (FieldOcc _ id))) = do freeVar (unLoc id); return e
|
| 711 | -addTickHsExpr (XExpr (ReSynBindsTc m e)) =
|
|
| 712 | - liftM (XExpr . ReSynBindsTc m) (addTickHsExpr e)
|
|
| 713 | - |
|
| 714 | 711 | |
| 715 | 712 | addTickHsExpr (HsDo srcloc cxt (L l stmts))
|
| 716 | 713 | = do { (stmts', _) <- addTickLStmts' forQual stmts (return ())
|
| ... | ... | @@ -1377,8 +1377,6 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where |
| 1377 | 1377 | HsBinTick _ _ expr
|
| 1378 | 1378 | -> [ toHie expr
|
| 1379 | 1379 | ]
|
| 1380 | - ReSynBindsTc _ _
|
|
| 1381 | - -> []
|
|
| 1382 | 1380 | HsRecSelTc fld
|
| 1383 | 1381 | -> [ toHie $ RFC RecFieldOcc Nothing (L mspan fld)
|
| 1384 | 1382 | ]
|
| ... | ... | @@ -610,7 +610,7 @@ rnExpr (HsFunArr _ mult arg res) |
| 610 | 610 | rnExpr (XExpr (ReSynBindsPs m e))
|
| 611 | 611 | = do { traceRn "XExpr ReSynBinds" (text "module:" <+> ppr m)
|
| 612 | 612 | ; (e', fvs) <- rnExpr e
|
| 613 | - ; return (e', fvs)
|
|
| 613 | + ; return (XExpr (ReSynBindsRn m e'), fvs)
|
|
| 614 | 614 | }
|
| 615 | 615 | |
| 616 | 616 | {-
|
| ... | ... | @@ -288,10 +288,31 @@ tcExpand e@(HsUntypedSplice splice_res _) |
| 288 | 288 | ------------------------
|
| 289 | 289 | -- XExpr
|
| 290 | 290 | |
| 291 | +tcExpand e@(XExpr (ReSynBindsRn _ inner_e))
|
|
| 292 | + = do { -- set environment variable to be in rebindable syntax
|
|
| 293 | + -- add the required rebindable syntax binding names into the environment
|
|
| 294 | + -- try expanding inner_e
|
|
| 295 | + traceTc "tcExpand: ReSynBindsRn" (ppr e)
|
|
| 296 | + ; e' <- tcExpand inner_e
|
|
| 297 | + ; let expr = case e' of
|
|
| 298 | + Just (HSE {hse_exp = expanded_e}) ->
|
|
| 299 | + expanded_e
|
|
| 300 | + Nothing ->
|
|
| 301 | + -- likely that inner_e does not contain anything expandable
|
|
| 302 | + -- so we just return inner_e
|
|
| 303 | + wrapGenSpan inner_e
|
|
| 304 | + ; return $ Just $
|
|
| 305 | + HSE { hse_ctxt = ExprCtxt e
|
|
| 306 | + , hse_exp = expr }
|
|
| 307 | + }
|
|
| 308 | + |
|
| 309 | + |
|
| 291 | 310 | -- Expansions are idempotent, XExprs do not expand again
|
| 292 | 311 | tcExpand (XExpr (ExpandedThingRn hse))
|
| 293 | 312 | = return $ Just hse
|
| 294 | 313 | |
| 314 | + |
|
| 315 | + |
|
| 295 | 316 | tcExpand _ = return $ Nothing
|
| 296 | 317 | |
| 297 | 318 |
| ... | ... | @@ -767,11 +767,6 @@ tcExprNoExpand (ArithSeq _ witness seq) res_ty |
| 767 | 767 | tcExprNoExpand (HsTypedSplice ext splice) res_ty = tcTypedSplice ext splice res_ty
|
| 768 | 768 | tcExprNoExpand e@(HsTypedBracket _ext body) res_ty = tcTypedBracket e body res_ty
|
| 769 | 769 | tcExprNoExpand e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty
|
| 770 | -tcExprNoExpand (XExpr (ReSynBindsRn m e)) res_ty
|
|
| 771 | - = do { traceTc "XExpr ReSynBinds" (text "module:" <+> ppr m)
|
|
| 772 | - ; e' <- tcExpr e res_ty
|
|
| 773 | - ; return $ XExpr (ReSynBindsTc m e')
|
|
| 774 | - }
|
|
| 775 | 770 | |
| 776 | 771 | {-
|
| 777 | 772 | ************************************************************************
|
| ... | ... | @@ -1096,10 +1096,6 @@ zonkExpr (XExpr (HsRecSelTc (FieldOcc occ (L l v)))) |
| 1096 | 1096 | = do { v' <- zonkIdOcc v
|
| 1097 | 1097 | ; return (XExpr (HsRecSelTc (FieldOcc occ (L l v')))) }
|
| 1098 | 1098 | |
| 1099 | -zonkExpr (XExpr (ReSynBindsTc m e))
|
|
| 1100 | - = do e' <- zonkExpr e
|
|
| 1101 | - return $ (XExpr (ReSynBindsTc m e'))
|
|
| 1102 | - |
|
| 1103 | 1099 | zonkExpr (RecordUpd x _ _) = dataConCantHappen x
|
| 1104 | 1100 | zonkExpr (HsGetField x _ _) = dataConCantHappen x
|
| 1105 | 1101 | zonkExpr (HsProjection x _) = dataConCantHappen x
|
| ... | ... | @@ -227,7 +227,7 @@ module GHC.Essentials |
| 227 | 227 | , lamE, lamCaseE, lamCasesE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE
|
| 228 | 228 | , letE, caseE, doE, mdoE, compE, fromE, fromThenE, fromToE, fromThenToE
|
| 229 | 229 | , listE, sigE, recConE, recUpdE, staticE, unboundVarE, labelE, implicitParamVarE
|
| 230 | - , getFieldE, projectionE, typeE, forallE, forallVisE, constrainedE
|
|
| 230 | + , getFieldE, projectionE, typeE, forallE, forallVisE, constrainedE, reSynBindsE
|
|
| 231 | 231 | , TH.cxt
|
| 232 | 232 | , TH.noSourceUnpackedness, TH.sourceNoUnpack, TH.sourceUnpack
|
| 233 | 233 | , TH.noSourceStrictness, TH.sourceLazy, TH.sourceStrict
|