{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
module GHC.Wasm.ControlFlow.FromCmm
( structuredControl
)
where
import GHC.Prelude hiding (succ)
import Data.Function
import Data.List (sortBy)
import qualified Data.Tree as Tree
import GHC.Cmm
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dominators
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Switch
import GHC.CmmToAsm.Wasm.Types
import GHC.Platform
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Outputable ( Outputable, text, (<+>), ppr
, pprWithCommas
)
import GHC.Wasm.ControlFlow
data ControlFlow e = Unconditional Label
| Conditional e Label Label
| Switch { forall e. ControlFlow e -> e
_scrutinee :: e
, forall e. ControlFlow e -> BrTableInterval
_range :: BrTableInterval
, forall e. ControlFlow e -> [Maybe Label]
_targets :: [Maybe Label]
, forall e. ControlFlow e -> Maybe Label
_defaultTarget :: Maybe Label
}
| TailCall e
flowLeaving :: Platform -> CmmBlock -> ControlFlow CmmExpr
flowLeaving :: Platform -> CmmBlock -> ControlFlow CmmExpr
flowLeaving Platform
platform CmmBlock
b =
case CmmBlock -> CmmNode O C
forall (n :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
Block n x C -> n O C
lastNode CmmBlock
b of
CmmBranch Label
l -> Label -> ControlFlow CmmExpr
forall e. Label -> ControlFlow e
Unconditional Label
l
CmmCondBranch CmmExpr
c Label
t Label
f Maybe Bool
_ -> CmmExpr -> Label -> Label -> ControlFlow CmmExpr
forall e. e -> Label -> Label -> ControlFlow e
Conditional CmmExpr
c Label
t Label
f
CmmSwitch CmmExpr
e SwitchTargets
targets ->
let (Int
offset, [Maybe Label]
target_labels) = SwitchTargets -> (Int, [Maybe Label])
switchTargetsToTable SwitchTargets
targets
(Integer
lo, Integer
hi) = SwitchTargets -> (Integer, Integer)
switchTargetsRange SwitchTargets
targets
default_label :: Maybe Label
default_label = SwitchTargets -> Maybe Label
switchTargetsDefault SwitchTargets
targets
scrutinee :: CmmExpr
scrutinee = Platform -> CmmExpr -> CmmExpr
smartExtend Platform
platform (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> Int -> CmmExpr
smartPlus Platform
platform CmmExpr
e Int
offset
range :: BrTableInterval
range = Integer -> Integer -> BrTableInterval
inclusiveInterval (Integer
loInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
offset) (Integer
hiInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
offset)
in CmmExpr
-> BrTableInterval
-> [Maybe Label]
-> Maybe Label
-> ControlFlow CmmExpr
forall e.
e
-> BrTableInterval -> [Maybe Label] -> Maybe Label -> ControlFlow e
Switch CmmExpr
scrutinee BrTableInterval
range [Maybe Label]
target_labels Maybe Label
default_label
CmmCall { cml_cont :: CmmNode O C -> Maybe Label
cml_cont = Maybe Label
Nothing, cml_target :: CmmNode O C -> CmmExpr
cml_target = CmmExpr
e } -> CmmExpr -> ControlFlow CmmExpr
forall e. e -> ControlFlow e
TailCall CmmExpr
e
CmmNode O C
_ -> String -> ControlFlow CmmExpr
forall a. HasCallStack => String -> a
panic String
"flowLeaving: unreachable"
data ContainingSyntax
= BlockFollowedBy Label
| LoopHeadedBy Label
| IfThenElse (Maybe Label)
matchesFrame :: Label -> ContainingSyntax -> Bool
matchesFrame :: Label -> ContainingSyntax -> Bool
matchesFrame Label
label (BlockFollowedBy Label
l) = Label
label Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
l
matchesFrame Label
label (LoopHeadedBy Label
l) = Label
label Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
l
matchesFrame Label
label (IfThenElse (Just Label
l)) = Label
label Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
l
matchesFrame Label
_ ContainingSyntax
_ = Bool
False
data Context = Context { Context -> [ContainingSyntax]
enclosing :: [ContainingSyntax]
, Context -> Maybe Label
fallthrough :: Maybe Label
}
instance Outputable Context where
ppr :: Context -> SDoc
ppr Context
c | Just Label
l <- Context -> Maybe Label
fallthrough Context
c =
(ContainingSyntax -> SDoc) -> [ContainingSyntax] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas ContainingSyntax -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Context -> [ContainingSyntax]
enclosing Context
c) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fallthrough to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
l
| Bool
otherwise = (ContainingSyntax -> SDoc) -> [ContainingSyntax] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas ContainingSyntax -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Context -> [ContainingSyntax]
enclosing Context
c)
emptyContext :: Context
emptyContext :: Context
emptyContext = [ContainingSyntax] -> Maybe Label -> Context
Context [] Maybe Label
forall a. Maybe a
Nothing
inside :: ContainingSyntax -> Context -> Context
withFallthrough :: Context -> Label -> Context
inside :: ContainingSyntax -> Context -> Context
inside ContainingSyntax
frame Context
c = Context
c { enclosing = frame : enclosing c }
withFallthrough :: Context -> Label -> Context
withFallthrough Context
c Label
l = Context
c { fallthrough = Just l }
type CmmActions = Block CmmNode O O
type FT pre post = WasmFunctionType pre post
returns :: FT '[] '[ 'I32]
doesn'tReturn :: FT '[] '[]
returns :: FT '[] '[ 'I32]
returns = TypeList '[] -> TypeList '[ 'I32] -> FT '[] '[ 'I32]
forall (pre :: [WasmType]) (post :: [WasmType]).
TypeList pre -> TypeList post -> WasmFunctionType pre post
WasmFunctionType TypeList '[]
TypeListNil (WasmTypeTag 'I32 -> TypeList '[] -> TypeList '[ 'I32]
forall (t :: WasmType) (ts :: [WasmType]).
WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
TypeListCons WasmTypeTag 'I32
TagI32 TypeList '[]
TypeListNil)
doesn'tReturn :: FT '[] '[]
doesn'tReturn = TypeList '[] -> TypeList '[] -> FT '[] '[]
forall (pre :: [WasmType]) (post :: [WasmType]).
TypeList pre -> TypeList post -> WasmFunctionType pre post
WasmFunctionType TypeList '[]
TypeListNil TypeList '[]
TypeListNil
emptyPost :: FT pre post -> Bool
emptyPost :: forall (pre :: [WasmType]) (post :: [WasmType]).
FT pre post -> Bool
emptyPost (WasmFunctionType TypeList pre
_ TypeList post
TypeListNil) = Bool
True
emptyPost WasmFunctionType pre post
_ = Bool
False
structuredControl :: forall expr stmt m .
Applicative m
=> Platform
-> (Label -> CmmExpr -> m expr)
-> (Label -> CmmActions -> m stmt)
-> CmmGraph
-> m (WasmControl stmt expr '[] '[ 'I32])
structuredControl :: forall expr stmt (m :: * -> *).
Applicative m =>
Platform
-> (Label -> CmmExpr -> m expr)
-> (Label -> CmmActions -> m stmt)
-> CmmGraph
-> m (WasmControl stmt expr '[] '[ 'I32])
structuredControl Platform
platform Label -> CmmExpr -> m expr
txExpr Label -> CmmActions -> m stmt
txBlock CmmGraph
g =
FT '[] '[ 'I32]
-> Tree CmmBlock
-> Context
-> m (WasmControl stmt expr '[] '[ 'I32])
forall (post :: [WasmType]).
FT '[] post
-> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
doTree FT '[] '[ 'I32]
returns Tree CmmBlock
dominatorTree Context
emptyContext
where
gwd :: GraphWithDominators CmmNode
gwd :: GraphWithDominators CmmNode
gwd = CmmGraph -> GraphWithDominators CmmNode
forall (node :: Extensibility -> Extensibility -> *).
(NonLocal node, () :: Constraint) =>
GenCmmGraph node -> GraphWithDominators node
graphWithDominators CmmGraph
g
dominatorTree :: Tree.Tree CmmBlock
dominatorTree :: Tree CmmBlock
dominatorTree = (Label -> CmmBlock) -> Tree Label -> Tree CmmBlock
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Label -> CmmBlock
blockLabeled (Tree Label -> Tree CmmBlock) -> Tree Label -> Tree CmmBlock
forall a b. (a -> b) -> a -> b
$ Tree Label -> Tree Label
sortTree (Tree Label -> Tree Label) -> Tree Label -> Tree Label
forall a b. (a -> b) -> a -> b
$ GraphWithDominators CmmNode -> Tree Label
forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> Tree Label
gwdDominatorTree GraphWithDominators CmmNode
gwd
doTree :: FT '[] post -> Tree.Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
nodeWithin :: forall post .
FT '[] post -> CmmBlock -> [Tree.Tree CmmBlock] -> Maybe Label
-> Context -> m (WasmControl stmt expr '[] post)
doBranch :: FT '[] post -> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
doTree :: forall (post :: [WasmType]).
FT '[] post
-> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
doTree FT '[] post
fty (Tree.Node CmmBlock
x [Tree CmmBlock]
children) Context
context =
let codeForX :: Context -> m (WasmControl stmt expr '[] post)
codeForX = FT '[] post
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] post)
forall (post :: [WasmType]).
FT '[] post
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] post)
nodeWithin FT '[] post
fty CmmBlock
x [Tree CmmBlock]
selectedChildren Maybe Label
forall a. Maybe a
Nothing
in if CmmBlock -> Bool
isLoopHeader CmmBlock
x then
FT '[] post
-> WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post
forall (c :: [WasmType]) (d :: [WasmType]) a b.
WasmFunctionType c d -> WasmControl a b c d -> WasmControl a b c d
WasmLoop FT '[] post
fty (WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> m (WasmControl stmt expr '[] post)
codeForX Context
loopContext
else
Context -> m (WasmControl stmt expr '[] post)
codeForX Context
context
where selectedChildren :: [Tree CmmBlock]
selectedChildren = case CmmBlock -> CmmNode O C
forall (n :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
Block n x C -> n O C
lastNode CmmBlock
x of
CmmSwitch {} -> [Tree CmmBlock]
children
CmmNode O C
_ -> (Tree CmmBlock -> Bool) -> [Tree CmmBlock] -> [Tree CmmBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter Tree CmmBlock -> Bool
hasMergeRoot [Tree CmmBlock]
children
loopContext :: Context
loopContext = Label -> ContainingSyntax
LoopHeadedBy (CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
x) ContainingSyntax -> Context -> Context
`inside` Context
context
hasMergeRoot :: Tree CmmBlock -> Bool
hasMergeRoot = CmmBlock -> Bool
isMergeNode (CmmBlock -> Bool)
-> (Tree CmmBlock -> CmmBlock) -> Tree CmmBlock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree CmmBlock -> CmmBlock
forall a. Tree a -> a
Tree.rootLabel
nodeWithin :: forall (post :: [WasmType]).
FT '[] post
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] post)
nodeWithin FT '[] post
fty CmmBlock
x (Tree CmmBlock
y_n:[Tree CmmBlock]
ys) (Just Label
zlabel) Context
context =
FT '[] post
-> WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post
forall (c :: [WasmType]) (d :: [WasmType]) a b.
WasmFunctionType c d -> WasmControl a b c d -> WasmControl a b c d
WasmBlock FT '[] post
fty (WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FT '[] post
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] post)
forall (post :: [WasmType]).
FT '[] post
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] post)
nodeWithin FT '[] post
fty CmmBlock
x (Tree CmmBlock
y_nTree CmmBlock -> [Tree CmmBlock] -> [Tree CmmBlock]
forall a. a -> [a] -> [a]
:[Tree CmmBlock]
ys) Maybe Label
forall a. Maybe a
Nothing Context
context'
where context' :: Context
context' = Label -> ContainingSyntax
BlockFollowedBy Label
zlabel ContainingSyntax -> Context -> Context
`inside` Context
context
nodeWithin FT '[] post
fty CmmBlock
x (Tree CmmBlock
y_n:[Tree CmmBlock]
ys) Maybe Label
Nothing Context
context =
FT '[] '[]
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] '[])
forall (post :: [WasmType]).
FT '[] post
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] post)
nodeWithin FT '[] '[]
doesn'tReturn CmmBlock
x [Tree CmmBlock]
ys (Label -> Maybe Label
forall a. a -> Maybe a
Just Label
ylabel) (Context
context Context -> Label -> Context
`withFallthrough` Label
ylabel) m (WasmControl stmt expr '[] '[])
-> m (WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
forall (m :: * -> *) s e (pre :: [WasmType]) (mid :: [WasmType])
(post :: [WasmType]).
Applicative m =>
m (WasmControl s e pre mid)
-> m (WasmControl s e mid post) -> m (WasmControl s e pre post)
<<>>
FT '[] post
-> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
forall (post :: [WasmType]).
FT '[] post
-> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
doTree FT '[] post
fty Tree CmmBlock
y_n Context
context
where ylabel :: Label
ylabel = Tree CmmBlock -> Label
treeEntryLabel Tree CmmBlock
y_n
nodeWithin FT '[] post
fty CmmBlock
x [] (Just Label
zlabel) Context
context
| Bool -> Bool
not (CmmBlock -> Bool
generatesIf CmmBlock
x) =
FT '[] post
-> WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post
forall (c :: [WasmType]) (d :: [WasmType]) a b.
WasmFunctionType c d -> WasmControl a b c d -> WasmControl a b c d
WasmBlock FT '[] post
fty (WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FT '[] post
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] post)
forall (post :: [WasmType]).
FT '[] post
-> CmmBlock
-> [Tree CmmBlock]
-> Maybe Label
-> Context
-> m (WasmControl stmt expr '[] post)
nodeWithin FT '[] post
fty CmmBlock
x [] Maybe Label
forall a. Maybe a
Nothing Context
context'
where context' :: Context
context' = Label -> ContainingSyntax
BlockFollowedBy Label
zlabel ContainingSyntax -> Context -> Context
`inside` Context
context
nodeWithin FT '[] post
fty CmmBlock
x [] Maybe Label
maybeMarks Context
context =
Context -> m (WasmControl stmt expr '[] post)
translationOfX Context
context
where xlabel :: Label
xlabel = CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
x
translationOfX :: Context -> m (WasmControl stmt expr '[] post)
translationOfX :: Context -> m (WasmControl stmt expr '[] post)
translationOfX Context
context =
(stmt -> WasmControl stmt expr '[] '[]
forall a b (c :: [WasmType]). a -> WasmControl a b c c
WasmActions (stmt -> WasmControl stmt expr '[] '[])
-> m stmt -> m (WasmControl stmt expr '[] '[])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label -> CmmActions -> m stmt
txBlock Label
xlabel (CmmBlock -> CmmActions
nodeBody CmmBlock
x)) m (WasmControl stmt expr '[] '[])
-> m (WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
forall (m :: * -> *) s e (pre :: [WasmType]) (mid :: [WasmType])
(post :: [WasmType]).
Applicative m =>
m (WasmControl s e pre mid)
-> m (WasmControl s e mid post) -> m (WasmControl s e pre post)
<<>>
case Platform -> CmmBlock -> ControlFlow CmmExpr
flowLeaving Platform
platform CmmBlock
x of
Unconditional Label
l -> FT '[] post
-> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
forall (post :: [WasmType]).
FT '[] post
-> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
doBranch FT '[] post
fty Label
xlabel Label
l Context
context
Conditional CmmExpr
e Label
t Label
f ->
FT '[] post
-> expr
-> WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post
forall (pre :: [WasmType]) (post :: [WasmType]) e s.
WasmFunctionType pre post
-> e
-> WasmControl s e pre post
-> WasmControl s e pre post
-> WasmControl s e pre post
WasmIf FT '[] post
fty
(expr
-> WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post)
-> m expr
-> m (WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label -> CmmExpr -> m expr
txExpr Label
xlabel CmmExpr
e
m (WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FT '[] post
-> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
forall (post :: [WasmType]).
FT '[] post
-> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
doBranch FT '[] post
fty Label
xlabel Label
t (Maybe Label -> ContainingSyntax
IfThenElse Maybe Label
maybeMarks ContainingSyntax -> Context -> Context
`inside` Context
context)
m (WasmControl stmt expr '[] post
-> WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
-> m (WasmControl stmt expr '[] post)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FT '[] post
-> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
forall (post :: [WasmType]).
FT '[] post
-> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
doBranch FT '[] post
fty Label
xlabel Label
f (Maybe Label -> ContainingSyntax
IfThenElse Maybe Label
maybeMarks ContainingSyntax -> Context -> Context
`inside` Context
context)
TailCall CmmExpr
e -> expr -> WasmControl stmt expr '[] post
forall b a (c :: [WasmType]) (d :: [WasmType]).
b -> WasmControl a b c d
WasmTailCall (expr -> WasmControl stmt expr '[] post)
-> m expr -> m (WasmControl stmt expr '[] post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label -> CmmExpr -> m expr
txExpr Label
xlabel CmmExpr
e
Switch CmmExpr
e BrTableInterval
range [Maybe Label]
targets Maybe Label
default' ->
expr
-> BrTableInterval
-> [Int]
-> Int
-> WasmControl stmt expr '[] post
forall b a (c :: [WasmType]) (d :: [WasmType]).
b -> BrTableInterval -> [Int] -> Int -> WasmControl a b c d
WasmBrTable (expr
-> BrTableInterval
-> [Int]
-> Int
-> WasmControl stmt expr '[] post)
-> m expr
-> m (BrTableInterval
-> [Int] -> Int -> WasmControl stmt expr '[] post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label -> CmmExpr -> m expr
txExpr Label
xlabel CmmExpr
e
m (BrTableInterval
-> [Int] -> Int -> WasmControl stmt expr '[] post)
-> BrTableInterval
-> m ([Int] -> Int -> WasmControl stmt expr '[] post)
forall (m :: * -> *) a b. Functor m => m (a -> b) -> a -> m b
<$~> BrTableInterval
range
m ([Int] -> Int -> WasmControl stmt expr '[] post)
-> [Int] -> m (Int -> WasmControl stmt expr '[] post)
forall (m :: * -> *) a b. Functor m => m (a -> b) -> a -> m b
<$~> (Maybe Label -> Int) -> [Maybe Label] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Label -> Int
switchIndex [Maybe Label]
targets
m (Int -> WasmControl stmt expr '[] post)
-> Int -> m (WasmControl stmt expr '[] post)
forall (m :: * -> *) a b. Functor m => m (a -> b) -> a -> m b
<$~> Maybe Label -> Int
switchIndex Maybe Label
default'
where switchIndex :: Maybe Label -> Int
switchIndex :: Maybe Label -> Int
switchIndex Maybe Label
Nothing = Int
0
switchIndex (Just Label
lbl) = Label -> [ContainingSyntax] -> Int
index Label
lbl (Context -> [ContainingSyntax]
enclosing Context
context)
doBranch :: forall (post :: [WasmType]).
FT '[] post
-> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
doBranch FT '[] post
fty Label
from Label
to Context
context
| Label
to Label -> Maybe Label -> Bool
forall a. Eq a => a -> Maybe a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Context -> Maybe Label
fallthrough Context
context Bool -> Bool -> Bool
&& FT '[] post -> Bool
forall (pre :: [WasmType]) (post :: [WasmType]).
FT pre post -> Bool
emptyPost FT '[] post
fty = WasmControl stmt expr '[] post
-> m (WasmControl stmt expr '[] post)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WasmControl stmt expr '[] post
forall a b (c :: [WasmType]) (d :: [WasmType]). WasmControl a b c d
WasmFallthrough
| Label -> Label -> Bool
isBackward Label
from Label
to = WasmControl stmt expr '[] post
-> m (WasmControl stmt expr '[] post)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmControl stmt expr '[] post
-> m (WasmControl stmt expr '[] post))
-> WasmControl stmt expr '[] post
-> m (WasmControl stmt expr '[] post)
forall a b. (a -> b) -> a -> b
$ Int -> WasmControl stmt expr '[] post
forall a b (c :: [WasmType]) (d :: [WasmType]).
Int -> WasmControl a b c d
WasmBr Int
i
| Label -> Bool
isMergeLabel Label
to = WasmControl stmt expr '[] post
-> m (WasmControl stmt expr '[] post)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmControl stmt expr '[] post
-> m (WasmControl stmt expr '[] post))
-> WasmControl stmt expr '[] post
-> m (WasmControl stmt expr '[] post)
forall a b. (a -> b) -> a -> b
$ Int -> WasmControl stmt expr '[] post
forall a b (c :: [WasmType]) (d :: [WasmType]).
Int -> WasmControl a b c d
WasmBr Int
i
| Bool
otherwise = FT '[] post
-> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
forall (post :: [WasmType]).
FT '[] post
-> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
doTree FT '[] post
fty (Label -> Tree CmmBlock
subtreeAt Label
to) Context
context
where i :: Int
i = Label -> [ContainingSyntax] -> Int
index Label
to (Context -> [ContainingSyntax]
enclosing Context
context)
generatesIf :: CmmBlock -> Bool
generatesIf :: CmmBlock -> Bool
generatesIf CmmBlock
x = case Platform -> CmmBlock -> ControlFlow CmmExpr
flowLeaving Platform
platform CmmBlock
x of Conditional {} -> Bool
True
ControlFlow CmmExpr
_ -> Bool
False
treeEntryLabel :: Tree.Tree CmmBlock -> Label
treeEntryLabel :: Tree CmmBlock -> Label
treeEntryLabel = CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel (CmmBlock -> Label)
-> (Tree CmmBlock -> CmmBlock) -> Tree CmmBlock -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree CmmBlock -> CmmBlock
forall a. Tree a -> a
Tree.rootLabel
sortTree :: Tree.Tree Label -> Tree.Tree Label
sortTree :: Tree Label -> Tree Label
sortTree (Tree.Node Label
label [Tree Label]
children) =
Label -> [Tree Label] -> Tree Label
forall a. a -> [Tree a] -> Tree a
Tree.Node Label
label ([Tree Label] -> Tree Label) -> [Tree Label] -> Tree Label
forall a b. (a -> b) -> a -> b
$ (Tree Label -> Tree Label -> Ordering)
-> [Tree Label] -> [Tree Label]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((RPNum -> RPNum -> Ordering) -> RPNum -> RPNum -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip RPNum -> RPNum -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RPNum -> RPNum -> Ordering)
-> (Tree Label -> RPNum) -> Tree Label -> Tree Label -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Label -> RPNum
rpnum (Label -> RPNum) -> (Tree Label -> Label) -> Tree Label -> RPNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Label -> Label
forall a. Tree a -> a
Tree.rootLabel)) ([Tree Label] -> [Tree Label]) -> [Tree Label] -> [Tree Label]
forall a b. (a -> b) -> a -> b
$
(Tree Label -> Tree Label) -> [Tree Label] -> [Tree Label]
forall a b. (a -> b) -> [a] -> [b]
map Tree Label -> Tree Label
sortTree [Tree Label]
children
subtreeAt :: Label -> Tree.Tree CmmBlock
blockLabeled :: Label -> CmmBlock
rpnum :: Label -> RPNum
isMergeLabel :: Label -> Bool
isMergeNode :: CmmBlock -> Bool
isLoopHeader :: CmmBlock -> Bool
dominates :: Label -> Label -> Bool
blockmap :: LabelMap CmmBlock
GMany MaybeO C (Block CmmNode O C)
NothingO LabelMap CmmBlock
blockmap MaybeO C (Block CmmNode C O)
NothingO = CmmGraph -> Graph' Block CmmNode C C
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Graph n C C
g_graph CmmGraph
g
blockLabeled :: Label -> CmmBlock
blockLabeled Label
l = Label -> LabelMap CmmBlock -> CmmBlock
forall a. (() :: Constraint) => Label -> LabelMap a -> a
findLabelIn Label
l LabelMap CmmBlock
blockmap
rpblocks :: [CmmBlock]
rpblocks :: [CmmBlock]
rpblocks = LabelMap CmmBlock -> Label -> [CmmBlock]
forall (block :: Extensibility -> Extensibility -> *).
NonLocal block =>
LabelMap (block C C) -> Label -> [block C C]
revPostorderFrom LabelMap CmmBlock
blockmap (CmmGraph -> Label
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Label
g_entry CmmGraph
g)
foldEdges :: forall a . (Label -> Label -> a -> a) -> a -> a
foldEdges :: forall a. (Label -> Label -> a -> a) -> a -> a
foldEdges Label -> Label -> a -> a
f a
a =
(a -> (Label, Label) -> a) -> a -> [(Label, Label)] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
a (Label
from, Label
to) -> Label -> Label -> a -> a
f Label
from Label
to a
a)
a
a
[(CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
from, Label
to) | CmmBlock
from <- [CmmBlock]
rpblocks, Label
to <- CmmBlock -> [Label]
forall (e :: Extensibility). Block CmmNode e C -> [Label]
forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [Label]
successors CmmBlock
from]
isMergeLabel :: Label -> Bool
isMergeLabel Label
l = ElemOf LabelSet -> LabelSet -> Bool
forall set. IsSet set => ElemOf set -> set -> Bool
setMember ElemOf LabelSet
Label
l LabelSet
mergeBlockLabels
isMergeNode :: CmmBlock -> Bool
isMergeNode = Label -> Bool
isMergeLabel (Label -> Bool) -> (CmmBlock -> Label) -> CmmBlock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel
isBackward :: Label -> Label -> Bool
isBackward :: Label -> Label -> Bool
isBackward Label
from Label
to = Label -> RPNum
rpnum Label
to RPNum -> RPNum -> Bool
forall a. Ord a => a -> a -> Bool
<= Label -> RPNum
rpnum Label
from
subtreeAt :: Label -> Tree CmmBlock
subtreeAt Label
label = Label -> LabelMap (Tree CmmBlock) -> Tree CmmBlock
forall a. (() :: Constraint) => Label -> LabelMap a -> a
findLabelIn Label
label LabelMap (Tree CmmBlock)
subtrees
subtrees :: LabelMap (Tree.Tree CmmBlock)
subtrees :: LabelMap (Tree CmmBlock)
subtrees = LabelMap (Tree CmmBlock)
-> Tree CmmBlock -> LabelMap (Tree CmmBlock)
forall {map :: * -> *}
{thing :: Extensibility -> Extensibility -> *}
{x :: Extensibility}.
(KeyOf map ~ Label, IsMap map, NonLocal thing) =>
map (Tree (thing C x))
-> Tree (thing C x) -> map (Tree (thing C x))
addSubtree LabelMap (Tree CmmBlock)
forall a. LabelMap a
forall (map :: * -> *) a. IsMap map => map a
mapEmpty Tree CmmBlock
dominatorTree
where addSubtree :: map (Tree (thing C x))
-> Tree (thing C x) -> map (Tree (thing C x))
addSubtree map (Tree (thing C x))
map t :: Tree (thing C x)
t@(Tree.Node thing C x
root [Tree (thing C x)]
children) =
(map (Tree (thing C x))
-> Tree (thing C x) -> map (Tree (thing C x)))
-> map (Tree (thing C x))
-> [Tree (thing C x)]
-> map (Tree (thing C x))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl map (Tree (thing C x))
-> Tree (thing C x) -> map (Tree (thing C x))
addSubtree (KeyOf map
-> Tree (thing C x)
-> map (Tree (thing C x))
-> map (Tree (thing C x))
forall a. KeyOf map -> a -> map a -> map a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert (thing C x -> Label
forall (x :: Extensibility). thing C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel thing C x
root) Tree (thing C x)
t map (Tree (thing C x))
map) [Tree (thing C x)]
children
mergeBlockLabels :: LabelSet
mergeBlockLabels :: LabelSet
mergeBlockLabels =
[ElemOf LabelSet] -> LabelSet
forall set. IsSet set => [ElemOf set] -> set
setFromList [CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
n | CmmBlock
n <- [CmmBlock]
rpblocks, [Label] -> Bool
forall {a}. [a] -> Bool
big (Label -> [Label]
forwardPreds (CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
n))]
where big :: [a] -> Bool
big [] = Bool
False
big [a
_] = Bool
False
big (a
_ : a
_ : [a]
_) = Bool
True
forwardPreds :: Label -> [Label]
forwardPreds :: Label -> [Label]
forwardPreds = \Label
l -> [Label] -> KeyOf LabelMap -> LabelMap [Label] -> [Label]
forall a. a -> KeyOf LabelMap -> LabelMap a -> a
forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
mapFindWithDefault [] KeyOf LabelMap
Label
l LabelMap [Label]
predmap
where predmap :: LabelMap [Label]
predmap :: LabelMap [Label]
predmap = (Label -> Label -> LabelMap [Label] -> LabelMap [Label])
-> LabelMap [Label] -> LabelMap [Label]
forall a. (Label -> Label -> a -> a) -> a -> a
foldEdges Label -> Label -> LabelMap [Label] -> LabelMap [Label]
forall {map :: * -> *}.
(KeyOf map ~ Label, IsMap map) =>
Label -> Label -> map [Label] -> map [Label]
addForwardEdge LabelMap [Label]
forall a. LabelMap a
forall (map :: * -> *) a. IsMap map => map a
mapEmpty
addForwardEdge :: Label -> Label -> map [Label] -> map [Label]
addForwardEdge Label
from Label
to map [Label]
pm
| Label -> Label -> Bool
isBackward Label
from Label
to = map [Label]
pm
| Bool
otherwise = ([Label] -> [Label]) -> KeyOf map -> map [Label] -> map [Label]
forall (map :: * -> *) a.
IsMap map =>
([a] -> [a]) -> KeyOf map -> map [a] -> map [a]
addToList (Label
from Label -> [Label] -> [Label]
forall a. a -> [a] -> [a]
:) KeyOf map
Label
to map [Label]
pm
isLoopHeader :: CmmBlock -> Bool
isLoopHeader = Label -> Bool
isHeaderLabel (Label -> Bool) -> (CmmBlock -> Label) -> CmmBlock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel
isHeaderLabel :: ElemOf LabelSet -> Bool
isHeaderLabel = (ElemOf LabelSet -> LabelSet -> Bool
forall set. IsSet set => ElemOf set -> set -> Bool
`setMember` LabelSet
headers)
where headers :: LabelSet
headers :: LabelSet
headers = (CmmBlock -> LabelSet) -> LabelMap CmmBlock -> LabelSet
forall m a. Monoid m => (a -> m) -> LabelMap a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CmmBlock -> LabelSet
forall {set} {thing :: Extensibility -> Extensibility -> *}.
(ElemOf set ~ Label, IsSet set, NonLocal thing) =>
thing C C -> set
headersPointedTo LabelMap CmmBlock
blockmap
headersPointedTo :: thing C C -> set
headersPointedTo thing C C
block =
[ElemOf set] -> set
forall set. IsSet set => [ElemOf set] -> set
setFromList [ElemOf set
Label
label | Label
label <- thing C C -> [Label]
forall (e :: Extensibility). thing e C -> [Label]
forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [Label]
successors thing C C
block,
Label -> Label -> Bool
dominates Label
label (thing C C -> Label
forall (x :: Extensibility). thing C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel thing C C
block)]
index :: Label -> [ContainingSyntax] -> Int
index :: Label -> [ContainingSyntax] -> Int
index Label
_ [] = String -> Int
forall a. HasCallStack => String -> a
panic String
"destination label not in evaluation context"
index Label
label (ContainingSyntax
frame : [ContainingSyntax]
context)
| Label
label Label -> ContainingSyntax -> Bool
`matchesFrame` ContainingSyntax
frame = Int
0
| Bool
otherwise = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Label -> [ContainingSyntax] -> Int
index Label
label [ContainingSyntax]
context
rpnum :: Label -> RPNum
rpnum = GraphWithDominators CmmNode -> Label -> RPNum
forall (node :: Extensibility -> Extensibility -> *).
(() :: Constraint) =>
GraphWithDominators node -> Label -> RPNum
gwdRPNumber GraphWithDominators CmmNode
gwd
dominates :: Label -> Label -> Bool
dominates Label
lbl Label
blockname =
Label
lbl Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
blockname Bool -> Bool -> Bool
|| Label -> DominatorSet -> Bool
dominatorsMember Label
lbl (GraphWithDominators CmmNode -> Label -> DominatorSet
forall (node :: Extensibility -> Extensibility -> *).
(() :: Constraint) =>
GraphWithDominators node -> Label -> DominatorSet
gwdDominatorsOf GraphWithDominators CmmNode
gwd Label
blockname)
nodeBody :: CmmBlock -> CmmActions
nodeBody :: CmmBlock -> CmmActions
nodeBody (BlockCC CmmNode C O
_first CmmActions
middle CmmNode O C
_last) = CmmActions
middle
smartExtend :: Platform -> CmmExpr -> CmmExpr
smartExtend :: Platform -> CmmExpr -> CmmExpr
smartExtend Platform
p CmmExpr
e | Width
w0 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
w1 = CmmExpr
e
| Bool
otherwise = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_UU_Conv Width
w0 Width
w1) [CmmExpr
e]
where
w0 :: Width
w0 = Platform -> CmmExpr -> Width
cmmExprWidth Platform
p CmmExpr
e
w1 :: Width
w1 = Platform -> Width
wordWidth Platform
p
smartPlus :: Platform -> CmmExpr -> Int -> CmmExpr
smartPlus :: Platform -> CmmExpr -> Int -> CmmExpr
smartPlus Platform
_ CmmExpr
e Int
0 = CmmExpr
e
smartPlus Platform
platform CmmExpr
e Int
k =
MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
width) [CmmExpr
e, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
k) Width
width)]
where width :: Width
width = Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
e
addToList :: (IsMap map) => ([a] -> [a]) -> KeyOf map -> map [a] -> map [a]
addToList :: forall (map :: * -> *) a.
IsMap map =>
([a] -> [a]) -> KeyOf map -> map [a] -> map [a]
addToList [a] -> [a]
consx = (Maybe [a] -> Maybe [a]) -> KeyOf map -> map [a] -> map [a]
forall a. (Maybe a -> Maybe a) -> KeyOf map -> map a -> map a
forall (map :: * -> *) a.
IsMap map =>
(Maybe a -> Maybe a) -> KeyOf map -> map a -> map a
mapAlter Maybe [a] -> Maybe [a]
add
where add :: Maybe [a] -> Maybe [a]
add Maybe [a]
Nothing = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> [a]
consx [])
add (Just [a]
xs) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> [a]
consx [a]
xs)
instance Outputable ContainingSyntax where
ppr :: ContainingSyntax -> SDoc
ppr (BlockFollowedBy Label
l) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"node" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
l
ppr (LoopHeadedBy Label
l) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"loop" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
l
ppr (IfThenElse Maybe Label
l) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"if-then-else" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Label
l
findLabelIn :: HasDebugCallStack => Label -> LabelMap a -> a
findLabelIn :: forall a. (() :: Constraint) => Label -> LabelMap a -> a
findLabelIn Label
lbl = a -> KeyOf LabelMap -> LabelMap a -> a
forall a. a -> KeyOf LabelMap -> LabelMap a -> a
forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
mapFindWithDefault a
failed KeyOf LabelMap
Label
lbl
where failed :: a
failed =
String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"label not found in control-flow graph" (Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
lbl)
infixl 4 <$~>
(<$~>) :: Functor m => m (a -> b) -> a -> m b
<$~> :: forall (m :: * -> *) a b. Functor m => m (a -> b) -> a -> m b
(<$~>) m (a -> b)
f a
x = ((a -> b) -> b) -> m (a -> b) -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) m (a -> b)
f
(<<>>) :: forall m s e pre mid post
. Applicative m
=> m (WasmControl s e pre mid)
-> m (WasmControl s e mid post)
-> m (WasmControl s e pre post)
<<>> :: forall (m :: * -> *) s e (pre :: [WasmType]) (mid :: [WasmType])
(post :: [WasmType]).
Applicative m =>
m (WasmControl s e pre mid)
-> m (WasmControl s e mid post) -> m (WasmControl s e pre post)
(<<>>) = (WasmControl s e pre mid
-> WasmControl s e mid post -> WasmControl s e pre post)
-> m (WasmControl s e pre mid)
-> m (WasmControl s e mid post)
-> m (WasmControl s e pre post)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 WasmControl s e pre mid
-> WasmControl s e mid post -> WasmControl s e pre post
forall s e (pre :: [WasmType]) (mid :: [WasmType])
(post :: [WasmType]).
WasmControl s e pre mid
-> WasmControl s e mid post -> WasmControl s e pre post
(<>)