From 05d26a650b6e9e1169b42376fe54bb00850722f2 Mon Sep 17 00:00:00 2001
From: Cheng Shao <terrorjack@type.dance>
Date: Fri, 7 Apr 2023 18:39:59 +0000
Subject: compiler: apply cmm node-splitting for wasm backend

This patch applies cmm node-splitting for wasm32 NCG, which is
required when handling irreducible CFGs. Fixes #23237.
---
 compiler/GHC/CmmToAsm/Wasm/FromCmm.hs    |  2 ++
 compiler/GHC/Wasm/ControlFlow/FromCmm.hs | 11 ++++++++---
 2 files changed, 10 insertions(+), 3 deletions(-)

(limited to 'compiler/GHC')

diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
index db4b39f756..7ca323d72d 100644
--- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
@@ -1529,9 +1529,11 @@ lower_CmmGraph :: CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
 lower_CmmGraph lbl g = do
   ty_word <- wasmWordTypeM
   platform <- wasmPlatformM
+  us <- getUniqueSupplyM
   body <-
     structuredControl
       platform
+      us
       (\_ -> lower_CmmExpr_Typed lbl ty_word)
       (lower_CmmActions lbl)
       g
diff --git a/compiler/GHC/Wasm/ControlFlow/FromCmm.hs b/compiler/GHC/Wasm/ControlFlow/FromCmm.hs
index 85eb8e534b..b0449aaedc 100644
--- a/compiler/GHC/Wasm/ControlFlow/FromCmm.hs
+++ b/compiler/GHC/Wasm/ControlFlow/FromCmm.hs
@@ -19,12 +19,13 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dominators
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.Reducibility
 import GHC.Cmm.Switch
 
 import GHC.CmmToAsm.Wasm.Types
 
 import GHC.Platform
-
+import GHC.Types.Unique.Supply
 import GHC.Utils.Misc
 import GHC.Utils.Panic
 import GHC.Utils.Outputable ( Outputable, text, (<+>), ppr
@@ -140,15 +141,19 @@ emptyPost _ = False
 structuredControl :: forall expr stmt m .
                      Applicative m
                   => Platform  -- ^ needed for offset calculation
+                  -> UniqSupply
                   -> (Label -> CmmExpr -> m expr) -- ^ translator for expressions
                   -> (Label -> CmmActions -> m stmt) -- ^ translator for straight-line code
                   -> CmmGraph -- ^ CFG to be translated
                   -> m (WasmControl stmt expr '[] '[ 'I32])
-structuredControl platform txExpr txBlock g =
+structuredControl platform us txExpr txBlock g' =
    doTree returns dominatorTree emptyContext
  where
+   g :: CmmGraph
+   g = gwd_graph gwd
+
    gwd :: GraphWithDominators CmmNode
-   gwd = graphWithDominators g
+   gwd = initUs_ us $ asReducible $ graphWithDominators g'
 
    dominatorTree :: Tree.Tree CmmBlock-- Dominator tree in which children are sorted
                                        -- with highest reverse-postorder number first
-- 
cgit v1.2.1