{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use camelCase" #-}
module GHC.CmmToAsm.Wasm.FromCmm
  ( alignmentFromWordType,
    globalInfoFromCmmGlobalReg,
    supportedCmmGlobalRegs,
    onCmmGroup,
  )
where

import Control.Monad
import qualified Data.ByteString as BS
import Data.Foldable
import Data.Functor
import Data.Semigroup
import Data.String
import Data.Traversable
import Data.Type.Equality
import GHC.Cmm
import GHC.Cmm.BlockId
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.Types.Unique.Set
import GHC.Types.Unique.DSM
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 :: CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t
  | CmmType -> Bool
isWord32 CmmType
t = WasmTypeTag 'I32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType -> Bool
isWord64 CmmType
t = WasmTypeTag 'I64 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I64
TagI64
  | CmmType
t CmmType -> CmmType -> Bool
`cmmEqType` CmmType
b16 = WasmTypeTag 'I32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType
t CmmType -> CmmType -> Bool
`cmmEqType` CmmType
b8 = WasmTypeTag 'I32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType -> Bool
isFloat64 CmmType
t = WasmTypeTag 'F64 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F64
TagF64
  | CmmType -> Bool
isFloat32 CmmType
t = WasmTypeTag 'F32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F32
TagF32
  | Bool
otherwise =
      String -> SomeWasmType
forall a. HasCallStack => String -> a
panic (String -> SomeWasmType) -> String -> SomeWasmType
forall a b. (a -> b) -> a -> b
$
        String
"someWasmTypeFromCmmType: unsupported CmmType "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext (CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
t)

-- | Calculate the optional memory narrowing of a 'CmmLoad' or
-- 'CmmStore'.
wasmMemoryNarrowing :: WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing :: forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm = case (# WasmTypeTag t
ty, CmmType -> Width
typeWidth CmmType
ty_cmm #) of
  (# WasmTypeTag t
TagI32, Width
W8 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
  (# WasmTypeTag t
TagI32, Width
W16 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
16
  (# WasmTypeTag t
TagI32, Width
W32 #) -> Maybe Int
forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagI64, Width
W8 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
  (# WasmTypeTag t
TagI64, Width
W16 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
16
  (# WasmTypeTag t
TagI64, Width
W32 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
32
  (# WasmTypeTag t
TagI64, Width
W64 #) -> Maybe Int
forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagF32, Width
W32 #) -> Maybe Int
forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagF64, Width
W64 #) -> Maybe Int
forall a. Maybe a
Nothing
  (# WasmTypeTag t, Width #)
_ -> String -> Maybe Int
forall a. HasCallStack => String -> a
panic String
"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 :: CLabel -> SymName
symNameFromCLabel CLabel
lbl =
  String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$
    SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext {sdocStyle = PprCode} (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$
      Platform -> CLabel -> SDoc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
genericPlatform CLabel
lbl

-- | Calculate a symbol's visibility.
symVisibilityFromCLabel :: CLabel -> SymVisibility
symVisibilityFromCLabel :: CLabel -> SymVisibility
symVisibilityFromCLabel CLabel
lbl
  | CLabel -> Bool
externallyVisibleCLabel CLabel
lbl = SymVisibility
SymDefault
  | Bool
otherwise = SymVisibility
SymStatic

-- | Calculate a symbol's kind, see haddock docs of 'SymKind' for more
-- explanation.
symKindFromCLabel :: CLabel -> SymKind
symKindFromCLabel :: CLabel -> SymKind
symKindFromCLabel CLabel
lbl
  | CLabel -> Bool
isCFunctionLabel CLabel
lbl = SymKind
SymFunc
  | Bool
otherwise = SymKind
SymData

-- | Calculate a data section's kind, see haddock docs of
-- 'DataSectionKind' for more explanation.
dataSectionKindFromCmmSection :: Section -> DataSectionKind
dataSectionKindFromCmmSection :: Section -> DataSectionKind
dataSectionKindFromCmmSection Section
s = case Section -> SectionProtection
sectionProtection Section
s of
  SectionProtection
ReadWriteSection -> DataSectionKind
SectionData
  SectionProtection
_ -> DataSectionKind
SectionROData

-- | Calculate the natural alignment size given the platform word
-- type.
alignmentFromWordType :: WasmTypeTag w -> Alignment
alignmentFromWordType :: forall (w :: WasmType). WasmTypeTag w -> Alignment
alignmentFromWordType WasmTypeTag w
TagI32 = Int -> Alignment
mkAlignment Int
4
alignmentFromWordType WasmTypeTag w
TagI64 = Int -> Alignment
mkAlignment Int
8
alignmentFromWordType WasmTypeTag w
_ = String -> Alignment
forall a. HasCallStack => String -> a
panic String
"alignmentFromWordType: unreachable"

-- | Calculate a data section's alignment. As a conservative
-- optimization, a data section with a single CmmString/CmmFileEmbed
-- has no alignment requirement, otherwise we always align to the word
-- size to satisfy pointer tagging requirements and avoid unaligned
-- loads/stores.
alignmentFromCmmSection :: WasmTypeTag w -> [DataSectionContent] -> Alignment
alignmentFromCmmSection :: forall (w :: WasmType).
WasmTypeTag w -> [DataSectionContent] -> Alignment
alignmentFromCmmSection WasmTypeTag w
_ [DataASCII {}] = Int -> Alignment
mkAlignment Int
1
alignmentFromCmmSection WasmTypeTag w
_ [DataIncBin {}] = Int -> Alignment
mkAlignment Int
1
alignmentFromCmmSection WasmTypeTag w
t [DataSectionContent]
_ = WasmTypeTag w -> Alignment
forall (w :: WasmType). WasmTypeTag w -> Alignment
alignmentFromWordType WasmTypeTag w
t

-- | Lower a 'CmmStatic'.
lower_CmmStatic :: CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic :: forall (w :: WasmType).
CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic CmmStatic
s = case CmmStatic
s of
  CmmStaticLit (CmmInt Integer
i Width
W8) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Word8 -> DataSectionContent
DataI8 (Word8 -> DataSectionContent) -> Word8 -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W8 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W16) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Word16 -> DataSectionContent
DataI16 (Word16 -> DataSectionContent) -> Word16 -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Integer -> Word16
forall a. Num a => Integer -> a
fromInteger (Integer -> Word16) -> Integer -> Word16
forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W16 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W32) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Word32 -> DataSectionContent
DataI32 (Word32 -> DataSectionContent) -> Word32 -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W32 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W64) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Word64 -> DataSectionContent
DataI64 (Word64 -> DataSectionContent) -> Word64 -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W64 Integer
i
  CmmStaticLit (CmmFloat Rational
f Width
W32) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Float -> DataSectionContent
DataF32 (Float -> DataSectionContent) -> Float -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
f
  CmmStaticLit (CmmFloat Rational
d Width
W64) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Double -> DataSectionContent
DataF64 (Double -> DataSectionContent) -> Double -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
d
  CmmStaticLit (CmmLabel CLabel
lbl) ->
    CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl
      WasmCodeGenM w ()
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SymName -> Int -> DataSectionContent
DataSym
        (CLabel -> SymName
symNameFromCLabel CLabel
lbl)
        Int
0
  CmmStaticLit (CmmLabelOff CLabel
lbl Int
o) ->
    CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl
      WasmCodeGenM w ()
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SymName -> Int -> DataSectionContent
DataSym
        (CLabel -> SymName
symNameFromCLabel CLabel
lbl)
        Int
o
  CmmUninitialised Int
i -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Int -> DataSectionContent
DataSkip Int
i
  CmmString ByteString
b -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ ByteString -> DataSectionContent
DataASCII ByteString
b
  CmmFileEmbed String
f Int
l -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ String -> Int -> DataSectionContent
DataIncBin String
f Int
l
  CmmStatic
_ -> String -> WasmCodeGenM w DataSectionContent
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
t GlobalReg
reg = case GlobalReg
reg of
  VanillaReg Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"__R" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i, SomeWasmType
ty_word)
  FloatReg Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 ->
        GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"__F" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i, WasmTypeTag 'F32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F32
TagF32)
  DoubleReg Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 ->
        GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"__D" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i, WasmTypeTag 'F64 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F64
TagF64)
  LongReg Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"__L" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i, WasmTypeTag 'I64 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I64
TagI64)
  GlobalReg
Sp -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (SymName
"__Sp", SomeWasmType
ty_word)
  GlobalReg
SpLim -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (SymName
"__SpLim", SomeWasmType
ty_word)
  GlobalReg
Hp -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (SymName
"__Hp", SomeWasmType
ty_word)
  GlobalReg
HpLim -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (SymName
"__HpLim", SomeWasmType
ty_word)
  GlobalReg
_ -> Maybe GlobalInfo
forall a. Maybe a
Nothing
  where
    ty_word :: SomeWasmType
ty_word = WasmTypeTag w -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag w
t

supportedCmmGlobalRegs :: [GlobalReg]
supportedCmmGlobalRegs :: [GlobalReg]
supportedCmmGlobalRegs =
  [Int -> GlobalReg
VanillaReg Int
i | Int
i <- [Int
1 .. Int
10]]
    [GlobalReg] -> [GlobalReg] -> [GlobalReg]
forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
FloatReg Int
i | Int
i <- [Int
1 .. Int
6]]
    [GlobalReg] -> [GlobalReg] -> [GlobalReg]
forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
DoubleReg Int
i | Int
i <- [Int
1 .. Int
6]]
    [GlobalReg] -> [GlobalReg] -> [GlobalReg]
forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
LongReg Int
i | Int
i <- [Int
1 .. Int
1]]
    [GlobalReg] -> [GlobalReg] -> [GlobalReg]
