compiler: wasm32 NCG

This patch adds the wasm32 NCG.

7 files changed, 2722 insertions, 0 deletions

diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 9fed66053a..37d77900ba 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -83,6 +83,7 @@ import GHC.Prelude hiding (head)
 import qualified GHC.CmmToAsm.X86   as X86
 import qualified GHC.CmmToAsm.PPC   as PPC
 import qualified GHC.CmmToAsm.AArch64 as AArch64
+import qualified GHC.CmmToAsm.Wasm as Wasm32
 
 import GHC.CmmToAsm.Reg.Liveness
 import qualified GHC.CmmToAsm.Reg.Linear                as Linear
@@ -169,6 +170,7 @@ nativeCodeGen logger config modLoc h us cmms
       ArchRISCV64   -> panic "nativeCodeGen: No NCG for RISCV64"
       ArchUnknown   -> panic "nativeCodeGen: No NCG for unknown arch"
       ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
+      ArchWasm32    -> Wasm32.ncgWasm platform us modLoc h cmms
 
 -- | Data accumulated during code generation. Mostly about statistics,
 -- but also collects debug data for DWARF generation.
diff --git a/compiler/GHC/CmmToAsm/Wasm.hs b/compiler/GHC/CmmToAsm/Wasm.hs
new file mode 100644
index 0000000000..6ea3244db4
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Wasm.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Strict #-}
+
+module GHC.CmmToAsm.Wasm (ncgWasm) where
+
+import Data.ByteString.Builder
+import Data.Maybe
+import Data.Semigroup
+import GHC.Cmm
+import GHC.CmmToAsm.Wasm.Asm
+import GHC.CmmToAsm.Wasm.FromCmm
+import GHC.CmmToAsm.Wasm.Types
+import GHC.Data.Stream (Stream, StreamS (..), runStream)
+import GHC.Platform
+import GHC.Prelude
+import GHC.Types.Unique.Supply
+import GHC.Unit
+import System.IO
+
+ncgWasm ::
+  Platform ->
+  UniqSupply ->
+  ModLocation ->
+  Handle ->
+  Stream IO RawCmmGroup a ->
+  IO a
+ncgWasm platform us loc h cmms = do
+  (r, s) <- streamCmmGroups platform us cmms
+  hPutBuilder h $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n"
+  hPutBuilder h $ execWasmAsmM $ asmTellEverything TagI32 s
+  pure r
+
+streamCmmGroups ::
+  Platform ->
+  UniqSupply ->
+  Stream IO RawCmmGroup a ->
+  IO (a, WasmCodeGenState 'I32)
+streamCmmGroups platform us cmms =
+  go (initialWasmCodeGenState platform us) $
+    runStream cmms
+  where
+    go s (Done r) = pure (r, s)
+    go s (Effect m) = m >>= go s
+    go s (Yield cmm k) = go (wasmExecM (onCmmGroup cmm) s) k
diff --git a/compiler/GHC/CmmToAsm/Wasm/Asm.hs b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
new file mode 100644
index 0000000000..2cc08a58b3
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
@@ -0,0 +1,514 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE Strict #-}
+
+module GHC.CmmToAsm.Wasm.Asm (asmTellEverything, execWasmAsmM) where
+
+import Control.Monad
+import Control.Monad.Trans.Reader
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import Data.ByteString.Builder
+import Data.Coerce
+import Data.Foldable
+import qualified Data.IntSet as IS
+import Data.Maybe
+import Data.Semigroup
+import GHC.Cmm
+import GHC.CmmToAsm.Ppr
+import GHC.CmmToAsm.Wasm.FromCmm
+import GHC.CmmToAsm.Wasm.Types
+import GHC.CmmToAsm.Wasm.Utils
+import GHC.Data.FastString
+import GHC.Float
+import GHC.Prelude
+import GHC.Types.Basic
+import GHC.Types.Unique
+import GHC.Types.Unique.Map
+import GHC.Utils.Monad.State.Strict
+import GHC.Utils.Outputable hiding ((<>))
+import GHC.Utils.Panic (panic)
+
+-- | Reads current indentation, appends result to state
+newtype WasmAsmM a = WasmAsmM (Builder -> State Builder a)
+  deriving
+    ( Functor,
+      Applicative,
+      Monad
+    )
+    via (ReaderT Builder (State Builder))
+
+instance Semigroup a => Semigroup (WasmAsmM a) where
+  (<>) = liftA2 (<>)
+
+instance Monoid a => Monoid (WasmAsmM a) where
+  mempty = pure mempty
+
+-- | Default indent level is none
+execWasmAsmM :: WasmAsmM a -> Builder
+execWasmAsmM (WasmAsmM m) = execState (m mempty) mempty
+
+-- | Increase indent level by a tab
+asmWithTab :: WasmAsmM a -> WasmAsmM a
+asmWithTab (WasmAsmM m) = WasmAsmM $ \t -> m $! char7 '\t' <> t
+
+-- | Writes a single line starting with the current indent
+asmTellLine :: Builder -> WasmAsmM ()
+asmTellLine b = WasmAsmM $ \t -> modify $ \acc -> acc <> t <> b <> char7 '\n'
+
+-- | Writes a single line break
+asmTellLF :: WasmAsmM ()
+asmTellLF = WasmAsmM $ \_ -> modify $ \acc -> acc <> char7 '\n'
+
+-- | Writes a line starting with a single tab, ignoring current indent
+-- level
+asmTellTabLine :: Builder -> WasmAsmM ()
+asmTellTabLine b =
+  WasmAsmM $ \_ -> modify $ \acc -> acc <> char7 '\t' <> b <> char7 '\n'
+
+asmFromWasmType :: WasmTypeTag t -> Builder
+asmFromWasmType ty = case ty of
+  TagI32 -> "i32"
+  TagI64 -> "i64"
+  TagF32 -> "f32"
+  TagF64 -> "f64"
+
+asmFromSomeWasmType :: SomeWasmType -> Builder
+asmFromSomeWasmType (SomeWasmType t) = asmFromWasmType t
+
+asmFromSomeWasmTypes :: [SomeWasmType] -> Builder
+asmFromSomeWasmTypes ts = "(" <> builderCommas asmFromSomeWasmType ts <> ")"
+
+asmFromFuncType :: [SomeWasmType] -> [SomeWasmType] -> Builder
+asmFromFuncType arg_tys ret_tys =
+  asmFromSomeWasmTypes arg_tys <> " -> " <> asmFromSomeWasmTypes ret_tys
+
+asmTellFuncType ::
+  SymName -> ([SomeWasmType], [SomeWasmType]) -> WasmAsmM ()
+asmTellFuncType sym (arg_tys, ret_tys) =
+  asmTellTabLine $
+    ".functype "
+      <> asmFromSymName sym
+      <> " "
+      <> asmFromFuncType arg_tys ret_tys
+
+asmTellLocals :: [SomeWasmType] -> WasmAsmM ()
+asmTellLocals [] = mempty
+asmTellLocals local_tys =
+  asmTellTabLine $ ".local " <> builderCommas asmFromSomeWasmType local_tys
+
+asmFromSymName :: SymName -> Builder
+asmFromSymName = shortByteString . coerce fastStringToShortByteString
+
+asmTellDefSym :: SymName -> WasmAsmM ()
+asmTellDefSym sym = do
+  asmTellTabLine $ ".hidden " <> asm_sym
+  asmTellTabLine $ ".globl " <> asm_sym
+  where
+    asm_sym = asmFromSymName sym
+
+asmTellDataSectionContent :: WasmTypeTag w -> DataSectionContent -> WasmAsmM ()
+asmTellDataSectionContent ty_word c = asmTellTabLine $ case c of
+  DataI8 i -> ".int8 " <> integerDec i
+  DataI16 i -> ".int16 " <> integerDec i
+  DataI32 i -> ".int32 " <> integerDec i
+  DataI64 i -> ".int64 " <> integerDec i
+  DataF32 f -> ".int32 0x" <> word32Hex (castFloatToWord32 f)
+  DataF64 d -> ".int64 0x" <> word64Hex (castDoubleToWord64 d)
+  DataSym sym o ->
+    ( case ty_word of
+        TagI32 -> ".int32 "
+        TagI64 -> ".int64 "
+        _ -> panic "asmTellDataSectionContent: unreachable"
+    )
+      <> asmFromSymName sym
+      <> ( case compare o 0 of
+             EQ -> mempty
+             GT -> "+" <> intDec o
+             LT -> intDec o
+         )
+  DataSkip i -> ".skip " <> intDec i
+  DataASCII s
+    | not (BS.null s) && BS.last s == 0 ->
+        ".asciz \""
+          <> string7
+            (showSDocOneLine defaultSDocContext $ pprASCII $ BS.init s)
+          <> "\""
+    | otherwise ->
+        ".ascii \""
+          <> string7
+            (showSDocOneLine defaultSDocContext $ pprASCII s)
+          <> "\""
+  DataIncBin f _ ->
+    ".incbin "
+      <> string7
+        (showSDocOneLine defaultSDocContext $ pprFilePathString f)
+
+dataSectionContentSize :: WasmTypeTag w -> DataSectionContent -> Int
+dataSectionContentSize ty_word c = case c of
+  DataI8 {} -> 1
+  DataI16 {} -> 2
+  DataI32 {} -> 4
+  DataI64 {} -> 8
+  DataF32 {} -> 4
+  DataF64 {} -> 8
+  DataSym {} -> alignmentBytes $ alignmentFromWordType ty_word
+  DataSkip i -> i
+  DataASCII s -> BS.length s
+  DataIncBin _ l -> l
+
+dataSectionSize :: WasmTypeTag w -> [DataSectionContent] -> Int
+dataSectionSize ty_word =
+  coerce
+    . foldMap'
+      (Sum . dataSectionContentSize ty_word)
+
+asmTellAlign :: Alignment -> WasmAsmM ()
+asmTellAlign a = case alignmentBytes a of
+  1 -> mempty
+  i -> asmTellTabLine $ ".p2align " <> intDec (countTrailingZeros i)
+
+asmTellSectionHeader :: Builder -> WasmAsmM ()
+asmTellSectionHeader k = asmTellTabLine $ ".section " <> k <> ",\"\",@"
+
+asmTellDataSection ::
+  WasmTypeTag w -> IS.IntSet -> SymName -> DataSection -> WasmAsmM ()
+asmTellDataSection ty_word def_syms sym DataSection {..} = do
+  when (getKey (getUnique sym) `IS.member` def_syms) $ asmTellDefSym sym
+  asmTellSectionHeader sec_name
+  asmTellAlign dataSectionAlignment
+  asmTellTabLine asm_size
+  asmTellLine $ asm_sym <> ":"
+  for_ dataSectionContents $ asmTellDataSectionContent ty_word
+  asmTellLF
+  where
+    asm_sym = asmFromSymName sym
+
+    sec_name =
+      ( case dataSectionKind of
+          SectionData -> ".data."
+          SectionROData -> ".rodata."
+      )
+        <> asm_sym
+
+    asm_size =
+      ".size "
+        <> asm_sym
+        <> ", "
+        <> intDec
+          (dataSectionSize ty_word dataSectionContents)
+
+asmFromWasmBlockType :: WasmTypeTag w -> WasmFunctionType pre post -> Builder
+asmFromWasmBlockType
+  _
+  (WasmFunctionType {ft_pops = TypeListNil, ft_pushes = TypeListNil}) =
+    mempty
+asmFromWasmBlockType
+  TagI32
+  ( WasmFunctionType
+      { ft_pops = TypeListNil,
+        ft_pushes = TypeListCons TagI32 TypeListNil
+      }
+    ) =
+    " i32"
+asmFromWasmBlockType
+  TagI64
+  ( WasmFunctionType
+      { ft_pops = TypeListNil,
+        ft_pushes = TypeListCons TagI64 TypeListNil
+      }
+    ) =
+    " i64"
+asmFromWasmBlockType _ _ = panic "asmFromWasmBlockType: invalid block type"
+
+asmFromAlignmentSpec :: AlignmentSpec -> Builder
+asmFromAlignmentSpec NaturallyAligned = mempty
+asmFromAlignmentSpec Unaligned = ":p2align=0"
+
+asmTellWasmInstr :: WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
+asmTellWasmInstr ty_word instr = case instr of
+  WasmComment c -> asmTellLine $ stringUtf8 $ "# " <> c
+  WasmNop -> mempty
+  WasmDrop -> asmTellLine "drop"
+  WasmUnreachable -> asmTellLine "unreachable"
+  WasmConst TagI32 i -> asmTellLine $ "i32.const " <> integerDec i
+  WasmConst TagI64 i -> asmTellLine $ "i64.const " <> integerDec i
+  WasmConst {} -> panic "asmTellWasmInstr: unreachable"
+  WasmSymConst sym ->
+    asmTellLine $
+      ( case ty_word of
+          TagI32 -> "i32.const "
+          TagI64 -> "i64.const "
+          _ -> panic "asmTellWasmInstr: unreachable"
+      )
+        <> asmFromSymName sym
+  WasmLoad ty (Just w) s o align ->
+    asmTellLine $
+      asmFromWasmType ty
+        <> ".load"
+        <> intDec w
+        <> ( case s of
+               Signed -> "_s"
+               Unsigned -> "_u"
+           )
+        <> " "
+        <> intDec o
+        <> asmFromAlignmentSpec align
+  WasmLoad ty Nothing _ o align ->
+    asmTellLine $
+      asmFromWasmType ty
+        <> ".load"
+        <> " "
+        <> intDec o
+        <> asmFromAlignmentSpec align
+  WasmStore ty (Just w) o align ->
+    asmTellLine $
+      asmFromWasmType ty
+        <> ".store"
+        <> intDec w
+        <> " "
+        <> intDec o
+        <> asmFromAlignmentSpec align
+  WasmStore ty Nothing o align ->
+    asmTellLine $
+      asmFromWasmType ty
+        <> ".store"
+        <> " "
+        <> intDec o
+        <> asmFromAlignmentSpec align
+  WasmGlobalGet _ sym -> asmTellLine $ "global.get " <> asmFromSymName sym
+  WasmGlobalSet _ sym -> asmTellLine $ "global.set " <> asmFromSymName sym
+  WasmLocalGet _ i -> asmTellLine $ "local.get " <> intDec i
+  WasmLocalSet _ i -> asmTellLine $ "local.set " <> intDec i
+  WasmLocalTee _ i -> asmTellLine $ "local.tee " <> intDec i
+  WasmCCall sym -> asmTellLine $ "call " <> asmFromSymName sym
+  WasmCCallIndirect arg_tys ret_tys ->
+    asmTellLine $
+      "call_indirect "
+        <> asmFromFuncType
+          (someWasmTypesFromTypeList arg_tys)
+          (someWasmTypesFromTypeList ret_tys)
+  WasmConcat instr0 instr1 -> do
+    asmTellWasmInstr ty_word instr0
+    asmTellWasmInstr ty_word instr1
+  WasmReinterpret t0 t1 ->
+    asmTellLine $
+      asmFromWasmType t1 <> ".reinterpret_" <> asmFromWasmType t0
+  WasmTruncSat Signed t0 t1 ->
+    asmTellLine $
+      asmFromWasmType t1 <> ".trunc_sat_" <> asmFromWasmType t0 <> "_s"
+  WasmTruncSat Unsigned t0 t1 ->
+    asmTellLine $
+      asmFromWasmType t1 <> ".trunc_sat_" <> asmFromWasmType t0 <> "_u"
+  WasmConvert Signed t0 t1 ->
+    asmTellLine $
+      asmFromWasmType t1 <> ".convert_" <> asmFromWasmType t0 <> "_s"
+  WasmConvert Unsigned t0 t1 ->
+    asmTellLine $
+      asmFromWasmType t1 <> ".convert_" <> asmFromWasmType t0 <> "_u"
+  WasmClz ty -> asmTellLine $ asmFromWasmType ty <> ".clz"
+  WasmCtz ty -> asmTellLine $ asmFromWasmType ty <> ".ctz"
+  WasmPopcnt ty -> asmTellLine $ asmFromWasmType ty <> ".popcnt"
+  WasmAdd ty -> asmTellLine $ asmFromWasmType ty <> ".add"
+  WasmSub ty -> asmTellLine $ asmFromWasmType ty <> ".sub"
+  WasmMul ty -> asmTellLine $ asmFromWasmType ty <> ".mul"
+  WasmDiv _ TagF32 -> asmTellLine "f32.div"
+  WasmDiv _ TagF64 -> asmTellLine "f64.div"
+  WasmDiv Signed ty -> asmTellLine $ asmFromWasmType ty <> ".div_s"
+  WasmDiv Unsigned ty -> asmTellLine $ asmFromWasmType ty <> ".div_u"
+  WasmRem Signed ty -> asmTellLine $ asmFromWasmType ty <> ".rem_s"
+  WasmRem Unsigned ty -> asmTellLine $ asmFromWasmType ty <> ".rem_u"
+  WasmAnd ty -> asmTellLine $ asmFromWasmType ty <> ".and"
+  WasmOr ty -> asmTellLine $ asmFromWasmType ty <> ".or"
+  WasmXor ty -> asmTellLine $ asmFromWasmType ty <> ".xor"
+  WasmEq ty -> asmTellLine $ asmFromWasmType ty <> ".eq"
+  WasmNe ty -> asmTellLine $ asmFromWasmType ty <> ".ne"
+  WasmLt _ TagF32 -> asmTellLine "f32.lt"
+  WasmLt _ TagF64 -> asmTellLine "f64.lt"
+  WasmLt Signed ty -> asmTellLine $ asmFromWasmType ty <> ".lt_s"
+  WasmLt Unsigned ty -> asmTellLine $ asmFromWasmType ty <> ".lt_u"
+  WasmGt _ TagF32 -> asmTellLine "f32.gt"
+  WasmGt _ TagF64 -> asmTellLine "f64.gt"
+  WasmGt Signed ty -> asmTellLine $ asmFromWasmType ty <> ".gt_s"
+  WasmGt Unsigned ty -> asmTellLine $ asmFromWasmType ty <> ".gt_u"
+  WasmLe _ TagF32 -> asmTellLine "f32.le"
+  WasmLe _ TagF64 -> asmTellLine "f64.le"
+  WasmLe Signed ty -> asmTellLine $ asmFromWasmType ty <> ".le_s"
+  WasmLe Unsigned ty -> asmTellLine $ asmFromWasmType ty <> ".le_u"
+  WasmGe _ TagF32 -> asmTellLine "f32.ge"
+  WasmGe _ TagF64 -> asmTellLine "f64.ge"
+  WasmGe Signed ty -> asmTellLine $ asmFromWasmType ty <> ".ge_s"
+  WasmGe Unsigned ty -> asmTellLine $ asmFromWasmType ty <> ".ge_u"
+  WasmShl ty -> asmTellLine $ asmFromWasmType ty <> ".shl"
+  WasmShr Signed ty -> asmTellLine $ asmFromWasmType ty <> ".shr_s"
+  WasmShr Unsigned ty -> asmTellLine $ asmFromWasmType ty <> ".shr_u"
+  WasmI32Extend8S -> asmTellLine "i32.extend8_s"
+  WasmI32Extend16S -> asmTellLine "i32.extend16_s"
+  WasmI64Extend8S -> asmTellLine "i64.extend8_s"
+  WasmI64Extend16S -> asmTellLine "i64.extend16_s"
+  WasmI64Extend32S -> asmTellLine "i64.extend32_s"
+  WasmI64ExtendI32 Signed -> asmTellLine "i64.extend_i32_s"
+  WasmI64ExtendI32 Unsigned -> asmTellLine "i64.extend_i32_u"
+  WasmI32WrapI64 -> asmTellLine "i32.wrap_i64"
+  WasmF32DemoteF64 -> asmTellLine "f32.demote_f64"
+  WasmF64PromoteF32 -> asmTellLine "f64.promote_f32"
+  WasmAbs ty -> asmTellLine $ asmFromWasmType ty <> ".abs"
+  WasmCond t -> do
+    asmTellLine "if"
+    asmWithTab $ asmTellWasmInstr ty_word t
+    asmTellLine "end_if"
+
+asmTellWasmControl ::
+  WasmTypeTag w ->
+  WasmControl
+    (WasmStatements w)
+    (WasmExpr w a)
+    pre
+    post ->
+  WasmAsmM ()
+asmTellWasmControl ty_word c = case c of
+  WasmPush _ (WasmExpr e) -> asmTellWasmInstr ty_word e
+  WasmBlock bt c -> do
+    asmTellLine $ "block" <> asmFromWasmBlockType ty_word bt
+    asmWithTab $ asmTellWasmControl ty_word c
+    asmTellLine "end_block"
+  WasmLoop bt c -> do
+    asmTellLine $ "loop" <> asmFromWasmBlockType ty_word bt
+    asmWithTab $ asmTellWasmControl ty_word c
+    -- asmTellLine "br 0"
+    asmTellLine "end_loop"
+  WasmIfTop bt t f -> do
+    asmTellLine $ "if" <> asmFromWasmBlockType ty_word bt
+    asmWithTab $ asmTellWasmControl ty_word t
+    asmTellLine "else"
+    asmWithTab $ asmTellWasmControl ty_word f
+    asmTellLine "end_if"
+  WasmBr i -> asmTellLine $ "br " <> intDec i
+  WasmFallthrough -> mempty
+  WasmBrTable (WasmExpr e) _ ts t -> do
+    asmTellWasmInstr ty_word e
+    asmTellLine $ "br_table {" <> builderCommas intDec (ts <> [t]) <> "}"
+  WasmReturnTop _ -> asmTellLine "return"
+  WasmActions (WasmStatements a) -> asmTellWasmInstr ty_word a
+  WasmSeq c0 c1 -> do
+    asmTellWasmControl ty_word c0
+    asmTellWasmControl ty_word c1
+
+asmTellFunc ::
+  WasmTypeTag w ->
+  IS.IntSet ->
+  SymName ->
+  (([SomeWasmType], [SomeWasmType]), FuncBody w) ->
+  WasmAsmM ()
+asmTellFunc ty_word def_syms sym (func_ty, FuncBody {..}) = do
+  when (getKey (getUnique sym) `IS.member` def_syms) $ asmTellDefSym sym
+  asmTellSectionHeader $ ".text." <> asm_sym
+  asmTellLine $ asm_sym <> ":"
+  asmTellFuncType sym func_ty
+  asmTellLocals funcLocals
+  asmWithTab $ asmTellWasmControl ty_word funcBody
+  asmTellTabLine "end_function"
+  asmTellLF
+  where
+    asm_sym = asmFromSymName sym
+
+asmTellGlobals :: WasmTypeTag w -> WasmAsmM ()
+asmTellGlobals ty_word = do
+  for_ supportedCmmGlobalRegs $ \reg ->
+    let (sym, ty) = fromJust $ globalInfoFromCmmGlobalReg ty_word reg
+     in asmTellTabLine $
+          ".globaltype "
+            <> asmFromSymName sym
+            <> ", "
+            <> asmFromSomeWasmType ty
+  asmTellLF
+
+asmTellCtors :: WasmTypeTag w -> [SymName] -> WasmAsmM ()
+asmTellCtors _ [] = mempty
+asmTellCtors ty_word syms = do
+  asmTellSectionHeader ".init_array"
+  asmTellAlign $ alignmentFromWordType ty_word
+  for_ syms $ \sym ->
+    asmTellTabLine $
+      ( case ty_word of
+          TagI32 -> ".int32 "
+          TagI64 -> ".int64 "
+          _ -> panic "asmTellCtors: unreachable"
+      )
+        <> asmFromSymName sym
+  asmTellLF
+
+asmTellBS :: ByteString -> WasmAsmM ()
+asmTellBS s = do
+  asmTellTabLine $ ".int8 " <> intDec (BS.length s)
+  asmTellTabLine $
+    ".ascii \""
+      <> string7
+        (showSDocOneLine defaultSDocContext $ pprASCII s)
+      <> "\""
+
+asmTellVec :: [WasmAsmM ()] -> WasmAsmM ()
+asmTellVec xs = do
+  asmTellTabLine $ ".int8 " <> intDec (length xs)
+  sequence_ xs
+
+asmTellProducers :: WasmAsmM ()
+asmTellProducers = do
+  asmTellSectionHeader ".custom_section.producers"
+  asmTellVec
+    [ do
+        asmTellBS "processed-by"
+        asmTellVec
+          [ do
+              asmTellBS "ghc"
+              asmTellBS "9.6"
+          ]
+    ]
+
+asmTellTargetFeatures :: WasmAsmM ()
+asmTellTargetFeatures = do
+  asmTellSectionHeader ".custom_section.target_features"
+  asmTellVec
+    [ do
+        asmTellTabLine ".int8 0x2b"
+        asmTellBS feature
+      | feature <-
+          [ "bulk-memory",
+            "mutable-globals",
+            "nontrapping-fptoint",
+            "reference-types",
+            "sign-ext"
+          ]
+    ]
+
+asmTellEverything :: WasmTypeTag w -> WasmCodeGenState w -> WasmAsmM ()
+asmTellEverything ty_word WasmCodeGenState {..} = do
+  asmTellGlobals ty_word
+  asm_functypes
+  asm_funcs
+  asm_data_secs
+  asm_ctors
+  asmTellProducers
+  asmTellTargetFeatures
+  where
+    asm_functypes = do
+      for_
+        (detEltsUniqMap $ funcTypes `minusUniqMap` funcBodies)
+        (uncurry asmTellFuncType)
+      asmTellLF
+
+    asm_funcs = do
+      for_
+        (detEltsUniqMap $ intersectUniqMap_C (,) funcTypes funcBodies)
+        (uncurry $ asmTellFunc ty_word defaultSyms)
+      asmTellLF
+
+    asm_data_secs = do
+      for_
+        (detEltsUniqMap dataSections)
+        (uncurry (asmTellDataSection ty_word defaultSyms))
+      asmTellLF
+
+    asm_ctors = asmTellCtors ty_word ctors
diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
new file mode 100644
index 0000000000..034a75aea2
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
@@ -0,0 +1,1666 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Strict #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use camelCase" #-}
+module GHC.CmmToAsm.Wasm.FromCmm where
+
+import Control.Monad
+import qualified Data.ByteString as BS
+import Data.Foldable
+import Data.Functor
+import qualified Data.IntSet as IS
+import Data.Semigroup
+import Data.String
+import Data.Traversable
+import Data.Type.Equality
+import GHC.Cmm
+import GHC.Cmm.CLabel
+import GHC.Cmm.Dataflow.Block
+import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.InitFini
+import GHC.CmmToAsm.Wasm.Types
+import GHC.CmmToAsm.Wasm.Utils
+import GHC.Float
+import GHC.Platform
+import GHC.Prelude
+import GHC.StgToCmm.CgUtils
+import GHC.Types.Basic
+import GHC.Types.ForeignCall
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Map
+import GHC.Utils.Outputable hiding ((<>))
+import GHC.Utils.Panic
+import GHC.Wasm.ControlFlow.FromCmm
+
+-- | Calculate the wasm representation type from a 'CmmType'. This is
+-- a lossy conversion, and sometimes we need to pass the original
+-- 'CmmType' or at least its 'Width' around, so to properly add
+-- subword truncation or extension logic.
+someWasmTypeFromCmmType :: CmmType -> SomeWasmType
+someWasmTypeFromCmmType t
+  | isWord32 t = SomeWasmType TagI32
+  | isWord64 t = SomeWasmType TagI64
+  | t `cmmEqType` b16 = SomeWasmType TagI32
+  | t `cmmEqType` b8 = SomeWasmType TagI32
+  | isFloat64 t = SomeWasmType TagF64
+  | isFloat32 t = SomeWasmType TagF32
+  | otherwise =
+      panic $
+        "someWasmTypeFromCmmType: unsupported CmmType "
+          <> showSDocOneLine defaultSDocContext (ppr t)
+
+-- | Calculate the optional memory narrowing of a 'CmmLoad' or
+-- 'CmmStore'.
+wasmMemoryNarrowing :: WasmTypeTag t -> CmmType -> Maybe Int
+wasmMemoryNarrowing ty ty_cmm = case (# ty, typeWidth ty_cmm #) of
+  (# TagI32, W8 #) -> Just 8
+  (# TagI32, W16 #) -> Just 16
+  (# TagI32, W32 #) -> Nothing
+  (# TagI64, W8 #) -> Just 8
+  (# TagI64, W16 #) -> Just 16
+  (# TagI64, W32 #) -> Just 32
+  (# TagI64, W64 #) -> Nothing
+  (# TagF32, W32 #) -> Nothing
+  (# TagF64, W64 #) -> Nothing
+  _ -> panic "wasmMemoryNarrowing: unreachable"
+
+-- | Despite this is used by the WebAssembly native codegen, we use
+-- 'pprCLabel' instead of 'pprAsmLabel' when emitting the textual
+-- symbol name. Either one would work, but 'pprCLabel' makes the
+-- output assembly code looks closer to the unregisterised codegen
+-- output, which can be handy when using the unregisterised codegen as
+-- a source of truth when debugging the native codegen.
+symNameFromCLabel :: CLabel -> SymName
+symNameFromCLabel lbl =
+  fromString $
+    showSDocOneLine defaultSDocContext {sdocStyle = PprCode} $
+      pprCLabel genericPlatform lbl
+
+-- | Calculate a symbol's visibility.
+symVisibilityFromCLabel :: CLabel -> SymVisibility
+symVisibilityFromCLabel lbl
+  | externallyVisibleCLabel lbl = SymDefault
+  | otherwise = SymStatic
+
+-- | Calculate a symbol's kind, see haddock docs of 'SymKind' for more
+-- explanation.
+symKindFromCLabel :: CLabel -> SymKind
+symKindFromCLabel lbl
+  | isCFunctionLabel lbl = SymFunc
+  | otherwise = SymData
+
+-- | Calculate a data section's kind, see haddock docs of
+-- 'DataSectionKind' for more explanation.
+dataSectionKindFromCmmSection :: Section -> DataSectionKind
+dataSectionKindFromCmmSection s = case sectionProtection s of
+  ReadWriteSection -> SectionData
+  _ -> SectionROData
+
+-- | Calculate the natural alignment size given the platform word
+-- type.
+alignmentFromWordType :: WasmTypeTag w -> Alignment
+alignmentFromWordType TagI32 = mkAlignment 4
+alignmentFromWordType TagI64 = mkAlignment 8
+alignmentFromWordType _ = panic "alignmentFromWordType: unreachable"
+
+-- | Calculate a data section's alignment. Closures needs to be
+-- naturally aligned; info tables need to align to 2, so to get 1 tag
+-- bit as forwarding pointer marker. The rest have no alignment
+-- requirements.
+alignmentFromCmmSection :: WasmTypeTag w -> CLabel -> Alignment
+alignmentFromCmmSection t lbl
+  | isStaticClosureLabel lbl = alignmentFromWordType t
+  | isInfoTableLabel lbl = mkAlignment 2
+  | otherwise = mkAlignment 1
+
+-- | Lower a 'CmmStatic'.
+lower_CmmStatic :: CmmStatic -> WasmCodeGenM w DataSectionContent
+lower_CmmStatic s = case s of
+  CmmStaticLit (CmmInt i W8) -> pure $ DataI8 $ naturalNarrowing W8 i
+  CmmStaticLit (CmmInt i W16) -> pure $ DataI16 $ naturalNarrowing W16 i
+  CmmStaticLit (CmmInt i W32) -> pure $ DataI32 $ naturalNarrowing W32 i
+  CmmStaticLit (CmmInt i W64) -> pure $ DataI64 $ naturalNarrowing W64 i
+  CmmStaticLit (CmmFloat f W32) -> pure $ DataF32 $ fromRational f
+  CmmStaticLit (CmmFloat d W64) -> pure $ DataF64 $ fromRational d
+  CmmStaticLit (CmmLabel lbl) ->
+    onAnySym lbl
+      $> DataSym
+        (symNameFromCLabel lbl)
+        0
+  CmmStaticLit (CmmLabelOff lbl o) ->
+    onAnySym lbl
+      $> DataSym
+        (symNameFromCLabel lbl)
+        o
+  CmmUninitialised i -> pure $ DataSkip i
+  CmmString b -> pure $ DataASCII b
+  CmmFileEmbed f l -> pure $ DataIncBin f l
+  _ -> panic "lower_CmmStatic: unreachable"
+
+{-
+Note [Register mapping on WebAssembly]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Unlike typical ISAs, WebAssembly doesn't expose a fixed set of
+registers. For now, we map each Cmm LocalReg to a wasm local, and each
+Cmm GlobalReg to a wasm global. The wasm globals are defined in
+rts/wasm/Wasm.S, and must be kept in sync with
+'globalInfoFromCmmGlobalReg' and 'supportedCmmGlobalRegs' here.
+
+There are some other Cmm GlobalRegs which are still represented by
+StgRegTable fields instead of wasm globals (e.g. HpAlloc). It's cheap
+to add wasm globals, but other parts of rts logic only work with the
+StgRegTable fields, so we also need to instrument StgRun/StgReturn to
+sync the wasm globals with the StgRegTable. It's not really worth the
+trouble.
+
+-}
+globalInfoFromCmmGlobalReg :: WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
+globalInfoFromCmmGlobalReg t reg = case reg of
+  VanillaReg i _
+    | i >= 1 && i <= 10 -> Just (fromString $ "__R" <> show i, ty_word)
+  FloatReg i
+    | i >= 1 && i <= 6 ->
+        Just (fromString $ "__F" <> show i, SomeWasmType TagF32)
+  DoubleReg i
+    | i >= 1 && i <= 6 ->
+        Just (fromString $ "__D" <> show i, SomeWasmType TagF64)
+  LongReg i
+    | i == 1 -> Just (fromString $ "__L" <> show i, SomeWasmType TagI64)
+  Sp -> Just ("__Sp", ty_word)
+  SpLim -> Just ("__SpLim", ty_word)
+  Hp -> Just ("__Hp", ty_word)
+  HpLim -> Just ("__HpLim", ty_word)
+  CCCS -> Just ("__CCCS", ty_word)
+  _ -> Nothing
+  where
+    ty_word = SomeWasmType t
+
+supportedCmmGlobalRegs :: [GlobalReg]
+supportedCmmGlobalRegs =
+  [VanillaReg i VGcPtr | i <- [1 .. 10]]
+    <> [FloatReg i | i <- [1 .. 6]]
+    <> [DoubleReg i | i <- [1 .. 6]]
+    <> [LongReg i | i <- [1 .. 1]]
+    <> [Sp, SpLim, Hp, HpLim, CCCS]
+
+-- | Allocate a fresh symbol for an internal data section.
+allocDataSection :: DataSection -> WasmCodeGenM w SymName
+allocDataSection sec = do
+  u <- wasmUniq
+  let sym = fromString $ ".L" <> show u
+  wasmModifyM $ \s ->
+    s
+      { dataSections =
+          addToUniqMap (dataSections s) sym sec
+      }
+  pure sym
+
+-- | Print a debug message to stderr by calling @fputs()@. We don't
+-- bother to check @fputs()@ return value.
+wasmDebugMsg :: String -> WasmCodeGenM w (WasmStatements w)
+wasmDebugMsg msg = do
+  ty_word_cmm <- wasmWordCmmTypeM
+  sym_buf <-
+    allocDataSection
+      DataSection
+        { dataSectionKind =
+            SectionROData,
+          dataSectionAlignment =
+            mkAlignment 1,
+          dataSectionContents =
+            [DataASCII $ fromString $ msg <> "\NUL"]
+        }
+  onFuncSym "fputs" [ty_word_cmm, ty_word_cmm] [b32]
+  pure $
+    WasmStatements $
+      WasmSymConst sym_buf
+        `WasmConcat` WasmSymConst "__stderr_FILE"
+        `WasmConcat` WasmCCall "fputs"
+        `WasmConcat` WasmDrop
+
+-- | Truncate a subword.
+truncSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
+truncSubword W8 ty (WasmExpr instr) =
+  WasmExpr $ instr `WasmConcat` WasmConst ty 0xFF `WasmConcat` WasmAnd ty
+truncSubword W16 ty (WasmExpr instr) =
+  WasmExpr $ instr `WasmConcat` WasmConst ty 0xFFFF `WasmConcat` WasmAnd ty
+truncSubword _ _ expr = expr
+
+-- | Sign-extend a subword.
+extendSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
+extendSubword W8 TagI32 (WasmExpr instr) =
+  WasmExpr $ instr `WasmConcat` WasmI32Extend8S
+extendSubword W16 TagI32 (WasmExpr instr) =
+  WasmExpr $ instr `WasmConcat` WasmI32Extend16S
+extendSubword W8 TagI64 (WasmExpr instr) =
+  WasmExpr $ instr `WasmConcat` WasmI64Extend8S
+extendSubword W16 TagI64 (WasmExpr instr) =
+  WasmExpr $ instr `WasmConcat` WasmI64Extend16S
+extendSubword W32 TagI64 (WasmExpr instr) =
+  WasmExpr $ instr `WasmConcat` WasmI64Extend32S
+extendSubword _ _ expr = expr
+
+-- | Lower a binary homogeneous operation. Homogeneous: result type is
+-- the same with operand types.
+lower_MO_Bin_Homo ::
+  ( forall pre t.
+    WasmTypeTag t ->
+    WasmInstr
+      w
+      (t : t : pre)
+      (t : pre)
+  ) ->
+  CLabel ->
+  CmmType ->
+  [CmmExpr] ->
+  WasmCodeGenM w (SomeWasmExpr w)
+lower_MO_Bin_Homo op lbl t0 [x, y] = case someWasmTypeFromCmmType t0 of
+  SomeWasmType ty -> do
+    WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+    WasmExpr y_instr <- lower_CmmExpr_Typed lbl ty y
+    pure $
+      SomeWasmExpr ty $
+        WasmExpr $
+          x_instr `WasmConcat` y_instr `WasmConcat` op ty
+lower_MO_Bin_Homo _ _ _ _ = panic "lower_MO_Bin_Homo: unreachable"
+
+-- | Lower a binary homogeneous operation, and truncate the result if
+-- it's a subword.
+lower_MO_Bin_Homo_Trunc ::
+  (forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)) ->
+  CLabel ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM w (SomeWasmExpr w)
+lower_MO_Bin_Homo_Trunc op lbl w0 [x, y] =
+  case someWasmTypeFromCmmType (cmmBits w0) of
+    SomeWasmType ty -> do
+      WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+      WasmExpr y_instr <- lower_CmmExpr_Typed lbl ty y
+      pure $
+        SomeWasmExpr ty $
+          truncSubword w0 ty $
+            WasmExpr $
+              x_instr `WasmConcat` y_instr `WasmConcat` op ty
+lower_MO_Bin_Homo_Trunc _ _ _ _ = panic "lower_MO_Bin_Homo_Trunc: unreachable"
+
+-- | Lower a binary homogeneous operation, first sign extending the
+-- operands, then truncating the result.
+lower_MO_Bin_Homo_Ext_Trunc ::
+  (forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)) ->
+  CLabel ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM w (SomeWasmExpr w)
+lower_MO_Bin_Homo_Ext_Trunc op lbl w0 [x, y] =
+  case someWasmTypeFromCmmType (cmmBits w0) of
+    SomeWasmType ty -> do
+      WasmExpr x_instr <-
+        extendSubword w0 ty <$> lower_CmmExpr_Typed lbl ty x
+      WasmExpr y_instr <-
+        extendSubword w0 ty <$> lower_CmmExpr_Typed lbl ty y
+      pure $
+        SomeWasmExpr ty $
+          truncSubword w0 ty $
+            WasmExpr $
+              x_instr `WasmConcat` y_instr `WasmConcat` op ty
+lower_MO_Bin_Homo_Ext_Trunc _ _ _ _ =
+  panic "lower_MO_Bin_Homo_Ext_Trunc: unreachable"
+
+-- | Lower a relational binary operation, first sign extending the
+-- operands. Relational: result type is a boolean (word type).
+lower_MO_Bin_Rel_Ext ::
+  (forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)) ->
+  CLabel ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM w (SomeWasmExpr w)
+lower_MO_Bin_Rel_Ext op lbl w0 [x, y] =
+  case someWasmTypeFromCmmType (cmmBits w0) of
+    SomeWasmType ty -> do
+      WasmExpr x_instr <-
+        extendSubword w0 ty <$> lower_CmmExpr_Typed lbl ty x
+      WasmExpr y_instr <-
+        extendSubword w0 ty <$> lower_CmmExpr_Typed lbl ty y
+      ty_word <- wasmWordTypeM
+      pure $
+        SomeWasmExpr ty_word $
+          WasmExpr $
+            x_instr `WasmConcat` y_instr `WasmConcat` op ty
+lower_MO_Bin_Rel_Ext _ _ _ _ = panic "lower_MO_Bin_Rel_Ext: unreachable"
+
+-- | Lower a relational binary operation.
+lower_MO_Bin_Rel ::
+  ( forall pre t.
+    WasmTypeTag t ->
+    WasmInstr
+      w
+      (t : t : pre)
+      (w : pre)
+  ) ->
+  CLabel ->
+  CmmType ->
+  [CmmExpr] ->
+  WasmCodeGenM w (SomeWasmExpr w)
+lower_MO_Bin_Rel op lbl t0 [x, y] = case someWasmTypeFromCmmType t0 of
+  SomeWasmType ty -> do
+    WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+    WasmExpr y_instr <- lower_CmmExpr_Typed lbl ty y
+    ty_word <- wasmWordTypeM
+    pure $
+      SomeWasmExpr ty_word $
+        WasmExpr $
+          x_instr `WasmConcat` y_instr `WasmConcat` op ty
+lower_MO_Bin_Rel _ _ _ _ = panic "lower_MO_Bin_Rel: unreachable"
+
+-- | Cast a shiftL/shiftR RHS to the same type as LHS. Because we may
+-- have a 64-bit LHS and 32-bit RHS, but wasm shift operators are
+-- homogeneous.
+shiftRHSCast ::
+  CLabel ->
+  WasmTypeTag t ->
+  CmmExpr ->
+  WasmCodeGenM
+    w
+    (WasmExpr w t)
+shiftRHSCast lbl t1 x = do
+  SomeWasmExpr t0 (WasmExpr x_instr) <- lower_CmmExpr lbl x
+  if
+      | Just Refl <- t0 `testEquality` t1 -> pure $ WasmExpr x_instr
+      | TagI32 <- t0,
+        TagI64 <- t1 ->
+          pure $ WasmExpr $ x_instr `WasmConcat` WasmI64ExtendI32 Unsigned
+      | otherwise -> panic "shiftRHSCast: unreachable"
+
+-- | Lower a 'MO_Shl' operation, truncating the result.
+lower_MO_Shl ::
+  CLabel ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_MO_Shl lbl w0 [x, y] = case someWasmTypeFromCmmType (cmmBits w0) of
+  SomeWasmType ty -> do
+    WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+    WasmExpr y_instr <- shiftRHSCast lbl ty y
+    pure $
+      SomeWasmExpr ty $
+        truncSubword w0 ty $
+          WasmExpr $
+            x_instr `WasmConcat` y_instr `WasmConcat` WasmShl ty
+lower_MO_Shl _ _ _ = panic "lower_MO_Shl: unreachable"
+
+-- | Lower a 'MO_U_Shr' operation.
+lower_MO_U_Shr ::
+  CLabel ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_MO_U_Shr lbl w0 [x, y] = case someWasmTypeFromCmmType (cmmBits w0) of
+  SomeWasmType ty -> do
+    WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+    WasmExpr y_instr <- shiftRHSCast lbl ty y
+    pure $
+      SomeWasmExpr ty $
+        WasmExpr $
+          x_instr `WasmConcat` y_instr `WasmConcat` WasmShr Unsigned ty
+lower_MO_U_Shr _ _ _ = panic "lower_MO_U_Shr: unreachable"
+
+-- | Lower a 'MO_S_Shr' operation, first sign-extending the LHS, then
+-- truncating the result.
+lower_MO_S_Shr ::
+  CLabel ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_MO_S_Shr lbl w0 [x, y] = case someWasmTypeFromCmmType (cmmBits w0) of
+  SomeWasmType ty -> do
+    WasmExpr x_instr <- extendSubword w0 ty <$> lower_CmmExpr_Typed lbl ty x
+    WasmExpr y_instr <- shiftRHSCast lbl ty y
+    pure $
+      SomeWasmExpr ty $
+        truncSubword w0 ty $
+          WasmExpr $
+            x_instr `WasmConcat` y_instr `WasmConcat` WasmShr Signed ty
+lower_MO_S_Shr _ _ _ = panic "lower_MO_S_Shr: unreachable"
+
+-- | Lower a 'MO_MulMayOflo' operation. It's translated to a ccall to
+-- one of the @hs_mulIntMayOflo@ functions in rts/wasm/Ops.c,
+-- otherwise it's quite non-trivial to implement as inline assembly.
+lower_MO_MulMayOflo ::
+  CLabel ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_MO_MulMayOflo lbl w0 [x, y] = case someWasmTypeFromCmmType ty_cmm of
+  SomeWasmType ty -> do
+    WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+    WasmExpr y_instr <- lower_CmmExpr_Typed lbl ty y
+    onFuncSym f [ty_cmm, ty_cmm] [ty_cmm]
+    pure $
+      SomeWasmExpr ty $
+        WasmExpr $
+          x_instr `WasmConcat` y_instr `WasmConcat` WasmCCall f
+  where
+    f = fromString $ "hs_mulIntMayOflo" <> show (widthInBits w0)
+
+    ty_cmm = cmmBits w0
+lower_MO_MulMayOflo _ _ _ = panic "lower_MO_MulMayOflo: unreachable"
+
+-- | Lower an unary conversion operation.
+lower_MO_Un_Conv ::
+  ( forall pre t0 t1.
+    WasmTypeTag t0 ->
+    WasmTypeTag t1 ->
+    WasmInstr w (t0 : pre) (t1 : pre)
+  ) ->
+  CLabel ->
+  CmmType ->
+  CmmType ->
+  [CmmExpr] ->
+  WasmCodeGenM w (SomeWasmExpr w)
+lower_MO_Un_Conv op lbl t0 t1 [x] =
+  case (# someWasmTypeFromCmmType t0, someWasmTypeFromCmmType t1 #) of
+    (# SomeWasmType ty0, SomeWasmType ty1 #) -> do
+      WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty0 x
+      pure $ SomeWasmExpr ty1 $ WasmExpr $ x_instr `WasmConcat` op ty0 ty1
+lower_MO_Un_Conv _ _ _ _ _ = panic "lower_MO_Un_Conv: unreachable"
+
+-- | Lower a 'MO_SS_Conv' operation.
+lower_MO_SS_Conv ::
+  CLabel ->
+  Width ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_MO_SS_Conv lbl w0 w1 [x]
+  | w0 == w1 = lower_CmmExpr lbl x
+lower_MO_SS_Conv lbl w0 w1 [CmmLoad ptr _ align]
+  | w0 < w1,
+    w1 <= W32 = do
+      (WasmExpr ptr_instr, o) <- lower_CmmExpr_Ptr lbl ptr
+      pure $
+        SomeWasmExpr TagI32 $
+          truncSubword w1 TagI32 $
+            WasmExpr $
+              ptr_instr
+                `WasmConcat` WasmLoad
+                  TagI32
+                  (wasmMemoryNarrowing TagI32 (cmmBits w0))
+                  Signed
+                  o
+                  align
+  | w0 > w1 =
+      SomeWasmExpr TagI32
+        <$> lower_CmmLoad_Typed
+          lbl
+          ptr
+          TagI32
+          (cmmBits w1)
+          align
+lower_MO_SS_Conv lbl w0 W64 [CmmLoad ptr _ align] = do
+  (WasmExpr ptr_instr, o) <- lower_CmmExpr_Ptr lbl ptr
+  pure $
+    SomeWasmExpr TagI64 $
+      WasmExpr $
+        ptr_instr
+          `WasmConcat` WasmLoad
+            TagI64
+            (wasmMemoryNarrowing TagI64 (cmmBits w0))
+            Signed
+            o
+            align
+lower_MO_SS_Conv lbl w0 w1 [x]
+  | w0 < w1,
+    w1 <= W32 = do
+      x_expr <- lower_CmmExpr_Typed lbl TagI32 x
+      pure $
+        SomeWasmExpr TagI32 $
+          truncSubword w1 TagI32 $
+            extendSubword w0 TagI32 x_expr
+  | W32 >= w0,
+    w0 > w1 = do
+      x_expr <- lower_CmmExpr_Typed lbl TagI32 x
+      pure $ SomeWasmExpr TagI32 $ truncSubword w1 TagI32 x_expr
+lower_MO_SS_Conv lbl W32 W64 [x] = do
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl TagI32 x
+  pure $
+    SomeWasmExpr TagI64 $
+      WasmExpr $
+        x_instr `WasmConcat` WasmI64ExtendI32 Signed
+lower_MO_SS_Conv lbl w0 W64 [x] = do
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl TagI32 x
+  pure $
+    SomeWasmExpr TagI64 $
+      extendSubword w0 TagI64 $
+        WasmExpr $
+          x_instr `WasmConcat` WasmI64ExtendI32 Unsigned
+lower_MO_SS_Conv lbl W64 w1 [x] = do
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl TagI64 x
+  pure $
+    SomeWasmExpr TagI32 $
+      truncSubword w1 TagI32 $
+        WasmExpr $
+          x_instr `WasmConcat` WasmI32WrapI64
+lower_MO_SS_Conv _ _ _ _ = panic "lower_MO_SS_Conv: unreachable"
+
+-- | Lower a 'MO_UU_Conv' operation.
+lower_MO_UU_Conv ::
+  CLabel ->
+  Width ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_MO_UU_Conv lbl w0 w1 [CmmLoad ptr _ align] =
+  case someWasmTypeFromCmmType (cmmBits w1) of
+    SomeWasmType ty ->
+      SomeWasmExpr ty
+        <$> lower_CmmLoad_Typed
+          lbl
+          ptr
+          ty
+          (cmmBits (min w0 w1))
+          align
+lower_MO_UU_Conv lbl w0 w1 [x]
+  | w0 == w1 = lower_CmmExpr lbl x
+  | w0 < w1, w1 <= W32 = lower_CmmExpr lbl x
+  | W32 >= w0,
+    w0 > w1 = do
+      x_expr <- lower_CmmExpr_Typed lbl TagI32 x
+      pure $ SomeWasmExpr TagI32 $ truncSubword w1 TagI32 x_expr
+lower_MO_UU_Conv lbl _ W64 [x] = do
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl TagI32 x
+  pure $
+    SomeWasmExpr TagI64 $
+      WasmExpr $
+        x_instr `WasmConcat` WasmI64ExtendI32 Unsigned
+lower_MO_UU_Conv lbl W64 w1 [x] = do
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl TagI64 x
+  pure $
+    SomeWasmExpr TagI32 $
+      truncSubword w1 TagI32 $
+        WasmExpr $
+          x_instr `WasmConcat` WasmI32WrapI64
+lower_MO_UU_Conv _ _ _ _ = panic "lower_MO_UU_Conv: unreachable"
+
+-- | Lower a 'MO_FF_Conv' operation.
+lower_MO_FF_Conv ::
+  CLabel ->
+  Width ->
+  Width ->
+  [CmmExpr] ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_MO_FF_Conv lbl W32 W64 [x] = do
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl TagF32 x
+  pure $
+    SomeWasmExpr TagF64 $
+      WasmExpr $
+        x_instr `WasmConcat` WasmF64PromoteF32
+lower_MO_FF_Conv lbl W64 W32 [x] = do
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl TagF64 x
+  pure $
+    SomeWasmExpr TagF32 $
+      WasmExpr $
+        x_instr `WasmConcat` WasmF32DemoteF64
+lower_MO_FF_Conv _ _ _ _ = panic "lower_MO_FF_Conv: unreachable"
+
+-- | Lower a 'CmmMachOp'.
+lower_CmmMachOp ::
+  CLabel ->
+  MachOp ->
+  [CmmExpr] ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_CmmMachOp lbl (MO_Add w0) xs = lower_MO_Bin_Homo_Trunc WasmAdd lbl w0 xs
+lower_CmmMachOp lbl (MO_Sub w0) xs = lower_MO_Bin_Homo_Trunc WasmSub lbl w0 xs
+lower_CmmMachOp lbl (MO_Eq w0) xs = lower_MO_Bin_Rel WasmEq lbl (cmmBits w0) xs
+lower_CmmMachOp lbl (MO_Ne w0) xs = lower_MO_Bin_Rel WasmNe lbl (cmmBits w0) xs
+lower_CmmMachOp lbl (MO_Mul w0) xs = lower_MO_Bin_Homo_Trunc WasmMul lbl w0 xs
+lower_CmmMachOp lbl (MO_S_MulMayOflo w0) xs = lower_MO_MulMayOflo lbl w0 xs
+lower_CmmMachOp lbl (MO_S_Quot w0) xs =
+  lower_MO_Bin_Homo_Ext_Trunc
+    (WasmDiv Signed)
+    lbl
+    w0
+    xs
+lower_CmmMachOp lbl (MO_S_Rem w0) xs =
+  lower_MO_Bin_Homo_Ext_Trunc
+    (WasmRem Signed)
+    lbl
+    w0
+    xs
+lower_CmmMachOp lbl (MO_S_Neg w0) [x] =
+  lower_CmmMachOp
+    lbl
+    (MO_Sub w0)
+    [CmmLit $ CmmInt 0 w0, x]
+lower_CmmMachOp lbl (MO_U_MulMayOflo w0) xs = lower_MO_MulMayOflo lbl w0 xs
+lower_CmmMachOp lbl (MO_U_Quot w0) xs =
+  lower_MO_Bin_Homo
+    (WasmDiv Unsigned)
+    lbl
+    (cmmBits w0)
+    xs
+lower_CmmMachOp lbl (MO_U_Rem w0) xs =
+  lower_MO_Bin_Homo
+    (WasmRem Unsigned)
+    lbl
+    (cmmBits w0)
+    xs
+lower_CmmMachOp lbl (MO_S_Ge w0) xs =
+  lower_MO_Bin_Rel_Ext
+    (WasmGe Signed)
+    lbl
+    w0
+    xs
+lower_CmmMachOp lbl (MO_S_Le w0) xs =
+  lower_MO_Bin_Rel_Ext
+    (WasmLe Signed)
+    lbl
+    w0
+    xs
+lower_CmmMachOp lbl (MO_S_Gt w0) xs =
+  lower_MO_Bin_Rel_Ext
+    (WasmGt Signed)
+    lbl
+    w0
+    xs
+lower_CmmMachOp lbl (MO_S_Lt w0) xs =
+  lower_MO_Bin_Rel_Ext
+    (WasmLt Signed)
+    lbl
+    w0
+    xs
+lower_CmmMachOp lbl (MO_U_Ge w0) xs =
+  lower_MO_Bin_Rel
+    (WasmGe Unsigned)
+    lbl
+    (cmmBits w0)
+    xs
+lower_CmmMachOp lbl (MO_U_Le w0) xs =
+  lower_MO_Bin_Rel
+    (WasmLe Unsigned)
+    lbl
+    (cmmBits w0)
+    xs
+lower_CmmMachOp lbl (MO_U_Gt w0) xs =
+  lower_MO_Bin_Rel
+    (WasmGt Unsigned)
+    lbl
+    (cmmBits w0)
+    xs
+lower_CmmMachOp lbl (MO_U_Lt w0) xs =
+  lower_MO_Bin_Rel
+    (WasmLt Unsigned)
+    lbl
+    (cmmBits w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Add w0) xs =
+  lower_MO_Bin_Homo
+    WasmAdd
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Sub w0) xs =
+  lower_MO_Bin_Homo
+    WasmSub
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Neg w0) [x] =
+  lower_CmmMachOp
+    lbl
+    (MO_F_Sub w0)
+    [CmmLit $ CmmFloat 0 w0, x]
+lower_CmmMachOp lbl (MO_F_Mul w0) xs =
+  lower_MO_Bin_Homo
+    WasmMul
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Quot w0) xs =
+  lower_MO_Bin_Homo
+    (WasmDiv Signed)
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Eq w0) xs =
+  lower_MO_Bin_Rel
+    WasmEq
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Ne w0) xs =
+  lower_MO_Bin_Rel
+    WasmNe
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Ge w0) xs =
+  lower_MO_Bin_Rel
+    (WasmGe Signed)
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Le w0) xs =
+  lower_MO_Bin_Rel
+    (WasmLe Signed)
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Gt w0) xs =
+  lower_MO_Bin_Rel
+    (WasmGt Signed)
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_F_Lt w0) xs =
+  lower_MO_Bin_Rel
+    (WasmLt Signed)
+    lbl
+    (cmmFloat w0)
+    xs
+lower_CmmMachOp lbl (MO_And w0) xs =
+  lower_MO_Bin_Homo
+    WasmAnd
+    lbl
+    (cmmBits w0)
+    xs
+lower_CmmMachOp lbl (MO_Or w0) xs = lower_MO_Bin_Homo WasmOr lbl (cmmBits w0) xs
+lower_CmmMachOp lbl (MO_Xor w0) xs =
+  lower_MO_Bin_Homo
+    WasmXor
+    lbl
+    (cmmBits w0)
+    xs
+lower_CmmMachOp lbl (MO_Not w0) [x] =
+  lower_CmmMachOp
+    lbl
+    (MO_Xor w0)
+    [x, CmmLit $ CmmInt (widthMax w0) w0]
+lower_CmmMachOp lbl (MO_Shl w0) xs = lower_MO_Shl lbl w0 xs
+lower_CmmMachOp lbl (MO_U_Shr w0) xs = lower_MO_U_Shr lbl w0 xs
+lower_CmmMachOp lbl (MO_S_Shr w0) xs = lower_MO_S_Shr lbl w0 xs
+lower_CmmMachOp lbl (MO_SF_Conv w0 w1) xs =
+  lower_MO_Un_Conv
+    (WasmConvert Signed)
+    lbl
+    (cmmBits w0)
+    (cmmFloat w1)
+    xs
+lower_CmmMachOp lbl (MO_FS_Conv w0 w1) xs =
+  lower_MO_Un_Conv
+    (WasmTruncSat Signed)
+    lbl
+    (cmmFloat w0)
+    (cmmBits w1)
+    xs
+lower_CmmMachOp lbl (MO_SS_Conv w0 w1) xs = lower_MO_SS_Conv lbl w0 w1 xs
+lower_CmmMachOp lbl (MO_UU_Conv w0 w1) xs = lower_MO_UU_Conv lbl w0 w1 xs
+lower_CmmMachOp lbl (MO_XX_Conv w0 w1) xs = lower_MO_UU_Conv lbl w0 w1 xs
+lower_CmmMachOp lbl (MO_FF_Conv w0 w1) xs = lower_MO_FF_Conv lbl w0 w1 xs
+lower_CmmMachOp _ _ _ = panic "lower_CmmMachOp: unreachable"
+
+-- | Lower a 'CmmLit'. Note that we don't emit 'f32.const' or
+-- 'f64.const' for the time being, and instead emit their relative bit
+-- pattern as int literals, then use an reinterpret cast. This is
+-- simpler than dealing with textual representation of floating point
+-- values.
+lower_CmmLit :: CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
+lower_CmmLit lit = do
+  ty_word <- wasmWordTypeM
+  case lit of
+    CmmInt i w -> case someWasmTypeFromCmmType (cmmBits w) of
+      SomeWasmType ty ->
+        pure $
+          SomeWasmExpr ty $
+            WasmExpr $
+              WasmConst ty $
+                naturalNarrowing w i
+    CmmFloat f W32 ->
+      pure $
+        SomeWasmExpr TagF32 $
+          WasmExpr $
+            WasmConst
+              TagI32
+              (toInteger $ castFloatToWord32 $ fromRational f)
+              `WasmConcat` WasmReinterpret TagI32 TagF32
+    CmmFloat f W64 ->
+      pure $
+        SomeWasmExpr TagF64 $
+          WasmExpr $
+            WasmConst
+              TagI64
+              (toInteger $ castDoubleToWord64 $ fromRational f)
+              `WasmConcat` WasmReinterpret TagI64 TagF64
+    CmmLabel lbl' -> do
+      onAnySym lbl'
+      let sym = symNameFromCLabel lbl'
+      pure $ SomeWasmExpr ty_word $ WasmExpr $ WasmSymConst sym
+    CmmLabelOff lbl' o -> do
+      onAnySym lbl'
+      let sym = symNameFromCLabel lbl'
+      pure $
+        SomeWasmExpr ty_word $
+          WasmExpr $
+            WasmSymConst sym
+              `WasmConcat` WasmConst ty_word (toInteger o)
+              `WasmConcat` WasmAdd ty_word
+    _ -> panic "lower_CmmLit: unreachable"
+
+--  | Lower a 'CmmReg'. Some of the logic here wouldn't be needed if
+--  we have run 'fixStgRegisters' on the wasm NCG's input Cmm, but we
+--  haven't run it yet for certain reasons.
+lower_CmmReg :: CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
+lower_CmmReg _ (CmmLocal reg) = do
+  (reg_i, SomeWasmType ty) <- onCmmLocalReg reg
+  pure $ SomeWasmExpr ty $ WasmExpr $ WasmLocalGet ty reg_i
+lower_CmmReg _ (CmmGlobal EagerBlackholeInfo) = do
+  ty_word <- wasmWordTypeM
+  pure $
+    SomeWasmExpr ty_word $
+      WasmExpr $
+        WasmSymConst "stg_EAGER_BLACKHOLE_info"
+lower_CmmReg _ (CmmGlobal GCEnter1) = do
+  ty_word <- wasmWordTypeM
+  ty_word_cmm <- wasmWordCmmTypeM
+  onFuncSym "__stg_gc_enter_1" [] [ty_word_cmm]
+  pure $ SomeWasmExpr ty_word $ WasmExpr $ WasmSymConst "__stg_gc_enter_1"
+lower_CmmReg _ (CmmGlobal GCFun) = do
+  ty_word <- wasmWordTypeM
+  ty_word_cmm <- wasmWordCmmTypeM
+  onFuncSym "__stg_gc_fun" [] [ty_word_cmm]
+  pure $ SomeWasmExpr ty_word $ WasmExpr $ WasmSymConst "__stg_gc_fun"
+lower_CmmReg lbl (CmmGlobal BaseReg) = do
+  platform <- wasmPlatformM
+  lower_CmmExpr lbl $ regTableOffset platform 0
+lower_CmmReg lbl (CmmGlobal reg) = do
+  ty_word <- wasmWordTypeM
+  if
+      | Just (sym_global, SomeWasmType ty) <-
+          globalInfoFromCmmGlobalReg ty_word reg ->
+          pure $ SomeWasmExpr ty $ WasmExpr $ WasmGlobalGet ty sym_global
+      | otherwise -> do
+          platform <- wasmPlatformM
+          case someWasmTypeFromCmmType $ globalRegType platform reg of
+            SomeWasmType ty -> do
+              (WasmExpr ptr_instr, o) <-
+                lower_CmmExpr_Ptr lbl $
+                  get_GlobalReg_addr platform reg
+              pure $
+                SomeWasmExpr ty $
+                  WasmExpr $
+                    ptr_instr
+                      `WasmConcat` WasmLoad
+                        ty
+                        Nothing
+                        Unsigned
+                        o
+                        NaturallyAligned
+
+-- | Lower a 'CmmRegOff'.
+lower_CmmRegOff :: CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
+lower_CmmRegOff lbl reg 0 = lower_CmmReg lbl reg
+lower_CmmRegOff lbl reg o = do
+  SomeWasmExpr ty (WasmExpr reg_instr) <- lower_CmmReg lbl reg
+  pure $
+    SomeWasmExpr ty $
+      WasmExpr $
+        reg_instr
+          `WasmConcat` WasmConst
+            ty
+            (toInteger o)
+          `WasmConcat` WasmAdd ty
+
+-- | Lower a 'CmmLoad', passing in the expected wasm representation
+-- type, and also the Cmm type (which contains width info needed for
+-- memory narrowing).
+--
+-- The Cmm type system doesn't track signedness, so all 'CmmLoad's are
+-- unsigned loads. However, as an optimization, we do emit signed
+-- loads when a 'CmmLoad' result is immediately used as a 'MO_SS_Conv'
+-- operand.
+lower_CmmLoad_Typed ::
+  CLabel ->
+  CmmExpr ->
+  WasmTypeTag t ->
+  CmmType ->
+  AlignmentSpec ->
+  WasmCodeGenM w (WasmExpr w t)
+lower_CmmLoad_Typed lbl ptr_expr ty ty_cmm align = do
+  (WasmExpr ptr_instr, o) <- lower_CmmExpr_Ptr lbl ptr_expr
+  pure $
+    WasmExpr $
+      ptr_instr
+        `WasmConcat` WasmLoad
+          ty
+          (wasmMemoryNarrowing ty ty_cmm)
+          Unsigned
+          o
+          align
+
+-- | Lower a 'CmmLoad'.
+lower_CmmLoad ::
+  CLabel ->
+  CmmExpr ->
+  CmmType ->
+  AlignmentSpec ->
+  WasmCodeGenM
+    w
+    (SomeWasmExpr w)
+lower_CmmLoad lbl ptr_expr ty_cmm align = case someWasmTypeFromCmmType ty_cmm of
+  SomeWasmType ty ->
+    SomeWasmExpr ty <$> lower_CmmLoad_Typed lbl ptr_expr ty ty_cmm align
+
+-- | Lower a 'CmmExpr'.
+lower_CmmExpr :: CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
+lower_CmmExpr lbl expr = case expr of
+  CmmLit lit -> lower_CmmLit lit
+  CmmLoad ptr_expr ty_cmm align -> lower_CmmLoad lbl ptr_expr ty_cmm align
+  CmmReg reg -> lower_CmmReg lbl reg
+  CmmRegOff reg o -> lower_CmmRegOff lbl reg o
+  CmmMachOp op xs -> lower_CmmMachOp lbl op xs
+  _ -> panic "lower_CmmExpr: unreachable"
+
+-- | Lower a 'CmmExpr', passing in the expected wasm representation
+-- type.
+lower_CmmExpr_Typed ::
+  CLabel ->
+  WasmTypeTag t ->
+  CmmExpr ->
+  WasmCodeGenM
+    w
+    (WasmExpr w t)
+lower_CmmExpr_Typed lbl ty expr = do
+  SomeWasmExpr ty' r <- lower_CmmExpr lbl expr
+  if
+      | Just Refl <- ty' `testEquality` ty -> pure r
+      | otherwise -> panic "lower_CmmExpr_Typed: unreachable"
+
+-- | Lower a 'CmmExpr' as a pointer, returning the pair of base
+-- pointer and non-negative offset.
+lower_CmmExpr_Ptr :: CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
+lower_CmmExpr_Ptr lbl ptr = do
+  ty_word <- wasmWordTypeM
+  case ptr of
+    CmmLit (CmmLabelOff lbl o)
+      | o >= 0 -> do
+          instrs <-
+            lower_CmmExpr_Typed
+              lbl
+              ty_word
+              (CmmLit $ CmmLabel lbl)
+          pure (instrs, o)
+    CmmMachOp (MO_Add _) [base, CmmLit (CmmInt o _)]
+      | o >= 0 -> do
+          instrs <- lower_CmmExpr_Typed lbl ty_word base
+          pure (instrs, fromInteger o)
+    _ -> do
+      instrs <- lower_CmmExpr_Typed lbl ty_word ptr
+      pure (instrs, 0)
+
+-- | Push a series of values onto the wasm value stack, returning the
+-- result stack type.
+type family
+  WasmPushes (ts :: [WasmType]) (pre :: [WasmType]) ::
+    [WasmType]
+  where
+  WasmPushes '[] pre = pre
+  WasmPushes (t : ts) pre = WasmPushes ts (t : pre)
+
+-- | Push the arguments onto the wasm value stack before a ccall.
+data SomeWasmPreCCall w where
+  SomeWasmPreCCall ::
+    TypeList ts ->
+    (forall pre. WasmInstr w pre (WasmPushes ts pre)) ->
+    SomeWasmPreCCall w
+
+-- | Pop the results into locals after a ccall.
+data SomeWasmPostCCall w where
+  SomeWasmPostCCall ::
+    TypeList ts ->
+    (forall post. WasmInstr w (WasmPushes ts post) post) ->
+    SomeWasmPostCCall w
+
+-- | Lower an unary homogeneous 'CallishMachOp' to a ccall.
+lower_CMO_Un_Homo ::
+  CLabel ->
+  SymName ->
+  [CmmFormal] ->
+  [CmmActual] ->
+  WasmCodeGenM w (WasmStatements w)
+lower_CMO_Un_Homo lbl op [reg] [x] = do
+  (ri, SomeWasmType ty) <- onCmmLocalReg reg
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+  let ty_cmm = localRegType reg
+  onFuncSym op [ty_cmm] [ty_cmm]
+  pure $
+    WasmStatements $
+      x_instr `WasmConcat` WasmCCall op `WasmConcat` WasmLocalSet ty ri
+lower_CMO_Un_Homo _ _ _ _ = panic "lower_CMO_Un_Homo: unreachable"
+
+-- | Lower an unary homogeneous 'CallishMachOp' to inline assembly.
+lower_CMO_Un_Prim ::
+  CLabel ->
+  (forall pre t. WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)) ->
+  [CmmFormal] ->
+  [CmmActual] ->
+  WasmCodeGenM w (WasmStatements w)
+lower_CMO_Un_Prim lbl op [reg] [x] = do
+  (ri, SomeWasmType ty) <- onCmmLocalReg reg
+  SomeWasmExpr ty_x (WasmExpr x_instr) <- lower_CmmExpr lbl x
+  if
+      | Just Refl <- ty `testEquality` ty_x ->
+          pure $
+            WasmStatements $
+              x_instr `WasmConcat` op ty_x `WasmConcat` WasmLocalSet ty ri
+      | TagI32 <- ty,
+        TagI64 <-
+          ty_x ->
+          pure $
+            WasmStatements $
+              x_instr
+                `WasmConcat` op ty_x
+                `WasmConcat` WasmI32WrapI64
+                `WasmConcat` WasmLocalSet ty ri
+      | otherwise -> panic "lower_CMO_Un_Prim: unreachable"
+lower_CMO_Un_Prim _ _ _ _ = panic "lower_CMO_Un_Prim: unreachable"
+
+-- | Lower a binary homogeneous 'CallishMachOp' to a ccall.
+lower_CMO_Bin_Homo ::
+  CLabel ->
+  SymName ->
+  [CmmFormal] ->
+  [CmmActual] ->
+  WasmCodeGenM w (WasmStatements w)
+lower_CMO_Bin_Homo lbl op [reg] [x, y] = do
+  (ri, SomeWasmType ty) <- onCmmLocalReg reg
+  WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+  WasmExpr y_instr <- lower_CmmExpr_Typed lbl ty y
+  let ty_cmm = localRegType reg
+  onFuncSym op [ty_cmm, ty_cmm] [ty_cmm]
+  pure $
+    WasmStatements $
+      x_instr
+        `WasmConcat` y_instr
+        `WasmConcat` WasmCCall op
+        `WasmConcat` WasmLocalSet ty ri
+lower_CMO_Bin_Homo _ _ _ _ = panic "lower_CMO_Bin_Homo: unreachable"
+
+-- | Lower a 'MO_UF_Conv' operation.
+lower_MO_UF_Conv ::
+  CLabel ->
+  Width ->
+  [CmmFormal] ->
+  [CmmActual] ->
+  WasmCodeGenM w (WasmStatements w)
+lower_MO_UF_Conv lbl W32 [reg] [x] = do
+  ri <- onCmmLocalReg_Typed TagF32 reg
+  SomeWasmExpr ty0 (WasmExpr x_instr) <- lower_CmmExpr lbl x
+  pure $
+    WasmStatements $
+      x_instr
+        `WasmConcat` WasmConvert Unsigned ty0 TagF32
+        `WasmConcat` WasmLocalSet TagF32 ri
+lower_MO_UF_Conv lbl W64 [reg] [x] = do
+  ri <- onCmmLocalReg_Typed TagF64 reg
+  SomeWasmExpr ty0 (WasmExpr x_instr) <- lower_CmmExpr lbl x
+  pure $
+    WasmStatements $
+      x_instr
+        `WasmConcat` WasmConvert Unsigned ty0 TagF64
+        `WasmConcat` WasmLocalSet TagF64 ri
+lower_MO_UF_Conv _ _ _ _ = panic "lower_MO_UF_Conv: unreachable"
+
+-- | Lower a 'MO_Cmpxchg' operation to inline assembly. Currently we
+-- target wasm without atomics and threads, so it's just lowered to
+-- regular memory loads and stores.
+lower_MO_Cmpxchg ::
+  CLabel ->
+  Width ->
+  [CmmFormal] ->
+  [CmmActual] ->
+  WasmCodeGenM w (WasmStatements w)
+lower_MO_Cmpxchg lbl w0 [reg] [ptr, expected, new] =
+  case someWasmTypeFromCmmType ty_cmm of
+    SomeWasmType ty -> do
+      reg_i <- onCmmLocalReg_Typed ty reg
+      let narrowing = wasmMemoryNarrowing ty ty_cmm
+      (WasmExpr ptr_instr, o) <- lower_CmmExpr_Ptr lbl ptr
+      WasmExpr expected_instr <- lower_CmmExpr_Typed lbl ty expected
+      WasmExpr new_instr <- lower_CmmExpr_Typed lbl ty new
+      pure $
+        WasmStatements $
+          ptr_instr
+            `WasmConcat` WasmLoad ty narrowing Unsigned o NaturallyAligned
+            `WasmConcat` WasmLocalTee ty reg_i
+            `WasmConcat` expected_instr
+            `WasmConcat` WasmEq ty
+            `WasmConcat` WasmCond
+              ( ptr_instr
+                  `WasmConcat` new_instr
+                  `WasmConcat` WasmStore ty narrowing o NaturallyAligned
+              )
+  where
+    ty_cmm = cmmBits w0
+lower_MO_Cmpxchg _ _ _ _ = panic "lower_MO_Cmpxchg: unreachable"
+
+-- | Lower a 'CallishMachOp'.
+lower_CallishMachOp ::
+  CLabel ->
+  CallishMachOp ->
+  [CmmFormal] ->
+  [CmmActual] ->
+  WasmCodeGenM w (WasmStatements w)
+lower_CallishMachOp lbl MO_F64_Pwr rs xs = lower_CMO_Bin_Homo lbl "pow" rs xs
+lower_CallishMachOp lbl MO_F64_Sin rs xs = lower_CMO_Un_Homo lbl "sin" rs xs
+lower_CallishMachOp lbl MO_F64_Cos rs xs = lower_CMO_Un_Homo lbl "cos" rs xs
+lower_CallishMachOp lbl MO_F64_Tan rs xs = lower_CMO_Un_Homo lbl "tan" rs xs
+lower_CallishMachOp lbl MO_F64_Sinh rs xs = lower_CMO_Un_Homo lbl "sinh" rs xs
+lower_CallishMachOp lbl MO_F64_Cosh rs xs = lower_CMO_Un_Homo lbl "cosh" rs xs
+lower_CallishMachOp lbl MO_F64_Tanh rs xs = lower_CMO_Un_Homo lbl "tanh" rs xs
+lower_CallishMachOp lbl MO_F64_Asin rs xs = lower_CMO_Un_Homo lbl "asin" rs xs
+lower_CallishMachOp lbl MO_F64_Acos rs xs = lower_CMO_Un_Homo lbl "acos" rs xs
+lower_CallishMachOp lbl MO_F64_Atan rs xs = lower_CMO_Un_Homo lbl "atan" rs xs
+lower_CallishMachOp lbl MO_F64_Asinh rs xs = lower_CMO_Un_Homo lbl "asinh" rs xs
+lower_CallishMachOp lbl MO_F64_Acosh rs xs = lower_CMO_Un_Homo lbl "acosh" rs xs
+lower_CallishMachOp lbl MO_F64_Atanh rs xs = lower_CMO_Un_Homo lbl "atanh" rs xs
+lower_CallishMachOp lbl MO_F64_Log rs xs = lower_CMO_Un_Homo lbl "log" rs xs
+lower_CallishMachOp lbl MO_F64_Log1P rs xs = lower_CMO_Un_Homo lbl "log1p" rs xs
+lower_CallishMachOp lbl MO_F64_Exp rs xs = lower_CMO_Un_Homo lbl "exp" rs xs
+lower_CallishMachOp lbl MO_F64_ExpM1 rs xs = lower_CMO_Un_Homo lbl "expm1" rs xs
+lower_CallishMachOp lbl MO_F64_Fabs rs xs = lower_CMO_Un_Homo lbl "fabs" rs xs
+lower_CallishMachOp lbl MO_F64_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrt" rs xs
+lower_CallishMachOp lbl MO_F32_Pwr rs xs = lower_CMO_Bin_Homo lbl "powf" rs xs
+lower_CallishMachOp lbl MO_F32_Sin rs xs = lower_CMO_Un_Homo lbl "sinf" rs xs
+lower_CallishMachOp lbl MO_F32_Cos rs xs = lower_CMO_Un_Homo lbl "cosf" rs xs
+lower_CallishMachOp lbl MO_F32_Tan rs xs = lower_CMO_Un_Homo lbl "tanf" rs xs
+lower_CallishMachOp lbl MO_F32_Sinh rs xs = lower_CMO_Un_Homo lbl "sinhf" rs xs
+lower_CallishMachOp lbl MO_F32_Cosh rs xs = lower_CMO_Un_Homo lbl "coshf" rs xs
+lower_CallishMachOp lbl MO_F32_Tanh rs xs = lower_CMO_Un_Homo lbl "tanhf" rs xs
+lower_CallishMachOp lbl MO_F32_Asin rs xs = lower_CMO_Un_Homo lbl "asinf" rs xs
+lower_CallishMachOp lbl MO_F32_Acos rs xs = lower_CMO_Un_Homo lbl "acosf" rs xs
+lower_CallishMachOp lbl MO_F32_Atan rs xs = lower_CMO_Un_Homo lbl "atanf" rs xs
+lower_CallishMachOp lbl MO_F32_Asinh rs xs =
+  lower_CMO_Un_Homo lbl "asinhf" rs xs
+lower_CallishMachOp lbl MO_F32_Acosh rs xs =
+  lower_CMO_Un_Homo lbl "acoshf" rs xs
+lower_CallishMachOp lbl MO_F32_Atanh rs xs =
+  lower_CMO_Un_Homo lbl "atanhf" rs xs
+lower_CallishMachOp lbl MO_F32_Log rs xs = lower_CMO_Un_Homo lbl "logf" rs xs
+lower_CallishMachOp lbl MO_F32_Log1P rs xs =
+  lower_CMO_Un_Homo lbl "log1pf" rs xs
+lower_CallishMachOp lbl MO_F32_Exp rs xs = lower_CMO_Un_Homo lbl "expf" rs xs
+lower_CallishMachOp lbl MO_F32_ExpM1 rs xs =
+  lower_CMO_Un_Homo lbl "expm1f" rs xs
+lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo lbl "fabsf" rs xs
+lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs
+lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs
+lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop
+lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop
+lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop
+lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop
+lower_CallishMachOp lbl (MO_Memcpy {}) [] xs = do
+  ty_word_cmm <- wasmWordCmmTypeM
+  lower_CmmUnsafeForeignCall_Drop lbl "memcpy" ty_word_cmm xs
+lower_CallishMachOp lbl (MO_Memset {}) [] xs = do
+  ty_word_cmm <- wasmWordCmmTypeM
+  lower_CmmUnsafeForeignCall_Drop lbl "memset" ty_word_cmm xs
+lower_CallishMachOp lbl (MO_Memmove {}) [] xs = do
+  ty_word_cmm <- wasmWordCmmTypeM
+  lower_CmmUnsafeForeignCall_Drop lbl "memmove" ty_word_cmm xs
+lower_CallishMachOp lbl (MO_Memcmp {}) rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left "memcmp")
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp lbl (MO_PopCnt {}) rs xs =
+  lower_CMO_Un_Prim lbl WasmPopcnt rs xs
+lower_CallishMachOp lbl (MO_Pdep w0) rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left $ fromString $ "hs_pdep" <> show (widthInBits w0))
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp lbl (MO_Pext w0) rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left $ fromString $ "hs_pext" <> show (widthInBits w0))
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp lbl (MO_Clz {}) rs xs = lower_CMO_Un_Prim lbl WasmClz rs xs
+lower_CallishMachOp lbl (MO_Ctz {}) rs xs = lower_CMO_Un_Prim lbl WasmCtz rs xs
+lower_CallishMachOp lbl (MO_BSwap w0) rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left $ fromString $ "hs_bswap" <> show (widthInBits w0))
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp lbl (MO_BRev w0) rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left $ fromString $ "hs_bitrev" <> show (widthInBits w0))
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp lbl (MO_AtomicRMW w0 op) rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    ( Left $
+        fromString $
+          ( case op of
+              AMO_Add -> "hs_atomic_add"
+              AMO_Sub -> "hs_atomic_sub"
+              AMO_And -> "hs_atomic_and"
+              AMO_Nand -> "hs_atomic_nand"
+              AMO_Or -> "hs_atomic_or"
+              AMO_Xor -> "hs_atomic_xor"
+          )
+            <> show (widthInBits w0)
+    )
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp lbl (MO_AtomicRead w0) [reg] [ptr] = do
+  SomeWasmExpr ty (WasmExpr ret_instr) <-
+    lower_CmmLoad
+      lbl
+      ptr
+      (cmmBits w0)
+      NaturallyAligned
+  ri <- onCmmLocalReg_Typed ty reg
+  pure $ WasmStatements $ ret_instr `WasmConcat` WasmLocalSet ty ri
+lower_CallishMachOp lbl (MO_AtomicWrite _) [] [ptr, val] =
+  lower_CmmStore lbl ptr val NaturallyAligned
+lower_CallishMachOp lbl (MO_Cmpxchg w0) rs xs = lower_MO_Cmpxchg lbl w0 rs xs
+lower_CallishMachOp lbl (MO_Xchg w0) rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left $ fromString $ "hs_xchg" <> show (widthInBits w0))
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp lbl MO_SuspendThread rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left "suspendThread")
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp lbl MO_ResumeThread rs xs =
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left "resumeThread")
+    CmmMayReturn
+    rs
+    xs
+lower_CallishMachOp _ _ _ _ = panic "lower_CallishMachOp: unreachable"
+
+-- | Lower a ccall, but drop the result by assigning it to an unused
+-- local. This is only used for lowering 'MO_Memcpy' and such, where
+-- the libc functions do have a return value, but the corresponding
+-- 'CallishMachOp' does not expect one.
+lower_CmmUnsafeForeignCall_Drop ::
+  CLabel ->
+  SymName ->
+  CmmType ->
+  [CmmActual] ->
+  WasmCodeGenM w (WasmStatements w)
+lower_CmmUnsafeForeignCall_Drop lbl sym_callee ret_cmm_ty arg_exprs = do
+  ret_uniq <- wasmUniq
+  let ret_local = LocalReg ret_uniq ret_cmm_ty
+  lower_CmmUnsafeForeignCall
+    lbl
+    (Left sym_callee)
+    CmmMayReturn
+    [ret_local]
+    arg_exprs
+
+-- | Lower a 'CmmUnsafeForeignCall'. The target is 'Either' a symbol,
+-- which translates to a direct @call@, or an expression, which
+-- translates to a @call_indirect@. The callee function signature is
+-- inferred from the passed in arguments here.
+lower_CmmUnsafeForeignCall ::
+  CLabel ->
+  (Either SymName CmmExpr) ->
+  CmmReturnInfo ->
+  [CmmFormal] ->
+  [CmmActual] ->
+  WasmCodeGenM
+    w
+    (WasmStatements w)
+lower_CmmUnsafeForeignCall lbl target ret_info ret_locals arg_exprs = do
+  SomeWasmPreCCall arg_tys args_instr <-
+    foldrM
+      ( \arg_expr (SomeWasmPreCCall acc_tys acc_instr) -> do
+          SomeWasmExpr arg_ty (WasmExpr arg_instr) <-
+            lower_CmmExpr lbl arg_expr
+          pure $
+            SomeWasmPreCCall (arg_ty `TypeListCons` acc_tys) $
+              arg_instr `WasmConcat` acc_instr
+      )
+      (SomeWasmPreCCall TypeListNil WasmNop)
+      arg_exprs
+  SomeWasmPostCCall ret_tys ret_instr <-
+    foldrM
+      ( \reg (SomeWasmPostCCall acc_tys acc_instr) -> do
+          (reg_i, SomeWasmType reg_ty) <- onCmmLocalReg reg
+          pure $
+            SomeWasmPostCCall (reg_ty `TypeListCons` acc_tys) $
+              acc_instr `WasmConcat` WasmLocalSet reg_ty reg_i
+      )
+      (SomeWasmPostCCall TypeListNil WasmNop)
+      ret_locals
+  case target of
+    Left sym_callee -> do
+      platform <- wasmPlatformM
+      let arg_cmm_tys = map (cmmExprType platform) arg_exprs
+          ret_cmm_tys = map localRegType ret_locals
+      onFuncSym sym_callee arg_cmm_tys ret_cmm_tys
+      pure $
+        WasmStatements $
+          args_instr
+            `WasmConcat` WasmCCall sym_callee
+            `WasmConcat` ( case ret_info of
+                             CmmMayReturn -> ret_instr
+                             CmmNeverReturns -> WasmUnreachable
+                         )
+    Right fptr_callee -> do
+      (WasmExpr instr_callee, _) <- lower_CmmExpr_Ptr lbl fptr_callee
+      pure $
+        WasmStatements $
+          args_instr
+            `WasmConcat` instr_callee
+            `WasmConcat` WasmCCallIndirect arg_tys ret_tys
+            `WasmConcat` ( case ret_info of
+                             CmmMayReturn -> ret_instr
+                             CmmNeverReturns -> WasmUnreachable
+                         )
+
+-- | Lower a 'CmmStore'.
+lower_CmmStore ::
+  CLabel ->
+  CmmExpr ->
+  CmmExpr ->
+  AlignmentSpec ->
+  WasmCodeGenM
+    w
+    (WasmStatements w)
+lower_CmmStore lbl ptr val align = do
+  platform <- wasmPlatformM
+  (WasmExpr ptr_instr, o) <- lower_CmmExpr_Ptr lbl ptr
+  let ty_cmm = cmmExprType platform val
+  SomeWasmExpr ty (WasmExpr val_instr) <- lower_CmmExpr lbl val
+  pure $
+    WasmStatements $
+      ptr_instr
+        `WasmConcat` val_instr
+        `WasmConcat` WasmStore ty (wasmMemoryNarrowing ty ty_cmm) o align
+
+-- | Lower a single Cmm action.
+lower_CmmAction :: CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w)
+lower_CmmAction lbl act = do
+  ty_word <- wasmWordTypeM
+  platform <- wasmPlatformM
+  case act of
+    CmmComment {} -> pure $ WasmStatements WasmNop
+    CmmTick {} -> pure $ WasmStatements WasmNop
+    CmmUnwind {} -> pure $ WasmStatements WasmNop
+    CmmAssign (CmmLocal reg) e -> do
+      (i, SomeWasmType ty_reg) <- onCmmLocalReg reg
+      WasmExpr instrs <- lower_CmmExpr_Typed lbl ty_reg e
+      pure $ WasmStatements $ instrs `WasmConcat` WasmLocalSet ty_reg i
+    CmmAssign (CmmGlobal reg) e
+      | BaseReg <- reg -> pure $ WasmStatements WasmNop
+      | Just (sym_global, SomeWasmType ty_reg) <-
+          globalInfoFromCmmGlobalReg ty_word reg -> do
+          WasmExpr instrs <- lower_CmmExpr_Typed lbl ty_reg e
+          pure $
+            WasmStatements $
+              instrs `WasmConcat` WasmGlobalSet ty_reg sym_global
+      | otherwise -> do
+          (WasmExpr ptr_instr, o) <-
+            lower_CmmExpr_Ptr lbl $ get_GlobalReg_addr platform reg
+          SomeWasmExpr ty_e (WasmExpr instrs) <- lower_CmmExpr lbl e
+          pure $
+            WasmStatements $
+              ptr_instr
+                `WasmConcat` instrs
+                `WasmConcat` WasmStore ty_e Nothing o NaturallyAligned
+    CmmStore ptr val align -> lower_CmmStore lbl ptr val align
+    CmmUnsafeForeignCall
+      ( ForeignTarget
+          (CmmLit (CmmLabel lbl_callee))
+          (ForeignConvention conv _ _ ret_info)
+        )
+      ret_locals
+      arg_exprs
+        | conv `elem` [CCallConv, CApiConv] ->
+            lower_CmmUnsafeForeignCall
+              lbl
+              (Left $ symNameFromCLabel lbl_callee)
+              ret_info
+              ret_locals
+              arg_exprs
+    CmmUnsafeForeignCall
+      (ForeignTarget target_expr (ForeignConvention conv _ _ ret_info))
+      ret_locals
+      arg_exprs
+        | conv `elem` [CCallConv, CApiConv] ->
+            lower_CmmUnsafeForeignCall
+              lbl
+              (Right target_expr)
+              ret_info
+              ret_locals
+              arg_exprs
+    CmmUnsafeForeignCall (PrimTarget op) ret_locals arg_exprs ->
+      lower_CallishMachOp lbl op ret_locals arg_exprs
+    _ -> panic "lower_CmmAction: unreachable"
+
+-- | Lower a block of Cmm actions.
+lower_CmmActions ::
+  CLabel ->
+  Label ->
+  Block CmmNode O O ->
+  WasmCodeGenM
+    w
+    (WasmStatements w)
+lower_CmmActions lbl _ blk =
+  foldlM
+    ( \(WasmStatements acc) act ->
+        (\(WasmStatements stmts) -> WasmStatements $ acc `WasmConcat` stmts)
+          <$> lower_CmmAction lbl act
+    )
+    (WasmStatements WasmNop)
+    acts
+  where
+    acts = blockToList blk
+
+-- | Lower a 'CmmGraph'.
+lower_CmmGraph :: CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
+lower_CmmGraph lbl g = do
+  ty_word <- wasmWordTypeM
+  platform <- wasmPlatformM
+  body <-
+    structuredControl
+      platform
+      (\_ -> lower_CmmExpr_Typed lbl ty_word)
+      (lower_CmmActions lbl)
+      g
+  locals <- wasmStateM $ \s ->
+    (#
+      map snd $ detEltsUFM $ localRegs s,
+      s {localRegs = emptyUFM, localRegsCount = 0}
+    #)
+  pure FuncBody {funcLocals = locals, funcBody = wasmControlCast $ body}
+
+-- | Invoked once for each 'CLabel' which indexes a 'CmmData' or
+-- 'CmmProc'.
+onTopSym :: CLabel -> WasmCodeGenM w ()
+onTopSym lbl = case sym_vis of
+  SymDefault -> wasmModifyM $ \s ->
+    s
+      { defaultSyms =
+          IS.insert
+            (getKey $ getUnique sym)
+            $ defaultSyms s
+      }
+  _ -> pure ()
+  where
+    sym = symNameFromCLabel lbl
+
+    sym_vis = symVisibilityFromCLabel lbl
+
+-- | Invoked for each function 'CLabel' with known type (e.g. a
+-- 'CmmProc', or callee of 'CmmUnsafeForeignCall').
+onFuncSym :: SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
+onFuncSym sym arg_tys ret_tys = wasmModifyM $
+  \s@WasmCodeGenState {..} ->
+    s
+      { funcTypes =
+          addToUniqMap
+            funcTypes
+            sym
+            ( map someWasmTypeFromCmmType arg_tys,
+              map someWasmTypeFromCmmType ret_tys
+            )
+      }
+
+-- | Invoked for all other 'CLabel's along the way, e.g. in
+-- 'CmmStatic's or 'CmmExpr's.
+onAnySym :: CLabel -> WasmCodeGenM w ()
+onAnySym lbl = case sym_kind of
+  SymFunc -> wasmModifyM $ \s@WasmCodeGenState {..} ->
+    s {funcTypes = addToUniqMap_C const funcTypes sym ([], [])}
+  _ -> pure ()
+  where
+    sym = symNameFromCLabel lbl
+
+    sym_kind = symKindFromCLabel lbl
+
+-- | Invoked for each 'LocalReg', returning its wasm local id and
+-- representation type.
+onCmmLocalReg :: LocalReg -> WasmCodeGenM w LocalInfo
+onCmmLocalReg reg = wasmStateM $ \s@WasmCodeGenState {..} ->
+  let reg_info =
+        (localRegsCount, someWasmTypeFromCmmType $ localRegType reg)
+   in case addToUFM_L (\_ i _ -> i) reg reg_info localRegs of
+        (Just i, _) -> (# i, s #)
+        (_, localRegs') ->
+          (#
+            reg_info,
+            s
+              { localRegs = localRegs',
+                localRegsCount =
+                  localRegsCount + 1
+              }
+          #)
+
+-- | Invoked for each 'LocalReg' with expected representation type,
+-- only returning its wasm local id.
+onCmmLocalReg_Typed :: WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
+onCmmLocalReg_Typed ty reg = do
+  (i, SomeWasmType ty') <- onCmmLocalReg reg
+  if
+      | Just Refl <- ty' `testEquality` ty -> pure i
+      | otherwise -> panic "onCmmLocalReg_Typed: unreachable"
+
+-- | Invoked for dtors. We don't bother to implement dtors yet;
+-- there's no native @.fini_array@ support for wasm, and the way
+-- @clang@ handles dtors is generating a ctor that calls @atexit()@
+-- for dtors. Which makes some sense, but we don't need to do the same
+-- thing yet.
+onFini :: [SymName] -> WasmCodeGenM w ()
+onFini syms = do
+  let n_finis = length syms
+  when (n_finis /= 0) $ panic "dtors unsupported by wasm32 NCG"
+
+-- | Invoked for ctors and dtors.
+onCmmInitFini :: InitOrFini -> [CLabel] -> WasmCodeGenM w ()
+onCmmInitFini iof lbls = do
+  for_ lbls $ \lbl -> onFuncSym (symNameFromCLabel lbl) [] []
+  case iof of
+    IsInitArray -> wasmModifyM $ \s -> s {ctors = syms <> ctors s}
+    IsFiniArray -> onFini syms
+  where
+    syms = map symNameFromCLabel lbls
+
+-- | Invoked for each data section.
+onCmmData :: CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
+onCmmData lbl s statics = do
+  ty_word <- wasmWordTypeM
+  onTopSym lbl
+  cs <- for statics lower_CmmStatic
+  let sym = symNameFromCLabel lbl
+      sec =
+        DataSection
+          { dataSectionKind =
+              dataSectionKindFromCmmSection s,
+            dataSectionAlignment =
+              alignmentFromCmmSection ty_word lbl,
+            dataSectionContents =
+              case cs of
+                [DataASCII buf] -> [DataASCII $ buf `BS.snoc` 0]
+                [DataIncBin p l] -> [DataIncBin p l, DataI8 0]
+                _ -> cs
+          }
+  wasmModifyM $ \s ->
+    s
+      { dataSections =
+          addToUniqMap (dataSections s) sym sec
+      }
+
+-- | Invoked for each 'CmmProc'.
+onCmmProc :: CLabel -> CmmGraph -> WasmCodeGenM w ()
+onCmmProc lbl g = do
+  ty_word <- wasmWordCmmTypeM
+  onTopSym lbl
+  onFuncSym sym [] [ty_word]
+  body <- lower_CmmGraph lbl g
+  wasmModifyM $ \s -> s {funcBodies = addToUniqMap (funcBodies s) sym body}
+  where
+    sym = symNameFromCLabel lbl
+
+-- | Invoked for each 'RawCmmDecl'.
+onCmmDecl :: RawCmmDecl -> WasmCodeGenM w ()
+onCmmDecl decl
+  | Just (iof, lbls) <- isInitOrFiniArray decl = onCmmInitFini iof lbls
+onCmmDecl (CmmData s (CmmStaticsRaw lbl statics)) = onCmmData lbl s statics
+onCmmDecl (CmmProc _ lbl _ g) = onCmmProc lbl g
+
+-- | Invoked for each 'RawCmmGroup'.
+onCmmGroup :: RawCmmGroup -> WasmCodeGenM w ()
+onCmmGroup cmms = wasmStateM $ \s0 ->
+  (# (), foldl' (\s cmm -> wasmExecM (onCmmDecl cmm) s) s0 cmms #)
diff --git a/compiler/GHC/CmmToAsm/Wasm/Types.hs b/compiler/GHC/CmmToAsm/Wasm/Types.hs
new file mode 100644
index 0000000000..ab052dc353
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Wasm/Types.hs
@@ -0,0 +1,455 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Strict #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module GHC.CmmToAsm.Wasm.Types
+  ( WasmType (..),
+    WasmTypeTag (..),
+    SomeWasmType (..),
+    TypeList (..),
+    someWasmTypesFromTypeList,
+    WasmFunctionType (..),
+    SymName (..),
+    SymVisibility (..),
+    SymKind (..),
+    DataSectionKind (..),
+    DataSectionContent (..),
+    DataSection (..),
+    GlobalInfo,
+    LocalInfo,
+    FuncBody (..),
+    Signage (..),
+    WasmInstr (..),
+    WasmExpr (..),
+    SomeWasmExpr (..),
+    WasmStatements (..),
+    WasmControl (..),
+    BrTableInterval (..),
+    wasmControlCast,
+    WasmCodeGenState (..),
+    initialWasmCodeGenState,
+    WasmCodeGenM (..),
+    wasmGetsM,
+    wasmPlatformM,
+    wasmWordTypeM,
+    wasmWordCmmTypeM,
+    wasmStateM,
+    wasmModifyM,
+    wasmExecM,
+    wasmUniq,
+  )
+where
+
+import Control.Applicative
+import Data.ByteString (ByteString)
+import Data.Coerce
+import Data.Functor
+import qualified Data.IntSet as IS
+import Data.Kind
+import Data.String
+import Data.Type.Equality
+import GHC.Cmm
+import GHC.Data.FastString
+import GHC.Float
+import GHC.Platform
+import GHC.Prelude
+import GHC.Types.Basic
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Map
+import GHC.Types.Unique.Supply
+import GHC.Utils.Monad.State.Strict
+import GHC.Utils.Outputable hiding ((<>))
+import Unsafe.Coerce
+
+-- | WebAssembly type of a WebAssembly value that WebAssembly code
+-- could either expect on the evaluation stack or leave on the
+-- evaluation stack.
+data WasmType = I32 | I64 | F32 | F64
+
+-- | Singleton type useful for programming with `WasmType` at the type
+-- level.
+data WasmTypeTag :: WasmType -> Type where
+  TagI32 :: WasmTypeTag 'I32
+  TagI64 :: WasmTypeTag 'I64
+  TagF32 :: WasmTypeTag 'F32
+  TagF64 :: WasmTypeTag 'F64
+
+deriving instance Show (WasmTypeTag t)
+
+instance TestEquality WasmTypeTag where
+  TagI32 `testEquality` TagI32 = Just Refl
+  TagI64 `testEquality` TagI64 = Just Refl
+  TagF32 `testEquality` TagF32 = Just Refl
+  TagF64 `testEquality` TagF64 = Just Refl
+  _ `testEquality` _ = Nothing
+
+data SomeWasmType where
+  SomeWasmType :: WasmTypeTag t -> SomeWasmType
+
+instance Eq SomeWasmType where
+  SomeWasmType ty0 == SomeWasmType ty1
+    | Just Refl <- ty0 `testEquality` ty1 = True
+    | otherwise = False
+
+-- | List of WebAssembly types used to describe the sequence of
+-- WebAssembly values that a block of code may expect on the stack or
+-- leave on the stack.
+data TypeList :: [WasmType] -> Type where
+  TypeListNil :: TypeList '[]
+  TypeListCons :: WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
+
+someWasmTypesFromTypeList :: TypeList ts -> [SomeWasmType]
+someWasmTypesFromTypeList TypeListNil = []
+someWasmTypesFromTypeList (ty `TypeListCons` tys) =
+  SomeWasmType ty : someWasmTypesFromTypeList tys
+
+-- | The type of a WebAssembly function, loop, block, or conditional.
+-- This type says what values the code expects to pop off the stack
+-- and what values it promises to push.  The WebAssembly standard
+-- requires that this type appear explicitly in the code.
+data WasmFunctionType pre post = WasmFunctionType {ft_pops :: TypeList pre, ft_pushes :: TypeList post}
+
+-- | For simplicity, we record other metadata in 'WasmCodeGenState' by
+-- need, instead of carrying them along with 'SymName'.
+newtype SymName = SymName FastString
+  deriving (Eq, IsString, Show, Uniquable) via FastString
+  deriving (Ord) via LexicalFastString
+
+data SymVisibility
+  = -- | Not defined in the current compilation unit.
+    --
+    -- @[ undefined binding=global vis=default ]@
+    SymUndefined
+  | -- | Defined, not visible to other compilation units.
+    --
+    -- @[ binding=local vis=default ]@
+    SymStatic
+  | -- | Defined, visible to other compilation units.
+    --
+    -- Adds @.hidden@ & @.globl@ directives in the output assembly.
+    --
+    -- @[ binding=global vis=hidden ]@
+    SymDefault
+
+-- | Represents whether a symbol is a data symbol or a function
+-- symbol. Unlike linkers for other targets, @wasm-ld@ does panic at
+-- link-time if it finds symbol kind inconsistency between the
+-- definition site and other use sites.
+--
+-- Currently we solely rely on 'isCFunctionLabel' to determine a
+-- symbol's kind, but it does take extra effort to make it work. The
+-- main source of inconsistency arises from hand-written Cmm sources,
+-- where it's possible to refer to external entities like @xxx_info@
+-- and @xxx_closure@ without explicit @import CLOSURE@ declarations.
+-- The Cmm parser will implicitly assume those are foreign function
+-- labels, and then this will break the WebAssembly backend. #22368
+-- provides more context on this issue.
+--
+-- tl;dr for any GHC contributor that accidentally triggers @wasm-ld@
+-- errors when hacking Cmm: whatever data symbols are used in new
+-- code, just add the corresponding @import CLOSURE@ declarations at
+-- the top of that Cmm file.
+data SymKind = SymData | SymFunc
+  deriving (Eq)
+
+-- | WebAssembly doesn't really have proper read-only memory regions
+-- yet. Neverthless we add the .rodata logic here, wasm-ld will
+-- aggregate all .rodata sections into a single one, which adds
+-- possibility for runtime checks later, either via a customized
+-- runtime, or via code instrumentation. See
+-- <https://github.com/llvm/llvm-project/blob/b296aed8ae239c20ebdd7969e978f8d2a3b9c178/lld/wasm/Writer.cpp#L856>
+data DataSectionKind = SectionData | SectionROData
+
+-- | Neither Cmm or Wasm type system takes integer signedness into
+-- account, therefore we always round up a 'CmmLit' to the right width
+-- and handle it as an untyped integer.
+data DataSectionContent
+  = DataI8 Integer
+  | DataI16 Integer
+  | DataI32 Integer
+  | DataI64 Integer
+  | DataF32 Float
+  | DataF64 Double
+  | DataSym SymName Int
+  | DataSkip Int
+  | DataASCII ByteString
+  | DataIncBin FilePath Int
+
+data DataSection = DataSection
+  { dataSectionKind :: DataSectionKind,
+    dataSectionAlignment ::
+      Alignment,
+    dataSectionContents :: [DataSectionContent]
+  }
+
+-- | We need to remember the symbols. Determinism is achieved by
+-- sorting symbols before writing the assembly.
+type SymMap = UniqMap SymName
+
+-- | No need to remember the symbols.
+type SymSet = IS.IntSet
+
+type GlobalInfo = (SymName, SomeWasmType)
+
+type LocalInfo = (Int, SomeWasmType)
+
+data FuncBody w = FuncBody
+  { funcLocals :: [SomeWasmType],
+    -- | Most are Cmm functions, but may also contain synthesized
+    -- function of other types, sigh.
+    funcBody :: WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
+  }
+
+data Signage = Signed | Unsigned
+
+-- | The @w@ type variable in the Wasm IR stands for "platform word
+-- type", so 'TagI32' on wasm32, and 'TagI64' on wasm64. This way, we
+-- can make the codegen logic work on both wasm32/wasm64 in a
+-- type-safe manner.
+data WasmInstr :: WasmType -> [WasmType] -> [WasmType] -> Type where
+  WasmComment :: String -> WasmInstr w pre pre
+  WasmNop :: WasmInstr w pre pre
+  WasmDrop :: WasmInstr w (t : pre) pre
+  WasmUnreachable :: WasmInstr w pre post
+  WasmConst :: WasmTypeTag t -> Integer -> WasmInstr w pre (t : pre)
+  WasmSymConst :: SymName -> WasmInstr w pre (w : pre)
+  WasmLoad ::
+    WasmTypeTag t ->
+    Maybe Int ->
+    Signage ->
+    Int ->
+    AlignmentSpec ->
+    WasmInstr w (w : pre) (t : pre)
+  WasmStore ::
+    WasmTypeTag t ->
+    Maybe Int ->
+    Int ->
+    AlignmentSpec ->
+    WasmInstr
+      w
+      (t : w : pre)
+      pre
+  WasmGlobalGet :: WasmTypeTag t -> SymName -> WasmInstr w pre (t : pre)
+  WasmGlobalSet :: WasmTypeTag t -> SymName -> WasmInstr w (t : pre) pre
+  WasmLocalGet :: WasmTypeTag t -> Int -> WasmInstr w pre (t : pre)
+  WasmLocalSet :: WasmTypeTag t -> Int -> WasmInstr w (t : pre) pre
+  WasmLocalTee :: WasmTypeTag t -> Int -> WasmInstr w (t : pre) (t : pre)
+  WasmCCall :: SymName -> WasmInstr w pre post
+  WasmCCallIndirect ::
+    TypeList arg_tys ->
+    TypeList ret_tys ->
+    WasmInstr
+      w
+      (w : pre)
+      post
+  WasmConcat ::
+    WasmInstr w pre mid ->
+    WasmInstr w mid post ->
+    WasmInstr w pre post
+  WasmReinterpret ::
+    WasmTypeTag t0 ->
+    WasmTypeTag t1 ->
+    WasmInstr
+      w
+      (t0 : pre)
+      (t1 : pre)
+  WasmTruncSat ::
+    Signage ->
+    WasmTypeTag t0 ->
+    WasmTypeTag t1 ->
+    WasmInstr
+      w
+      (t0 : pre)
+      (t1 : pre)
+  WasmConvert ::
+    Signage ->
+    WasmTypeTag t0 ->
+    WasmTypeTag t1 ->
+    WasmInstr
+      w
+      (t0 : pre)
+      (t1 : pre)
+  WasmClz :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
+  WasmCtz :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
+  WasmPopcnt :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
+  WasmAdd :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmSub :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmMul :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmDiv :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmRem :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmAnd :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmOr :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmXor :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmEq :: WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
+  WasmNe :: WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
+  WasmLt :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
+  WasmGt :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
+  WasmLe :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
+  WasmGe :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
+  WasmShl :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmShr :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
+  WasmI32Extend8S :: WasmInstr w ('I32 : pre) ('I32 : pre)
+  WasmI32Extend16S :: WasmInstr w ('I32 : pre) ('I32 : pre)
+  WasmI64Extend8S :: WasmInstr w ('I64 : pre) ('I64 : pre)
+  WasmI64Extend16S :: WasmInstr w ('I64 : pre) ('I64 : pre)
+  WasmI64Extend32S :: WasmInstr w ('I64 : pre) ('I64 : pre)
+  WasmI64ExtendI32 :: Signage -> WasmInstr w ('I32 : pre) ('I64 : pre)
+  WasmI32WrapI64 :: WasmInstr w ('I64 : pre) ('I32 : pre)
+  WasmF32DemoteF64 :: WasmInstr w ('F64 : pre) ('F32 : pre)
+  WasmF64PromoteF32 :: WasmInstr w ('F32 : pre) ('F64 : pre)
+  WasmAbs :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
+  WasmCond :: WasmInstr w pre pre -> WasmInstr w (w : pre) pre
+
+newtype WasmExpr w t = WasmExpr (forall pre. WasmInstr w pre (t : pre))
+
+data SomeWasmExpr w where
+  SomeWasmExpr :: WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
+
+newtype WasmStatements w = WasmStatements (forall pre. WasmInstr w pre pre)
+
+-- | Representation of WebAssembly control flow.
+-- Normally written as
+-- @
+--   WasmControl s e pre post
+-- @
+-- Type parameter `s` is the type of (unspecified) statements.
+-- It might be instantiated with an open Cmm block or with a sequence
+-- of Wasm instructions.
+-- Parameter `e` is the type of expressions.
+-- Parameter `pre` represents the values that are expected on the
+-- WebAssembly stack when the code runs, and `post` represents
+-- the state of the stack on completion.
+data WasmControl :: Type -> Type -> [WasmType] -> [WasmType] -> Type where
+  WasmPush :: WasmTypeTag t -> e -> WasmControl s e stack (t : stack)
+  WasmBlock ::
+    WasmFunctionType pre post ->
+    WasmControl s e pre post ->
+    WasmControl s e pre post
+  WasmLoop ::
+    WasmFunctionType pre post ->
+    WasmControl s e pre post ->
+    WasmControl s e pre post
+  WasmIfTop ::
+    WasmFunctionType pre post ->
+    WasmControl s e pre post ->
+    WasmControl s e pre post ->
+    WasmControl s e ('I32 : pre) post
+  WasmBr :: Int -> WasmControl s e dropped destination -- not typechecked
+  WasmFallthrough :: WasmControl s e dropped destination
+  -- generates no code, but has the same type as a branch
+  WasmBrTable ::
+    e ->
+    BrTableInterval -> -- for testing
+    [Int] -> -- targets
+    Int -> -- default target
+    WasmControl s e dropped destination
+  -- invariant: the table interval is contained
+  -- within [0 .. pred (length targets)]
+  WasmReturnTop ::
+    WasmTypeTag t ->
+    WasmControl s e (t : t1star) t2star -- as per type system
+  WasmActions ::
+    s ->
+    WasmControl s e stack stack -- basic block: one entry, one exit
+  WasmSeq ::
+    WasmControl s e pre mid ->
+    WasmControl s e mid post ->
+    WasmControl s e pre post
+
+data BrTableInterval = BrTableInterval {bti_lo :: Integer, bti_count :: Integer}
+  deriving (Show)
+
+instance Outputable BrTableInterval where
+  ppr range =
+    brackets $
+      hcat
+        [integer (bti_lo range), text "..", integer hi]
+    where
+      hi = bti_lo range + bti_count range - 1
+
+wasmControlCast :: WasmControl s e pre post -> WasmControl s e pre' post'
+wasmControlCast = unsafeCoerce
+
+data WasmCodeGenState w = WasmCodeGenState
+  { -- | Target platform
+    wasmPlatform :: Platform,
+    -- | Defined symbols with 'SymDefault' visibility.
+    defaultSyms :: SymSet,
+    -- | Function types, defined or not. There may exist a function
+    -- whose type is unknown (e.g. as a function pointer), in that
+    -- case we fall back to () -> (), it's imperfect but works with
+    -- wasm-ld.
+    funcTypes :: SymMap ([SomeWasmType], [SomeWasmType]),
+    -- | Defined function bodies.
+    funcBodies :: SymMap (FuncBody w),
+    -- | Defined data sections.
+    dataSections :: SymMap DataSection,
+    -- | ctors in the current compilation unit.
+    ctors :: [SymName],
+    localRegs ::
+      UniqFM LocalReg LocalInfo,
+    localRegsCount ::
+      Int,
+    wasmUniqSupply :: UniqSupply
+  }
+
+initialWasmCodeGenState :: Platform -> UniqSupply -> WasmCodeGenState w
+initialWasmCodeGenState platform us =
+  WasmCodeGenState
+    { wasmPlatform =
+        platform,
+      defaultSyms = IS.empty,
+      funcTypes = emptyUniqMap,
+      funcBodies =
+        emptyUniqMap,
+      dataSections = emptyUniqMap,
+      ctors =
+        [],
+      localRegs = emptyUFM,
+      localRegsCount = 0,
+      wasmUniqSupply = us
+    }
+
+newtype WasmCodeGenM w a = WasmCodeGenM (State (WasmCodeGenState w) a)
+  deriving newtype (Functor, Applicative, Monad)
+
+wasmGetsM :: (WasmCodeGenState w -> a) -> WasmCodeGenM w a
+wasmGetsM = coerce . gets
+
+wasmPlatformM :: WasmCodeGenM w Platform
+wasmPlatformM = wasmGetsM wasmPlatform
+
+wasmWordTypeM :: WasmCodeGenM w (WasmTypeTag w)
+wasmWordTypeM = wasmGetsM $ \s ->
+  if target32Bit $ wasmPlatform s
+    then unsafeCoerce TagI32
+    else unsafeCoerce TagI64
+
+wasmWordCmmTypeM :: WasmCodeGenM w CmmType
+wasmWordCmmTypeM = wasmGetsM (bWord . wasmPlatform)
+
+wasmStateM ::
+  (WasmCodeGenState w -> (# a, WasmCodeGenState w #)) ->
+  WasmCodeGenM w a
+wasmStateM = coerce . State
+
+wasmModifyM :: (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
+wasmModifyM = coerce . modify
+
+wasmExecM :: WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w
+wasmExecM (WasmCodeGenM s) = execState s
+
+wasmUniq :: WasmCodeGenM w Unique
+wasmUniq = wasmStateM $
+  \s@WasmCodeGenState {..} -> case takeUniqFromSupply wasmUniqSupply of
+    (u, us) -> (# u, s {wasmUniqSupply = us} #)
diff --git a/compiler/GHC/CmmToAsm/Wasm/Utils.hs b/compiler/GHC/CmmToAsm/Wasm/Utils.hs
new file mode 100644
index 0000000000..b794c7f5b7
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Wasm/Utils.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Strict #-}
+
+module GHC.CmmToAsm.Wasm.Utils
+  ( naturalNarrowing,
+    widthMax,
+    detEltsUFM,
+    detEltsUniqMap,
+    builderCommas,
+  )
+where
+
+import Data.ByteString.Builder
+import Data.List (intersperse, sortOn)
+import GHC.Cmm
+import GHC.Prelude
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Map
+
+naturalNarrowing :: Width -> Integer -> Integer
+naturalNarrowing w i
+  | i < 0 = narrowS w i
+  | otherwise = narrowU w i
+
+widthMax :: Width -> Integer
+widthMax w = (1 `shiftL` widthInBits w) - 1
+
+detEltsUFM :: Ord k => UniqFM k0 (k, a) -> [(k, a)]
+detEltsUFM = sortOn fst . nonDetEltsUFM
+
+detEltsUniqMap :: Ord k => UniqMap k a -> [(k, a)]
+detEltsUniqMap = sortOn fst . nonDetEltsUniqMap
+
+builderCommas :: (a -> Builder) -> [a] -> Builder
+builderCommas f xs = mconcat (intersperse ", " (map f xs))
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index b7ff590a11..de013e5d32 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -816,6 +816,11 @@ Library
         GHC.Utils.Trace
         GHC.Wasm.ControlFlow
         GHC.Wasm.ControlFlow.FromCmm
+        GHC.CmmToAsm.Wasm
+        GHC.CmmToAsm.Wasm.Asm
+        GHC.CmmToAsm.Wasm.FromCmm
+        GHC.CmmToAsm.Wasm.Types
+        GHC.CmmToAsm.Wasm.Utils
 
         Language.Haskell.Syntax
         Language.Haskell.Syntax.Basic