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 add reSynBindsE in GHC.Essentials. Remove ReSynBindsTc as we should not need it. Add a tcExpand stub for ReSynBindsRn that should expand to the appropriate expression - - - - - 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: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -715,7 +715,6 @@ data XXExprGhcTc | HsRecSelTc (FieldOcc GhcTc) -- ^ Variable pointing to record selector -- See Note [Non-overloaded record field selectors] and -- Note [Record selectors in the AST] - | ReSynBindsTc HsModuleName (HsExpr GhcTc) {- ********************************************************************* * * @@ -1091,8 +1090,6 @@ instance Outputable XXExprGhcTc where ppr exp, text ")"] ppr (HsRecSelTc f) = pprPrefixOcc f - ppr (ReSynBindsTc m e) = text "{{" <+> ppr m <+> text "}}" <+> ppr e - ppr_infix_expr :: forall p. (OutputableBndrId p) => HsExpr (GhcPass p) -> Maybe SDoc ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v) 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 ppr_infix_expr_tc (HsTick {}) = Nothing ppr_infix_expr_tc (HsBinTick {}) = Nothing ppr_infix_expr_tc (HsRecSelTc f) = Just (pprInfixOcc f) -ppr_infix_expr_tc (ReSynBindsTc _ e) = ppr_infix_expr e ppr_infix_hs_expansion :: HsCtxt -> Maybe SDoc ppr_infix_hs_expansion (ExprCtxt e) = ppr_infix_expr e @@ -1215,7 +1211,6 @@ hsExprNeedsParens prec = go 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_tc (ReSynBindsTc _ e) = hsExprNeedsParens prec e go_x_rn :: XXExprGhcRn -> Bool go_x_rn (ExpandedThingRn (HSE thing _)) = hsExpandedNeedsParens thing @@ -1269,7 +1264,6 @@ isAtomicHsExpr (XExpr x) go_x_tc (HsTick {}) = False go_x_tc (HsBinTick {}) = False go_x_tc (HsRecSelTc{}) = True - go_x_tc (ReSynBindsTc _ e) = isAtomicHsExpr e go_x_rn :: XXExprGhcRn -> Bool go_x_rn (ExpandedThingRn (HSE thing _)) = isAtomicExpandedThingRn thing ===================================== compiler/GHC/Hs/Syn/Type.hs ===================================== @@ -170,7 +170,6 @@ 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) -hsExprType (XExpr (ReSynBindsTc _ e)) = hsExprType e arithSeqInfoType :: ArithSeqInfo GhcTc -> Type arithSeqInfoType asi = mkListTy $ case asi of ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -310,10 +310,6 @@ dsExpr e@(XExpr ext_expr_tc) ConLikeTc {} -> dsApp e ExpandedThingTc (HSE _ e) -> dsLExpr e - ReSynBindsTc m e -> - do - tracePm "dsExpr XExpr" (ppr m) - dsExpr e --TODO ANI: This should never happen? -- Hpc Support HsTick tickish e -> do ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -708,9 +708,6 @@ 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 (XExpr (ReSynBindsTc m e)) = - liftM (XExpr . ReSynBindsTc m) (addTickHsExpr e) - addTickHsExpr (HsDo srcloc cxt (L l stmts)) = do { (stmts', _) <- addTickLStmts' forQual stmts (return ()) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1377,8 +1377,6 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where HsBinTick _ _ expr -> [ toHie expr ] - ReSynBindsTc _ _ - -> [] HsRecSelTc fld -> [ toHie $ RFC RecFieldOcc Nothing (L mspan fld) ] ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -610,7 +610,7 @@ rnExpr (HsFunArr _ mult arg res) rnExpr (XExpr (ReSynBindsPs m e)) = do { traceRn "XExpr ReSynBinds" (text "module:" <+> ppr m) ; (e', fvs) <- rnExpr e - ; return (e', fvs) + ; return (XExpr (ReSynBindsRn m e'), fvs) } {- ===================================== compiler/GHC/Tc/Gen/Expand.hs ===================================== @@ -288,10 +288,31 @@ tcExpand e@(HsUntypedSplice splice_res _) ------------------------ -- XExpr +tcExpand e@(XExpr (ReSynBindsRn _ inner_e)) + = do { -- set environment variable to be in rebindable syntax + -- add the required rebindable syntax binding names into the environment + -- try expanding inner_e + traceTc "tcExpand: ReSynBindsRn" (ppr e) + ; e' <- tcExpand inner_e + ; let expr = case e' of + Just (HSE {hse_exp = expanded_e}) -> + expanded_e + Nothing -> + -- likely that inner_e does not contain anything expandable + -- so we just return inner_e + wrapGenSpan inner_e + ; return $ Just $ + HSE { hse_ctxt = ExprCtxt e + , hse_exp = expr } + } + + -- Expansions are idempotent, XExprs do not expand again tcExpand (XExpr (ExpandedThingRn hse)) = return $ Just hse + + tcExpand _ = return $ Nothing ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -767,11 +767,6 @@ tcExprNoExpand (ArithSeq _ witness seq) res_ty tcExprNoExpand (HsTypedSplice ext splice) res_ty = tcTypedSplice ext splice res_ty tcExprNoExpand e@(HsTypedBracket _ext body) res_ty = tcTypedBracket e body res_ty tcExprNoExpand e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty -tcExprNoExpand (XExpr (ReSynBindsRn m e)) res_ty - = do { traceTc "XExpr ReSynBinds" (text "module:" <+> ppr m) - ; e' <- tcExpr e res_ty - ; return $ XExpr (ReSynBindsTc m e') - } {- ************************************************************************ ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1096,10 +1096,6 @@ zonkExpr (XExpr (HsRecSelTc (FieldOcc occ (L l v)))) = do { v' <- zonkIdOcc v ; return (XExpr (HsRecSelTc (FieldOcc occ (L l v')))) } -zonkExpr (XExpr (ReSynBindsTc m e)) - = do e' <- zonkExpr e - return $ (XExpr (ReSynBindsTc m e')) - zonkExpr (RecordUpd x _ _) = dataConCantHappen x zonkExpr (HsGetField x _ _) = dataConCantHappen x zonkExpr (HsProjection x _) = dataConCantHappen x ===================================== libraries/base/src/GHC/Essentials.hs ===================================== @@ -227,7 +227,7 @@ module GHC.Essentials , lamE, lamCaseE, lamCasesE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE , letE, caseE, doE, mdoE, compE, fromE, fromThenE, fromToE, fromThenToE , listE, sigE, recConE, recUpdE, staticE, unboundVarE, labelE, implicitParamVarE - , getFieldE, projectionE, typeE, forallE, forallVisE, constrainedE + , getFieldE, projectionE, typeE, forallE, forallVisE, constrainedE, reSynBindsE , TH.cxt , TH.noSourceUnpackedness, TH.sourceNoUnpack, TH.sourceUnpack , TH.noSourceStrictness, TH.sourceLazy, TH.sourceStrict View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e01782f263bf75628574d508bbeb331c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e01782f263bf75628574d508bbeb331c... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help