forall a. Semigroup a => a -> a -> a
<> [GlobalReg
Sp, GlobalReg
SpLim, GlobalReg
Hp, GlobalReg
HpLim]

-- | Truncate a subword.
truncSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword :: forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
W8 WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
  (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Integer -> WasmInstr w (t : pre) (t : t : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty Integer
0xFF WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
ty
truncSubword Width
W16 WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
  (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Integer -> WasmInstr w (t : pre) (t : t : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty Integer
0xFFFF WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
ty
truncSubword Width
_ WasmTypeTag t
_ WasmExpr w t
expr = WasmExpr w t
expr

-- | Sign-extend a subword.
extendSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword :: forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
W8 WasmTypeTag t
TagI32 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
  (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : pre)
WasmInstr w ('I32 : pre) ('I32 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I32 : pre) ('I32 : pre)
WasmI32Extend8S
extendSubword Width
W16 WasmTypeTag t
TagI32 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
  (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : pre)
WasmInstr w ('I32 : pre) ('I32 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I32 : pre) ('I32 : pre)
WasmI32Extend16S
extendSubword Width
W8 WasmTypeTag t
TagI64 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
  (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : pre)
WasmInstr w ('I64 : pre) ('I64 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I64 : pre)
WasmI64Extend8S
extendSubword Width
W16 WasmTypeTag t
TagI64 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
  (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : pre)
WasmInstr w ('I64 : pre) ('I64 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I64 : pre)
WasmI64Extend16S
extendSubword Width
W32 WasmTypeTag t
TagI64 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
  (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : pre)
WasmInstr w ('I64 : pre) ('I64 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I64 : pre)
WasmI64Extend32S
extendSubword Width
_ WasmTypeTag t
_ WasmExpr w t
expr = WasmExpr w t
expr

-- | Lower an unary homogeneous operation.
lower_MO_Un_Homo ::
  ( forall pre t.
    WasmTypeTag t ->
    WasmInstr
      w
      (t : pre)
      (t : pre)
  ) ->
  CLabel ->
  CmmType ->
  [CmmExpr] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Homo :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
op CLabel
lbl CmmType
t0 [CmmExpr
x] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0 of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    pure $
      SomeWasmExpr ty $
        WasmExpr $
          x_instr `WasmConcat` op ty
lower_MO_Un_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Un_Homo: unreachable"

-- | 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 :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl CmmType
t0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0 of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
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 forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
    SomeWasmType WasmTypeTag t
ty -> do
      WasmExpr x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
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 forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
    SomeWasmType WasmTypeTag t
ty -> do
      WasmExpr x_instr <-
        Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (WasmExpr w t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
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 forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ =
  String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
    SomeWasmType WasmTypeTag t
ty -> do
      WasmExpr x_instr <-
        Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (WasmExpr w t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
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 forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op CLabel
lbl CmmType
t0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0 of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
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 forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
t1 CmmExpr
x = do
  SomeWasmExpr t0 (WasmExpr x_instr) <- CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
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 :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Shl CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
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 CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_U_Shr CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
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 CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_S_Shr CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr x_instr <- Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (WasmExpr w t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
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 CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_S_Shr: unreachable"

-- | Lower a 'MO_MulMayOflo' operation. It's translated to a ccall to
-- @hs_mulIntMayOflo@ function in @ghc-prim/cbits/mulIntMayOflo@,
-- otherwise it's quite non-trivial to implement as inline assembly.
lower_MO_MulMayOflo ::
  CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
ty_cmm of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    WasmExpr y_instr <- lower_CmmExpr_Typed lbl ty y
    onFuncSym "hs_mulIntMayOflo" [ty_cmm, ty_cmm] [ty_cmm]
    pure $
      SomeWasmExpr ty $
        WasmExpr $
          x_instr
            `WasmConcat` y_instr
            `WasmConcat` WasmCCall "hs_mulIntMayOflo"
  where
    ty_cmm :: CmmType
ty_cmm = Width -> CmmType
cmmBits Width
w0
lower_MO_MulMayOflo CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre)
op CLabel
lbl CmmType
t0 CmmType
t1 [CmmExpr
x] =
  case (# CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0, CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t1 #) of
    (# SomeWasmType WasmTypeTag t
ty0, SomeWasmType WasmTypeTag t
ty1 #) -> do
      WasmExpr x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty0 CmmExpr
x
      pure $ SomeWasmExpr ty1 $ WasmExpr $ x_instr `WasmConcat` op ty0 ty1
lower_MO_Un_Conv forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre)
_ CLabel
_ CmmType
_ CmmType
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
  | Width
w0 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
w1 = CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align]
  | Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
w1,
    Width
w1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W32 = do
      (WasmExpr ptr_instr, o) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
      pure $
        SomeWasmExpr TagI32 $
          truncSubword w1 TagI32 $
            WasmExpr $
              ptr_instr
                `WasmConcat` WasmLoad
                  TagI32
                  (wasmMemoryNarrowing TagI32 (cmmBits w0))
                  Signed
                  o
                  align
  | Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
w1 =
      WasmTypeTag 'I32 -> WasmExpr w 'I32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32
        (WasmExpr w 'I32 -> SomeWasmExpr w)
-> WasmCodeGenM w (WasmExpr w 'I32)
-> WasmCodeGenM w (SomeWasmExpr w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel
-> CmmExpr
-> WasmTypeTag 'I32
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed
          CLabel
lbl
          CmmExpr
ptr
          WasmTypeTag 'I32
TagI32
          (Width -> CmmType
cmmBits Width
w1)
          AlignmentSpec
align
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
W64 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align] = do
  (WasmExpr ptr_instr, o) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
  pure $
    SomeWasmExpr TagI64 $
      WasmExpr $
        ptr_instr
          `WasmConcat` WasmLoad
            TagI64
            (wasmMemoryNarrowing TagI64 (cmmBits w0))
            Signed
            o
            align
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
  | Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
w1,
    Width
w1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W32 = do
      x_expr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      pure $
        SomeWasmExpr TagI32 $
          truncSubword w1 TagI32 $
            extendSubword w0 TagI32 x_expr
  | Width
W32 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
>= Width
w0,
    Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
w1 = do
      x_expr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      pure $ SomeWasmExpr TagI32 $ truncSubword w1 TagI32 x_expr
lower_MO_SS_Conv CLabel
lbl Width
W32 Width
W64 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  pure $
    SomeWasmExpr TagI64 $
      WasmExpr $
        x_instr `WasmConcat` WasmI64ExtendI32 Signed
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
W64 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  pure $
    SomeWasmExpr TagI64 $
      extendSubword w0 TagI64 $
        WasmExpr $
          x_instr `WasmConcat` WasmI64ExtendI32 Unsigned
lower_MO_SS_Conv CLabel
lbl Width
W64 Width
w1 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'I64 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I64)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
  pure $
    SomeWasmExpr TagI32 $
      truncSubword w1 TagI32 $
        WasmExpr $
          x_instr `WasmConcat` WasmI32WrapI64
lower_MO_SS_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w1) of
    SomeWasmType WasmTypeTag t
ty ->
      WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty
        (WasmExpr w t -> SomeWasmExpr w)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (SomeWasmExpr w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed
          CLabel
lbl
          CmmExpr
ptr
          WasmTypeTag t
ty
          (Width -> CmmType
cmmBits (Width -> Width -> Width
forall a. Ord a => a -> a -> a
min Width
w0 Width
w1))
          AlignmentSpec
align
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
  | Width
w0 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
w1 = CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  | Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
w1, Width
w1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W32 = CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  | Width
W32 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
>= Width
w0,
    Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
w1 = do
      x_expr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      pure $ SomeWasmExpr TagI32 $ truncSubword w1 TagI32 x_expr
lower_MO_UU_Conv CLabel
lbl Width
_ Width
W64 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  pure $
    SomeWasmExpr TagI64 $
      WasmExpr $
        x_instr `WasmConcat` WasmI64ExtendI32 Unsigned
lower_MO_UU_Conv CLabel
lbl Width
W64 Width
w1 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'I64 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I64)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
  pure $
    SomeWasmExpr TagI32 $
      truncSubword w1 TagI32 $
        WasmExpr $
          x_instr `WasmConcat` WasmI32WrapI64
lower_MO_UU_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FF_Conv CLabel
lbl Width
W32 Width
W64 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'F32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'F32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F32
TagF32 CmmExpr
x
  pure $
    SomeWasmExpr TagF64 $
      WasmExpr $
        x_instr `WasmConcat` WasmF64PromoteF32
lower_MO_FF_Conv CLabel
lbl Width
W64 Width
W32 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'F64 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'F64)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F64
TagF64 CmmExpr
x
  pure $
    SomeWasmExpr TagF32 $
      WasmExpr $
        x_instr `WasmConcat` WasmF32DemoteF64
lower_MO_FF_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_FF_Conv: unreachable"


-- | Lower a 'MO_WF_Bitcast' operation. Note that this is not a conversion,
-- rather it reinterprets the data.
lower_MO_WF_Bitcast ::
  CLabel ->
  Width ->
  [CmmActual] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_WF_Bitcast :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_WF_Bitcast CLabel
lbl Width
W32 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  pure $
    SomeWasmExpr TagF32 $
      WasmExpr  $
        x_instr `WasmConcat` WasmReinterpret TagI32 TagF32
lower_MO_WF_Bitcast CLabel
lbl Width
W64 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'I64 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I64)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
  pure $
    SomeWasmExpr TagF64 $
      WasmExpr  $
        x_instr `WasmConcat` WasmReinterpret TagI64 TagF64
lower_MO_WF_Bitcast CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_WF_Bitcast: unreachable"

-- | Lower a 'MO_FW_Bitcast' operation. Note that this is not a conversion,
-- rather it reinterprets the data.
lower_MO_FW_Bitcast ::
  CLabel ->
  Width ->
  [CmmActual] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FW_Bitcast :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FW_Bitcast CLabel
lbl Width
W32 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'F32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'F32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F32
TagF32 CmmExpr
x
  pure $
    SomeWasmExpr TagI32 $
      WasmExpr  $
        x_instr `WasmConcat` WasmReinterpret TagF32 TagI32
lower_MO_FW_Bitcast CLabel
lbl Width
W64 [CmmExpr
x] = do
  WasmExpr x_instr <- CLabel
-> WasmTypeTag 'F64 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'F64)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F64
TagF64 CmmExpr
x
  pure $
    SomeWasmExpr TagI64 $
      WasmExpr  $
        x_instr `WasmConcat` WasmReinterpret TagF64 TagI64
lower_MO_FW_Bitcast CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_FW_Bitcast: unreachable"

-- | Lower a 'CmmMachOp'.
lower_CmmMachOp ::
  CLabel ->
  MachOp ->
  [CmmExpr] ->
  WasmCodeGenM
    w
    (SomeWasmExpr w)
lower_CmmMachOp :: forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp CLabel
lbl (MO_RelaxedRead Width
w0) [CmmExpr
x] = CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad CmmExpr
x (Width -> CmmType
cmmBits Width
w0) AlignmentSpec
NaturallyAligned)
lower_CmmMachOp CLabel
lbl (MO_Add Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Sub Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmSub CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Eq Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Ne Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmNe CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Mul Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmMul CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_MulMayOflo Width
w0) [CmmExpr]
xs = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Quot Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Rem Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmRem Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Neg Width
w0) [CmmExpr
x] =
  CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp
    CLabel
lbl
    (Width -> MachOp
MO_Sub Width
w0)
    [CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
w0, CmmExpr
x]
lower_CmmMachOp CLabel
lbl (MO_U_Quot Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Rem Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmRem Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Ge Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Le Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Gt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Lt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Ge Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Le Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Gt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Lt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Add Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Sub Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmSub
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Neg Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Homo
    WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : pre) (t : pre)
WasmNeg
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Mul Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmMul
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Quot Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Eq Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Ne Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmNe
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Ge Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Le Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Gt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Lt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Min Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmMin
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Max Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmMax
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_And Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Or Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmOr CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Xor Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmXor
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Not Width
w0) [CmmExpr
x] =
  CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp
    CLabel
lbl
    (Width -> MachOp
MO_Xor Width
w0)
    [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt (Width -> Integer
widthMax Width
w0) Width
w0]
lower_CmmMachOp CLabel
lbl (MO_Shl Width
w0) [CmmExpr]
xs = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Shl CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Shr Width
w0) [CmmExpr]
xs = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_U_Shr CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Shr Width
w0) [CmmExpr]
xs = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_S_Shr CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_SF_Round Width
w0 Width
w1) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv
    (Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr w (t0 : pre) (t1 : pre)
forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmConvert Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    (Width -> CmmType
cmmFloat Width
w1)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_FS_Truncate Width
w0 Width
w1) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv
    (Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr w (t0 : pre) (t1 : pre)
forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmTruncSat Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    (Width -> CmmType
cmmBits Width
w1)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_SS_Conv Width
w0 Width
w1) [CmmExpr]
xs = CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_UU_Conv Width
w0 Width
w1) [CmmExpr]
xs = CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_XX_Conv Width
w0 Width
w1) [CmmExpr]
xs = CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_FF_Conv Width
w0 Width
w1) [CmmExpr]
xs = CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FF_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_FW_Bitcast Width
w) [CmmExpr]
xs  = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FW_Bitcast CLabel
lbl Width
w [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_WF_Bitcast Width
w) [CmmExpr]
xs  = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_WF_Bitcast CLabel
lbl Width
w [CmmExpr]
xs
lower_CmmMachOp CLabel
_ MachOp
mop [CmmExpr]
_ =
  String -> SDoc -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lower_CmmMachOp: unreachable" (SDoc -> WasmCodeGenM w (SomeWasmExpr w))
