diff options
| author | Josh Meredith <joshmeredith2008@gmail.com> | 2023-04-11 06:07:35 +0000 |
|---|---|---|
| committer | Josh Meredith <joshmeredith2008@gmail.com> | 2023-04-26 10:35:06 +0000 |
| commit | eba7b247f31a420cae64d0ee87d7296bf434724e (patch) | |
| tree | ff20a73518f78cfa52a6cd7c2b956b98d8a1dd33 /compiler/GHC/StgToJS/Sinker.hs | |
| parent | 74c557121fbcae32abd3b4a69513f8aa7d536073 (diff) | |
| download | haskell-wip/js-stgrhsclosure.tar.gz | |
Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364)wip/js-stgrhsclosure
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/Sinker.hs')
| -rw-r--r-- | compiler/GHC/StgToJS/Sinker.hs | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/compiler/GHC/StgToJS/Sinker.hs b/compiler/GHC/StgToJS/Sinker.hs index 6df58d4fcf..f758a7ac94 100644 --- a/compiler/GHC/StgToJS/Sinker.hs +++ b/compiler/GHC/StgToJS/Sinker.hs @@ -64,11 +64,11 @@ sinkPgm' m pgm = alwaysSinkable :: CgStgBinding -> [(Id, CgStgExpr)] alwaysSinkable (StgRec {}) = [] alwaysSinkable (StgNonRec b rhs) = case rhs of - StgRhsClosure _ _ _ _ e@(StgLit l) + StgRhsClosure _ _ _ _ e@(StgLit l) _ | isSmallSinkableLit l , isLocal b -> [(b,e)] - StgRhsCon _ccs dc cnum _ticks as@[StgLitArg l] + StgRhsCon _ccs dc cnum _ticks as@[StgLitArg l] _typ | isSmallSinkableLit l , isLocal b , isUnboxableCon dc @@ -88,9 +88,9 @@ onceSinkable _m (StgNonRec b rhs) , isLocal b = [(b,e)] where getSinkable = \case - StgRhsCon _ccs dc cnum _ticks args -> Just (StgConApp dc cnum args []) - StgRhsClosure _ _ _ _ e@(StgLit{}) -> Just e - _ -> Nothing + StgRhsCon _ccs dc cnum _ticks args _typ -> Just (StgConApp dc cnum args []) + StgRhsClosure _ _ _ _ e@(StgLit{}) _typ -> Just e + _ -> Nothing onceSinkable _ _ = [] -- | collect all idents used only once in an argument at the top level @@ -115,8 +115,8 @@ collectArgsTop = \case collectArgsTopRhs :: CgStgRhs -> [Id] collectArgsTopRhs = \case - StgRhsCon _ccs _dc _mu _ticks args -> concatMap collectArgsA args - StgRhsClosure {} -> [] + StgRhsCon _ccs _dc _mu _ticks args _typ -> concatMap collectArgsA args + StgRhsClosure {} -> [] -- | fold over all Id in StgArg in the AST collectArgs :: CgStgBinding -> [Id] @@ -126,8 +126,8 @@ collectArgs = \case collectArgsR :: CgStgRhs -> [Id] collectArgsR = \case - StgRhsClosure _x0 _x1 _x2 _x3 e -> collectArgsE e - StgRhsCon _ccs _con _mu _ticks args -> concatMap collectArgsA args + StgRhsClosure _x0 _x1 _x2 _x3 e _typ -> collectArgsE e + StgRhsCon _ccs _con _mu _ticks args _typ -> concatMap collectArgsA args collectArgsAlt :: CgStgAlt -> [Id] collectArgsAlt alt = collectArgsE (alt_rhs alt) @@ -171,7 +171,7 @@ topSortDecls _m binds = rest ++ nr' keys = mkUniqSet (map node_key vs) getV e@(StgNonRec b _) = DigraphNode e b [] getV _ = error "topSortDecls: getV, unexpected binding" - collectDeps (StgNonRec b (StgRhsCon _cc _dc _cnum _ticks args)) = + collectDeps (StgNonRec b (StgRhsCon _cc _dc _cnum _ticks args _typ)) = [ (i, b) | StgVarArg i <- args, i `elementOfUniqSet` keys ] collectDeps _ = [] g = graphFromVerticesAndAdjacency vs (concatMap collectDeps nr) |