diff options
| author | Josh Meredith <joshmeredith2008@gmail.com> | 2023-04-11 06:07:35 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-04-26 14:51:28 -0400 |
| commit | 77f506b888624b4fd30205fb8512f39435055a27 (patch) | |
| tree | ccd11d2b2788661a895df3f3e1f942ffee3ef62f /compiler/GHC/StgToJS/StgUtils.hs | |
| parent | c30ac25f7dfaded58bb2ff85d4bffe662e4af8b1 (diff) | |
| download | haskell-77f506b888624b4fd30205fb8512f39435055a27.tar.gz | |
Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364)
Carry the actual type of an expression through the PreStgRhs and into GenStgRhs
for use in later stages. Currently this is used in the JavaScript backend to fix
some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2,
T13822, T14749.
Diffstat (limited to 'compiler/GHC/StgToJS/StgUtils.hs')
| -rw-r--r-- | compiler/GHC/StgToJS/StgUtils.hs | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/compiler/GHC/StgToJS/StgUtils.hs b/compiler/GHC/StgToJS/StgUtils.hs index 62c494c3a7..0632ce8fe6 100644 --- a/compiler/GHC/StgToJS/StgUtils.hs +++ b/compiler/GHC/StgToJS/StgUtils.hs @@ -67,8 +67,8 @@ bindingRefs u = \case rhsRefs :: UniqFM Id CgStgExpr -> CgStgRhs -> Set Id rhsRefs u = \case - StgRhsClosure _ _ _ _ body -> exprRefs u body - StgRhsCon _ccs d _mu _ticks args -> l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args + StgRhsClosure _ _ _ _ body _ -> exprRefs u body + StgRhsCon _ccs d _mu _ticks args _ -> l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args exprRefs :: UniqFM Id CgStgExpr -> CgStgExpr -> Set Id exprRefs u = \case @@ -97,7 +97,7 @@ hasExport bnd = StgNonRec b e -> isExportedBind b e StgRec bs -> any (uncurry isExportedBind) bs where - isExportedBind _i (StgRhsCon _cc con _ _ _) = + isExportedBind _i (StgRhsCon _cc con _ _ _ _) = getUnique con == staticPtrDataConKey isExportedBind _ _ = False @@ -152,8 +152,8 @@ stgBindRhsLive b = stgRhsLive :: CgStgRhs -> LiveVars stgRhsLive = \case - StgRhsClosure _ _ _ args e -> delDVarSetList (stgExprLive True e) args - StgRhsCon _ _ _ _ args -> unionDVarSets (map stgArgLive args) + StgRhsClosure _ _ _ args e _ -> delDVarSetList (stgExprLive True e) args + StgRhsCon _ _ _ _ args _ -> unionDVarSets (map stgArgLive args) stgArgLive :: StgArg -> LiveVars stgArgLive = \case @@ -189,8 +189,8 @@ bindees = \case StgRec bs -> map fst bs isUpdatableRhs :: CgStgRhs -> Bool -isUpdatableRhs (StgRhsClosure _ _ u _ _) = isUpdatable u -isUpdatableRhs _ = False +isUpdatableRhs (StgRhsClosure _ _ u _ _ _) = isUpdatable u +isUpdatableRhs _ = False stgLneLive' :: CgStgBinding -> [Id] stgLneLive' b = filter (`notElem` bindees b) (stgLneLive b) @@ -241,9 +241,9 @@ inspectInlineBinding v = \case inspectInlineRhs :: UniqSet Id -> Id -> CgStgRhs -> UniqSet Id inspectInlineRhs v i = \case - StgRhsCon{} -> addOneToUniqSet v i - StgRhsClosure _ _ ReEntrant _ _ -> addOneToUniqSet v i - _ -> v + StgRhsCon{} -> addOneToUniqSet v i + StgRhsClosure _ _ ReEntrant _ _ _ -> addOneToUniqSet v i + _ -> v isInlineForeignCall :: ForeignCall -> Bool isInlineForeignCall (CCall (CCallSpec _ cconv safety)) = |