-> SDoc -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"offending MachOp:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> MachOp -> SDoc
pprMachOp MachOp
mop ]

-- | 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 :: forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit CmmLit
lit = do
  ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  case lit of
    CmmInt Integer
i Width
w -> case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w) of
      SomeWasmType WasmTypeTag t
ty ->
        SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
          WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
            (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
              WasmTypeTag t -> Integer -> WasmInstr w pre (t : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty (Integer -> WasmInstr w pre (t : pre))
-> Integer -> WasmInstr w pre (t : pre)
forall a b. (a -> b) -> a -> b
$
                Width -> Integer -> Integer
narrowU Width
w Integer
i
    CmmFloat Rational
f Width
W32 ->
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag 'F32 -> WasmExpr w 'F32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F32
TagF32 (WasmExpr w 'F32 -> SomeWasmExpr w)
-> WasmExpr w 'F32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
-> WasmExpr w 'F32
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
 -> WasmExpr w 'F32)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
-> WasmExpr w 'F32
forall a b. (a -> b) -> a -> b
$
            WasmTypeTag 'I32 -> Integer -> WasmInstr w pre ('I32 : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
              WasmTypeTag 'I32
TagI32
              (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 (Float -> Word32) -> Float -> Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
f)
              WasmInstr w pre ('I32 : pre)
-> WasmInstr w ('I32 : pre) ('F32 : pre)
-> WasmInstr w pre ('F32 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag 'I32
-> WasmTypeTag 'F32 -> WasmInstr w ('I32 : pre) ('F32 : pre)
forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr a (t0 : pre) (t1 : pre)
WasmReinterpret WasmTypeTag 'I32
TagI32 WasmTypeTag 'F32
TagF32
    CmmFloat Rational
f Width
W64 ->
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag 'F64 -> WasmExpr w 'F64 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F64
TagF64 (WasmExpr w 'F64 -> SomeWasmExpr w)
-> WasmExpr w 'F64 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
-> WasmExpr w 'F64
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
 -> WasmExpr w 'F64)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
-> WasmExpr w 'F64
forall a b. (a -> b) -> a -> b
$
            WasmTypeTag 'I64 -> Integer -> WasmInstr w pre ('I64 : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
              WasmTypeTag 'I64
TagI64
              (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 (Double -> Word64) -> Double -> Word64
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
f)
              WasmInstr w pre ('I64 : pre)
-> WasmInstr w ('I64 : pre) ('F64 : pre)
-> WasmInstr w pre ('F64 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag 'I64
-> WasmTypeTag 'F64 -> WasmInstr w ('I64 : pre) ('F64 : pre)
forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr a (t0 : pre) (t1 : pre)
WasmReinterpret WasmTypeTag 'I64
TagI64 WasmTypeTag 'F64
TagF64
    CmmLabel CLabel
lbl' -> do
      CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl'
      let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl'
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$ SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
sym
    CmmLabelOff CLabel
lbl' Int
o -> do
      CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl'
      let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl'
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$
            SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
sym
              WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) (w : w : pre)
-> WasmInstr w pre (w : w : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag w -> Integer -> WasmInstr w (w : pre) (w : w : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag w
ty_word (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
o)
              WasmInstr w pre (w : w : pre)
-> WasmInstr w (w : w : pre) (w : pre) -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag w -> WasmInstr w (w : w : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd WasmTypeTag w
ty_word
    CmmBlock BlockId
bid -> CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit (CmmLit -> WasmCodeGenM w (SomeWasmExpr w))
-> CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
forall a b. (a -> b) -> a -> b
$ BlockId -> CLabel
infoTblLbl BlockId
bid
    CmmLit
_ -> String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
_ (CmmLocal LocalReg
reg) = do
  (reg_i, SomeWasmType ty) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  pure $ SomeWasmExpr ty $ WasmExpr $ WasmLocalGet ty reg_i
lower_CmmReg CLabel
lbl (CmmGlobal (GlobalRegUse GlobalReg
greg CmmType
reg_use_ty)) = do
  ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  ty_word_cmm <- wasmWordCmmTypeM
  case greg of
    GlobalReg
EagerBlackholeInfo ->
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$
            SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_EAGER_BLACKHOLE_info"
    GlobalReg
GCEnter1 -> do
      SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"__stg_gc_enter_1" [] [CmmType
ty_word_cmm]
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$ SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_gc_enter_1"
    GlobalReg
GCFun -> do
      SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"__stg_gc_fun" [] [CmmType
ty_word_cmm]
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$ SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_gc_fun"
    GlobalReg
BaseReg -> do
      platform <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
      lower_CmmExpr lbl $ regTableOffset platform 0
    GlobalReg
_other
      | Just (SymName
sym_global, SomeWasmType WasmTypeTag t
ty) <-
          WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
ty_word GlobalReg
greg ->
          SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> SymName -> WasmInstr w pre (t : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> SymName -> WasmInstr a b (t : b)
WasmGlobalGet WasmTypeTag t
ty SymName
sym_global
      | Bool
otherwise -> do
          platform <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
          case someWasmTypeFromCmmType reg_use_ty of
            SomeWasmType WasmTypeTag t
ty -> do
              (WasmExpr ptr_instr, o) <-
                CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl (CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int))
-> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall a b. (a -> b) -> a -> b
$
                  Platform -> GlobalReg -> CmmExpr
get_GlobalReg_addr Platform
platform GlobalReg
greg
              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 :: forall (w :: WasmType).
CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
0 = CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
o = do
  SomeWasmExpr ty (WasmExpr reg_instr) <- CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
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 :: forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed CLabel
lbl CmmExpr
ptr_expr WasmTypeTag t
ty CmmType
ty_cmm AlignmentSpec
align = do
  (WasmExpr ptr_instr, o) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
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 :: forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad CLabel
lbl CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
ty_cmm of
  SomeWasmType WasmTypeTag t
ty ->
    WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (SomeWasmExpr w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed CLabel
lbl CmmExpr
ptr_expr WasmTypeTag t
ty CmmType
ty_cmm AlignmentSpec
align

-- | Lower a 'CmmExpr'.
lower_CmmExpr :: CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr :: forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
expr = case CmmExpr
expr of
  CmmLit CmmLit
lit -> CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit CmmLit
lit
  CmmLoad CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align -> CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad CLabel
lbl CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align
  CmmReg CmmReg
reg -> CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
  CmmRegOff CmmReg
reg Int
o -> CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
o
  CmmMachOp MachOp
op [CmmExpr]
xs -> CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp CLabel
lbl MachOp
op [CmmExpr]
xs
  CmmExpr
_ -> String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
expr = do
  SomeWasmExpr ty' r <- CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
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 :: forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr = do
  ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  let (ptr', o) = case ptr of
        CmmLit (CmmLabelOff CLabel
lbl Int
o)
          | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> (CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl, Int
o)
        CmmRegOff CmmReg
reg Int
o
          | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> (CmmReg -> CmmExpr
CmmReg CmmReg
reg, Int
o)
        CmmMachOp (MO_Add Width
_) [CmmExpr
base, CmmLit (CmmInt Integer
o Width
_)]
          | Integer
o Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> (CmmExpr
base, Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
o)
        CmmExpr
_ -> (CmmExpr
ptr, Int
0)
  instrs <- lower_CmmExpr_Typed lbl ty_word ptr'
  pure (instrs, o)

-- | 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 :: forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
op [LocalReg
reg] [CmmExpr
x] = do
  (ri, SomeWasmType ty) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
  let ty_cmm = LocalReg -> CmmType
localRegType LocalReg
reg
  onFuncSym op [ty_cmm] [ty_cmm]
  pure $
    WasmStatements $
      x_instr `WasmConcat` WasmCCall op `WasmConcat` WasmLocalSet ty ri
lower_CMO_Un_Homo CLabel
_ SymName
_ [LocalReg]
_ [CmmExpr]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"lower_CMO_Un_Homo: 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 :: forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
op [LocalReg
reg] [CmmExpr
x, CmmExpr
y] = do
  (ri, SomeWasmType ty) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
  WasmExpr y_instr <- lower_CmmExpr_Typed lbl ty y
  let ty_cmm = LocalReg -> CmmType
localRegType LocalReg
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 CLabel
_ SymName
_ [LocalReg]
_ [CmmExpr]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_UF_Conv CLabel
lbl Width
W32 [LocalReg
reg] [CmmExpr
x] = do
  ri <- WasmTypeTag 'F32 -> LocalReg -> WasmCodeGenM w Int
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag 'F32
TagF32 LocalReg
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 CLabel
lbl Width
W64 [LocalReg
reg] [CmmExpr
x] = do
  ri <- WasmTypeTag 'F64 -> LocalReg -> WasmCodeGenM w Int
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag 'F64
TagF64 LocalReg
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 CLabel
_ Width
_ [LocalReg]
_ [CmmExpr]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_Cmpxchg CLabel
lbl Width
w0 [LocalReg
reg] [CmmExpr
ptr, CmmExpr
expected, CmmExpr
new] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
ty_cmm of
    SomeWasmType WasmTypeTag t
ty -> do
      reg_i <- WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg
      let narrowing = WasmTypeTag t -> CmmType -> Maybe Int
forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
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 :: CmmType
ty_cmm = Width -> CmmType
cmmBits Width
w0
lower_MO_Cmpxchg CLabel
_ Width
_ [LocalReg]
_ [CmmExpr]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Cmpxchg: unreachable"

-- | Lower a 'CallishMachOp'.
lower_CallishMachOp ::
  CLabel ->
  CallishMachOp ->
  [CmmFormal] ->
  [CmmActual] ->
  WasmCodeGenM w (WasmStatements w)
lower_CallishMachOp :: forall (w :: WasmType).
CLabel
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Pwr [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
"pow" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sin [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sin" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Cos [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cos" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Tan [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tan" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sinh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Cosh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cosh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Tanh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Asin [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asin" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Acos [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acos" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Atan [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atan" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Asinh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Acosh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acosh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Atanh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Log [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Log1P [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log1p" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Exp [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"exp" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_ExpM1 [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expm1" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Fabs [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"fabs" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sqrt [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sqrt" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Pwr [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
"powf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sin [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Cos [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cosf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Tan [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sinh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Cosh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"coshf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Tanh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Asin [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Acos [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acosf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Atan [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Asinh [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Acosh [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acoshf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Atanh [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Log [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"logf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Log1P [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log1pf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Exp [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_ExpM1 [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expm1f" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Fabs [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"fabsf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sqrt [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sqrtf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_UF_Conv Width
w0) [LocalReg]
rs [CmmExpr]
xs = CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_UF_Conv CLabel
lbl Width
w0 [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
_ CallishMachOp
MO_AcquireFence [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_ReleaseFence [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_SeqCstFence [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_Touch [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ (MO_Prefetch_Data {}) [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
lbl (MO_Memcpy {}) [] [CmmExpr]
xs = do
  ty_word_cmm <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  lower_CmmUnsafeForeignCall_Drop lbl "memcpy" ty_word_cmm xs
lower_CallishMachOp CLabel
lbl (MO_Memset {}) [] [CmmExpr]
xs = do
  ty_word_cmm <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  lower_CmmUnsafeForeignCall_Drop lbl "memset" ty_word_cmm xs
lower_CallishMachOp CLabel
lbl (MO_Memmove {}) [] [CmmExpr]
xs = do
  ty_word_cmm <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  lower_CmmUnsafeForeignCall_Drop lbl "memmove" ty_word_cmm xs
lower_CallishMachOp CLabel
lbl (MO_Memcmp {}) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left SymName
"memcmp")
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_PopCnt Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_popcnt" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Pdep Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_pdep" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Pext Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_pext" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Clz Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_clz" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Ctz Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_ctz" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_BSwap Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_bswap" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_BRev Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_bitrev" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_AtomicRMW Width
w0 AtomicMachOp
op) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    ( SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$
        String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$
          ( case AtomicMachOp
op of
              AtomicMachOp
AMO_Add -> String
"hs_atomic_add"
              AtomicMachOp
AMO_Sub -> String
"hs_atomic_sub"
              AtomicMachOp
AMO_And -> String
"hs_atomic_and"
              AtomicMachOp
AMO_Nand -> String
"hs_atomic_nand"
              AtomicMachOp
AMO_Or -> String
"hs_atomic_or"
              AtomicMachOp
AMO_Xor -> String
"hs_atomic_xor"
          )
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0)
    )
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_AtomicRead Width
w0 MemoryOrdering
_) [LocalReg
reg] [CmmExpr
ptr] = do
  SomeWasmExpr ty (WasmExpr ret_instr) <-
    CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad
      CLabel
lbl
      CmmExpr
ptr
      (Width -> CmmType
cmmBits Width
w0)
      AlignmentSpec
NaturallyAligned
  ri <- onCmmLocalReg_Typed ty reg
  pure $ WasmStatements $ ret_instr `WasmConcat` WasmLocalSet ty ri
lower_CallishMachOp CLabel
lbl (MO_AtomicWrite Width
_ MemoryOrdering
_) [] [CmmExpr
ptr, CmmExpr
val] =
  CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
lower_CmmStore CLabel
lbl CmmExpr
ptr CmmExpr
val AlignmentSpec
NaturallyAligned
lower_CallishMachOp CLabel
lbl (MO_Cmpxchg Width
w0) [LocalReg]
rs [CmmExpr]
xs = CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_Cmpxchg CLabel
lbl Width
w0 [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Xchg Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_xchg" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_SuspendThread [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left SymName
"suspendThread")
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_ResumeThread [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left SymName
"resumeThread")
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
_ CallishMachOp
_ [LocalReg]
_ [CmmExpr]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"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 :: forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
sym_callee CmmType
ret_cmm_ty [CmmExpr]
arg_exprs = do
  ret_uniq <- WasmCodeGenM w Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM
  let ret_local = Unique -> CmmType -> LocalReg
LocalReg Unique
ret_uniq CmmType
ret_cmm_ty
  lower_CmmUnsafeForeignCall
    lbl
    (Left sym_callee)
    Nothing
    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) ->
  Maybe
    ([ForeignHint], [ForeignHint]) ->
  CmmReturnInfo ->
  [CmmFormal] ->
  [CmmActual] ->
  WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall :: forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall CLabel
lbl Either SymName CmmExpr
target Maybe ([ForeignHint], [ForeignHint])
mb_hints CmmReturnInfo
ret_info [LocalReg]
ret_locals [CmmExpr]
arg_exprs = do
  platform <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  SomeWasmPreCCall arg_tys args_instr <-
    foldrM
      ( \(CmmExpr
arg_expr, ForeignHint
arg_hint) (SomeWasmPreCCall TypeList ts
acc_tys forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
acc_instr) -> do
          SomeWasmExpr arg_ty arg_wasm_expr <- CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
arg_expr
          let WasmExpr arg_instr = case arg_hint of
                ForeignHint
SignedHint ->
                  Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword
                    (Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
arg_expr)
                    WasmTypeTag t
arg_ty
                    WasmExpr w t
arg_wasm_expr
                ForeignHint
_ -> WasmExpr w t
arg_wasm_expr
          pure $
            SomeWasmPreCCall (arg_ty `TypeListCons` acc_tys) $
              arg_instr `WasmConcat` acc_instr
      )
      (SomeWasmPreCCall TypeListNil WasmNop)
      arg_exprs_hints
  SomeWasmPostCCall ret_tys ret_instr <-
    foldrM
      ( \(LocalReg
reg, ForeignHint
ret_hint) (SomeWasmPostCCall TypeList ts
acc_tys forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr) -> do
          (reg_i, SomeWasmType reg_ty) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
          pure $
            SomeWasmPostCCall (reg_ty `TypeListCons` acc_tys) $
              case (# ret_hint, cmmRegWidth $ CmmLocal reg #) of
                (# ForeignHint
SignedHint, Width
W8 #) ->
                  WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr
                    WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) (t : t : post)
-> WasmInstr w (WasmPushes ts (t : post)) (t : t : post)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Integer -> WasmInstr w (t : post) (t : t : post)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
reg_ty Integer
0xFF
                    WasmInstr w (WasmPushes ts (t : post)) (t : t : post)
-> WasmInstr w (t : t : post) (t : post)
-> WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : post) (t : post)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
reg_ty
                    WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) post
-> WasmInstr w (WasmPushes ts (t : post)) post
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : post) post
forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
                (# ForeignHint
SignedHint, Width
W16 #) ->
                  WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr
                    WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) (t : t : post)
-> WasmInstr w (WasmPushes ts (t : post)) (t : t : post)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Integer -> WasmInstr w (t : post) (t : t : post)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
reg_ty Integer
0xFFFF
                    WasmInstr w (WasmPushes ts (t : post)) (t : t : post)
-> WasmInstr w (t : t : post) (t : post)
-> WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : post) (t : post)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
reg_ty
                    WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) post
-> WasmInstr w (WasmPushes ts (t : post)) post
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : post) post
forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
                (# ForeignHint, Width #)
_ -> WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) post
-> WasmInstr w (WasmPushes ts (t : post)) post
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : post) post
forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
      )
      (SomeWasmPostCCall TypeListNil WasmNop)
      ret_locals_hints
  case target of
    Left SymName
sym_callee -> do
      platform <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
      let arg_cmm_tys = (CmmExpr -> CmmType) -> [CmmExpr] -> [CmmType]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) [CmmExpr]
arg_exprs
          ret_cmm_tys = (LocalReg -> CmmType) -> [LocalReg] -> [CmmType]
forall a b. (a -> b) -> [a] -> [b]
map LocalReg -> CmmType
localRegType [LocalReg]
ret_locals
      onFuncSym sym_callee arg_cmm_tys ret_cmm_tys
      pure $
        WasmStatements $
          args_instr
            `WasmConcat` WasmCCall sym_callee
            `WasmConcat` ( case ret_info of
                             CmmReturnInfo
CmmMayReturn -> WasmInstr w (WasmPushes ts pre) pre
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr
                             CmmReturnInfo
CmmNeverReturns -> WasmInstr w (WasmPushes ts pre) pre
forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
WasmInstr a b c
WasmUnreachable
                         )
    Right CmmExpr
fptr_callee -> do
      (WasmExpr instr_callee, _) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
fptr_callee
      pure $
        WasmStatements $
          args_instr
            `WasmConcat` instr_callee
            `WasmConcat` WasmCCallIndirect arg_tys ret_tys
            `WasmConcat` ( case ret_info of
                             CmmReturnInfo
CmmMayReturn -> WasmInstr w (WasmPushes ts pre) pre
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr
                             CmmReturnInfo
CmmNeverReturns -> WasmInstr w (WasmPushes ts pre) pre
forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
WasmInstr a b c
WasmUnreachable
                         )
  where
    (# [(CmmExpr, ForeignHint)]
arg_exprs_hints, [(LocalReg, ForeignHint)]
ret_locals_hints #) = case Maybe ([ForeignHint], [ForeignHint])
mb_hints of
      Just ([ForeignHint]
arg_hints, [ForeignHint]
ret_hints) ->
        (# [CmmExpr] -> [ForeignHint] -> [(CmmExpr, ForeignHint)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CmmExpr]
arg_exprs [ForeignHint]
arg_hints, [LocalReg] -> [ForeignHint] -> [(LocalReg, ForeignHint)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LocalReg]
ret_locals [ForeignHint]
ret_hints #)
      Maybe ([ForeignHint], [ForeignHint])
_ -> (# (CmmExpr -> (CmmExpr, ForeignHint))
-> [CmmExpr] -> [(CmmExpr, ForeignHint)]
forall a b. (a -> b) -> [a] -> [b]
map (,ForeignHint
NoHint) [CmmExpr]
arg_exprs, (LocalReg -> (LocalReg, ForeignHint))
-> [LocalReg] -> [(LocalReg, ForeignHint)]
forall a b. (a -> b) -> [a] -> [b]
map (,ForeignHint
NoHint) [LocalReg]
ret_locals #)

-- | Lower a 'CmmStore'.
lower_CmmStore ::
  CLabel ->
  CmmExpr ->
  CmmExpr ->
  AlignmentSpec ->
  WasmCodeGenM
    w
    (WasmStatements w)
lower_CmmStore :: forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
lower_CmmStore CLabel
lbl CmmExpr
ptr CmmExpr
val AlignmentSpec
align = do
  platform <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  (WasmExpr ptr_instr, o) <- lower_CmmExpr_Ptr lbl ptr
  let ty_cmm = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
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 :: forall (w :: WasmType).
CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w)
lower_CmmAction CLabel
lbl CmmNode O O
act = do
  ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  platform <- wasmPlatformM
  case act of
    CmmComment {} -> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
    CmmTick {} -> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
    CmmUnwind {} -> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
    CmmAssign (CmmLocal LocalReg
reg) CmmExpr
e -> do
      (i, SomeWasmType ty_reg) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
      WasmExpr instrs <- lower_CmmExpr_Typed lbl ty_reg e
      pure $ WasmStatements $ instrs `WasmConcat` WasmLocalSet ty_reg i
    CmmAssign (CmmGlobal (GlobalRegUse GlobalReg
reg CmmType
_)) CmmExpr
e
      | GlobalReg
BaseReg <- GlobalReg
reg -> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
      | Just (SymName
sym_global, SomeWasmType WasmTypeTag t
ty_reg) <-
          WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
ty_word GlobalReg
reg -> do
          WasmExpr instrs <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty_reg CmmExpr
e
          pure $
            WasmStatements $
              instrs `WasmConcat` WasmGlobalSet ty_reg sym_global
      | Bool
otherwise -> do
          (WasmExpr ptr_instr, o) <-
            CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl (CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int))
-> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall a b. (a -> b) -> a -> b
$ Platform -> GlobalReg -> CmmExpr
get_GlobalReg_addr Platform
platform GlobalReg
reg
          SomeWasmExpr ty_e (WasmExpr instrs) <- lower_CmmExpr lbl e
          pure $
            WasmStatements $
              ptr_instr
                `WasmConcat` instrs
                `WasmConcat` WasmStore ty_e Nothing o NaturallyAligned
    CmmStore CmmExpr
ptr CmmExpr
val AlignmentSpec
align -> CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
lower_CmmStore CLabel
lbl CmmExpr
ptr CmmExpr
val AlignmentSpec
align
    CmmUnsafeForeignCall
      ( ForeignTarget
          (CmmLit (CmmLabel CLabel
lbl_callee))
          (ForeignConvention CCallConv
conv [ForeignHint]
arg_hints [ForeignHint]
ret_hints CmmReturnInfo
ret_info)
        )
      [LocalReg]
ret_locals
      [CmmExpr]
arg_exprs
        | CCallConv
conv CCallConv -> [CCallConv] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CCallConv
CCallConv, CCallConv
CApiConv] ->
            CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
              CLabel
lbl
              (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> SymName
symNameFromCLabel CLabel
lbl_callee)
              (([ForeignHint], [ForeignHint])
-> Maybe ([ForeignHint], [ForeignHint])
forall a. a -> Maybe a
Just ([ForeignHint]
arg_hints, [ForeignHint]
ret_hints))
              CmmReturnInfo
ret_info
              [LocalReg]
ret_locals
              [CmmExpr]
arg_exprs
    CmmUnsafeForeignCall
      (ForeignTarget CmmExpr
target_expr (ForeignConvention CCallConv
conv [ForeignHint]
arg_hints [ForeignHint]
ret_hints CmmReturnInfo
ret_info))
      [LocalReg]
ret_locals
      [CmmExpr]
arg_exprs
        | CCallConv
conv CCallConv -> [CCallConv] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CCallConv
CCallConv, CCallConv
CApiConv] ->
            CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
              CLabel
lbl
              (CmmExpr -> Either SymName CmmExpr
forall a b. b -> Either a b
Right CmmExpr
target_expr)
              (([ForeignHint], [ForeignHint])
-> Maybe ([ForeignHint], [ForeignHint])
forall a. a -> Maybe a
Just ([ForeignHint]
arg_hints, [ForeignHint]
ret_hints))
              CmmReturnInfo
ret_info
              [LocalReg]
ret_locals
              [CmmExpr]
arg_exprs
    CmmUnsafeForeignCall (PrimTarget CallishMachOp
op) [LocalReg]
ret_locals [CmmExpr]
arg_exprs ->
      CLabel
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CallishMachOp CLabel
lbl CallishMachOp
op [LocalReg]
ret_locals [CmmExpr]
arg_exprs
    CmmNode O O
_ -> String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"lower_CmmAction: unreachable"

-- | Lower a block of Cmm actions.
lower_CmmActions ::
  CLabel ->
  Label ->
  Block CmmNode O O ->
  WasmCodeGenM
    w
    (WasmStatements w)
lower_CmmActions :: forall (w :: WasmType).
CLabel
-> BlockId
-> Block CmmNode O O
-> WasmCodeGenM w (WasmStatements w)
lower_CmmActions CLabel
lbl BlockId
_ Block CmmNode O O
blk =
  (WasmStatements w
 -> CmmNode O O -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w
-> [CmmNode O O]
-> WasmCodeGenM w (WasmStatements w)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
    ( \(WasmStatements forall (pre :: [WasmType]). WasmInstr w pre pre
acc) CmmNode O O
act ->
        (\(WasmStatements forall (pre :: [WasmType]). WasmInstr w pre pre
stmts) -> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
acc WasmInstr w pre pre -> WasmInstr w pre pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
stmts)
          (WasmStatements w -> WasmStatements w)
-> WasmCodeGenM w (WasmStatements w)
-> WasmCodeGenM w (WasmStatements w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w)
lower_CmmAction CLabel
lbl CmmNode O O
act
    )
    ((forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop)
    [CmmNode O O]
acts
  where
    acts :: [CmmNode O O]
acts = Block CmmNode O O -> [CmmNode O O]
forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
blk

-- | Lower a 'CmmGraph'.
lower_CmmGraph :: CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph :: forall (w :: WasmType).
CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph CLabel
lbl CmmGraph
g = do
  ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  platform <- wasmPlatformM
  body <-
    structuredControl
      platform
      (\BlockId
_ -> CLabel -> WasmTypeTag w -> CmmExpr -> WasmCodeGenM w (WasmExpr w w)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word)
      (lower_CmmActions lbl)
      g
  locals <- wasmStateM $ \WasmCodeGenState w
s ->
    (#
      ((Int, SomeWasmType) -> SomeWasmType)
-> [(Int, SomeWasmType)] -> [SomeWasmType]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SomeWasmType) -> SomeWasmType
forall a b. (a, b) -> b
snd ([(Int, SomeWasmType)] -> [SomeWasmType])
-> [(Int, SomeWasmType)] -> [SomeWasmType]
forall a b. (a -> b) -> a -> b
$ UniqFM LocalReg (Int, SomeWasmType) -> [(Int, SomeWasmType)]
forall {k1} k2 (k0 :: k1) a.
Ord k2 =>
UniqFM k0 (k2, a) -> [(k2, a)]
detEltsUFM (UniqFM LocalReg (Int, SomeWasmType) -> [(Int, SomeWasmType)])
-> UniqFM LocalReg (Int, SomeWasmType) -> [(Int, SomeWasmType)]
forall a b. (a -> b) -> a -> b
$ WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegs WasmCodeGenState w
s,
      WasmCodeGenState w
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 :: forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onTopSym CLabel
lbl = case SymVisibility
sym_vis of
  SymVisibility
SymDefault -> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM ((WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ())
-> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
    WasmCodeGenState w
s
      { defaultSyms =
          insertUniqueSet
            (getUnique sym)
            $ defaultSyms s
      }
  SymVisibility
_ -> () -> WasmCodeGenM w ()
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl

    sym_vis :: SymVisibility
sym_vis = CLabel -> SymVisibility
symVisibilityFromCLabel CLabel
lbl

-- | Invoked for each function 'CLabel' with known type (e.g. a
-- 'CmmProc', or callee of 'CmmUnsafeForeignCall').
onFuncSym :: SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym :: forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
sym [CmmType]
arg_tys [CmmType]
ret_tys = (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM ((WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ())
-> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$
  \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
UniqFM LocalReg (Int, SomeWasmType)
DUniqSupply
UniqueSet
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
Platform
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> UniqueSet
wasmPlatform :: Platform
defaultSyms :: UniqueSet
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: SymMap (FuncBody w)
dataSections :: SymMap DataSection
ctors :: [SymName]
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: Int
wasmDUniqSupply :: DUniqSupply
wasmDUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> DUniqSupply
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
..} ->
    WasmCodeGenState w
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 :: forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl = case SymKind
sym_kind of
  SymKind
SymFunc -> do
    ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
    wasmModifyM $ \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
UniqFM LocalReg (Int, SomeWasmType)
DUniqSupply
UniqueSet
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
Platform
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> UniqueSet
wasmDUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> DUniqSupply
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
wasmPlatform :: Platform
defaultSyms :: UniqueSet
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: SymMap (FuncBody w)
dataSections :: SymMap DataSection
ctors :: [SymName]
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: Int
wasmDUniqSupply :: DUniqSupply
..} ->
      WasmCodeGenState w
s {funcTypes = addToUniqMap_C const funcTypes sym ([], [SomeWasmType ty_word])}
  SymKind
_ -> () -> WasmCodeGenM w ()
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl

    sym_kind :: SymKind
sym_kind = CLabel -> SymKind
symKindFromCLabel CLabel
lbl

-- | Invoked for each 'LocalReg', returning its wasm local id and
-- representation type.
onCmmLocalReg :: LocalReg -> WasmCodeGenM w LocalInfo
onCmmLocalReg :: forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg = (WasmCodeGenState w
 -> (# (Int, SomeWasmType), WasmCodeGenState w #))
-> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM ((WasmCodeGenState w
  -> (# (Int, SomeWasmType), WasmCodeGenState w #))
 -> WasmCodeGenM w (Int, SomeWasmType))
-> (WasmCodeGenState w
    -> (# (Int, SomeWasmType), WasmCodeGenState w #))
-> WasmCodeGenM w (Int, SomeWasmType)
forall a b. (a -> b) -> a -> b
$ \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
UniqFM LocalReg (Int, SomeWasmType)
DUniqSupply
UniqueSet
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
Platform
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> UniqueSet
wasmDUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> DUniqSupply
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
wasmPlatform :: Platform
defaultSyms :: UniqueSet
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: SymMap (FuncBody w)
dataSections :: SymMap DataSection
ctors :: [SymName]
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: Int
wasmDUniqSupply :: DUniqSupply
..} ->
  let reg_info :: (Int, SomeWasmType)
reg_info =
        (Int
localRegsCount, CmmType -> SomeWasmType
someWasmTypeFromCmmType (CmmType -> SomeWasmType) -> CmmType -> SomeWasmType
forall a b. (a -> b) -> a -> b
$ LocalReg -> CmmType
localRegType LocalReg
reg)
   in case (LocalReg
 -> (Int, SomeWasmType)
 -> (Int, SomeWasmType)
 -> (Int, SomeWasmType))
-> LocalReg
-> (Int, SomeWasmType)
-> UniqFM LocalReg (Int, SomeWasmType)
-> (Maybe (Int, SomeWasmType), UniqFM LocalReg (Int, SomeWasmType))
forall key elt.
Uniquable key =>
(key -> elt -> elt -> elt)
-> key -> elt -> UniqFM key elt -> (Maybe elt, UniqFM key elt)
addToUFM_L (\LocalReg
_ (Int, SomeWasmType)
i (Int, SomeWasmType)
_ -> (Int, SomeWasmType)
i) LocalReg
reg (Int, SomeWasmType)
reg_info UniqFM LocalReg (Int, SomeWasmType)
localRegs of
        (Just (Int, SomeWasmType)
i, UniqFM LocalReg (Int, SomeWasmType)
_) -> (# (Int, SomeWasmType)
i, WasmCodeGenState w
s #)
        (Maybe (Int, SomeWasmType)
_, UniqFM LocalReg (Int, SomeWasmType)
localRegs') ->
          (#
            (Int, SomeWasmType)
reg_info,
            WasmCodeGenState w
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 :: forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg = do
  (i, SomeWasmType ty') <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
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 :: forall (w :: WasmType). [SymName] -> WasmCodeGenM w ()
onFini [SymName]
syms = do
  let n_finis :: Int
n_finis = [SymName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SymName]
syms
  Bool -> WasmCodeGenM w () -> WasmCodeGenM w ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n_finis Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (WasmCodeGenM w () -> WasmCodeGenM w ())
-> WasmCodeGenM w () -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ String -> WasmCodeGenM w ()
forall a. HasCallStack => String -> a
panic String
"dtors unsupported by wasm32 NCG"

-- | Invoked for ctors and dtors.
onCmmInitFini :: InitOrFini -> [CLabel] -> WasmCodeGenM w ()
onCmmInitFini :: forall (w :: WasmType). InitOrFini -> [CLabel] -> WasmCodeGenM w ()
onCmmInitFini InitOrFini
iof [CLabel]
lbls = do
  [CLabel] -> (CLabel -> WasmCodeGenM w ()) -> WasmCodeGenM w ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [CLabel]
lbls ((CLabel -> WasmCodeGenM w ()) -> WasmCodeGenM w ())
-> (CLabel -> WasmCodeGenM w ()) -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ \CLabel
lbl -> SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym (CLabel -> SymName
symNameFromCLabel CLabel
lbl) [] []
  case InitOrFini
iof of
    InitOrFini
IsInitArray -> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM ((WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ())
-> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s -> WasmCodeGenState w
s {ctors = syms <> ctors s}
    InitOrFini
IsFiniArray -> [SymName] -> WasmCodeGenM w ()
forall (w :: WasmType). [SymName] -> WasmCodeGenM w ()
onFini [SymName]
syms
  where
    syms :: [SymName]
syms = (CLabel -> SymName) -> [CLabel] -> [SymName]
forall a b. (a -> b) -> [a] -> [b]
map CLabel -> SymName
symNameFromCLabel [CLabel]
lbls

-- | Invoked for each data section.
onCmmData :: CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData :: forall (w :: WasmType).
CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData CLabel
lbl Section
s [CmmStatic]
statics = do
  ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  onTopSym lbl
  cs <- for statics lower_CmmStatic
  let sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl
      sec =
        DataSection
          { dataSectionKind :: DataSectionKind
dataSectionKind =
              Section -> DataSectionKind
dataSectionKindFromCmmSection Section
s,
            dataSectionAlignment :: Alignment
dataSectionAlignment =
              WasmTypeTag w -> [DataSectionContent] -> Alignment
forall (w :: WasmType).
WasmTypeTag w -> [DataSectionContent] -> Alignment
alignmentFromCmmSection WasmTypeTag w
ty_word [DataSectionContent]
cs,
            dataSectionContents :: [DataSectionContent]
dataSectionContents =
              case [DataSectionContent]
cs of
                [DataASCII ByteString
buf] -> [ByteString -> DataSectionContent
DataASCII (ByteString -> DataSectionContent)
-> ByteString -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ ByteString
buf ByteString -> Word8 -> ByteString
`BS.snoc` Word8
0]
                [DataIncBin String
p Int
l] -> [String -> Int -> DataSectionContent
DataIncBin String
p Int
l, Word8 -> DataSectionContent
DataI8 Word8
0]
                [DataSectionContent]
_ -> [DataSectionContent]
cs
          }
  wasmModifyM $ \WasmCodeGenState w
s ->
    WasmCodeGenState w
s
      { dataSections =
          addToUniqMap (dataSections s) sym sec
      }

-- | Invoked for each 'CmmProc'.
onCmmProc :: CLabel -> CmmGraph -> WasmCodeGenM w ()
onCmmProc :: forall (w :: WasmType). CLabel -> CmmGraph -> WasmCodeGenM w ()
onCmmProc CLabel
lbl CmmGraph
g = do
  ty_word <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  onTopSym lbl
  onFuncSym sym [] [ty_word]
  body <- lower_CmmGraph lbl g
  wasmModifyM $ \WasmCodeGenState w
s -> WasmCodeGenState w
s {funcBodies = addToUniqMap (funcBodies s) sym body}
  where
    sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl

-- | Invoked for each 'RawCmmDecl'.
onCmmDecl :: RawCmmDecl -> WasmCodeGenM w ()
onCmmDecl :: forall (w :: WasmType). RawCmmDecl -> WasmCodeGenM w ()
onCmmDecl RawCmmDecl
decl
  | Just (InitOrFini
iof, [CLabel]
lbls) <- RawCmmDecl -> Maybe (InitOrFini, [CLabel])
isInitOrFiniArray RawCmmDecl
decl = InitOrFini -> [CLabel] -> WasmCodeGenM w ()
forall (w :: WasmType). InitOrFini -> [CLabel] -> WasmCodeGenM w ()
onCmmInitFini InitOrFini
iof [CLabel]
lbls
onCmmDecl (CmmData Section
s (CmmStaticsRaw CLabel
lbl [CmmStatic]
statics)) = CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
forall (w :: WasmType).
CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData CLabel
lbl Section
s [CmmStatic]
statics
onCmmDecl (CmmProc LabelMap (GenCmmStatics 'True)
_ CLabel
lbl [GlobalRegUse]
_ CmmGraph
g) = CLabel -> CmmGraph -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> CmmGraph -> WasmCodeGenM w ()
onCmmProc CLabel
lbl CmmGraph
g

-- | Invoked for each 'RawCmmGroup'.
onCmmGroup :: RawCmmGroup -> WasmCodeGenM w ()
onCmmGroup :: forall (w :: WasmType). RawCmmGroup -> WasmCodeGenM w ()
onCmmGroup RawCmmGroup
cmms = (WasmCodeGenState w -> (# (), WasmCodeGenState w #))
-> WasmCodeGenM w ()
forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM ((WasmCodeGenState w -> (# (), WasmCodeGenState w #))
 -> WasmCodeGenM w ())
-> (WasmCodeGenState w -> (# (), WasmCodeGenState w #))
-> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s0 ->
  (# (), (WasmCodeGenState w -> RawCmmDecl -> WasmCodeGenState w)
-> WasmCodeGenState w -> RawCmmGroup -> WasmCodeGenState w
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\WasmCodeGenState w
s RawCmmDecl
cmm -> WasmCodeGenM w () -> WasmCodeGenState w -> WasmCodeGenState w
forall (w :: WasmType) a.
WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w
wasmExecM (RawCmmDecl -> WasmCodeGenM w ()
forall (w :: WasmType). RawCmmDecl -> WasmCodeGenM w ()
onCmmDecl RawCmmDecl
cmm) WasmCodeGenState w
s) WasmCodeGenState w
s0 RawCmmGroup
cmms #)