{-# 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 qualified Data.IntSet as IS
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.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 = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType -> Bool
isWord64 CmmType
t = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I64
TagI64
  | CmmType
t CmmType -> CmmType -> Bool
`cmmEqType` CmmType
b16 = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType
t CmmType -> CmmType -> Bool
`cmmEqType` CmmType
b8 = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType -> Bool
isFloat64 CmmType
t = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F64
TagF64
  | CmmType -> Bool
isFloat32 CmmType
t = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F32
TagF32
  | Bool
otherwise =
      forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$
        String
"someWasmTypeFromCmmType: unsupported CmmType "
          forall a. Semigroup a => a -> a -> a
<> SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext (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 #) -> forall a. a -> Maybe a
Just Int
8
  (# WasmTypeTag t
TagI32, Width
W16 #) -> forall a. a -> Maybe a
Just Int
16
  (# WasmTypeTag t
TagI32, Width
W32 #) -> forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagI64, Width
W8 #) -> forall a. a -> Maybe a
Just Int
8
  (# WasmTypeTag t
TagI64, Width
W16 #) -> forall a. a -> Maybe a
Just Int
16
  (# WasmTypeTag t
TagI64, Width
W32 #) -> forall a. a -> Maybe a
Just Int
32
  (# WasmTypeTag t
TagI64, Width
W64 #) -> forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagF32, Width
W32 #) -> forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagF64, Width
W64 #) -> forall a. Maybe a
Nothing
  (# WasmTypeTag t, Width #)
_ -> 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 =
  forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$
    SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext {sdocStyle :: PprStyle
sdocStyle = PprStyle
PprCode} forall a b. (a -> b) -> a -> b
$
      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
_ = 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]
_ = 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) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word8 -> DataSectionContent
DataI8 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W8 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W16) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word16 -> DataSectionContent
DataI16 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W16 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W32) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> DataSectionContent
DataI32 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W32 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W64) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word64 -> DataSectionContent
DataI64 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W64 Integer
i
  CmmStaticLit (CmmFloat Rational
f Width
W32) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Float -> DataSectionContent
DataF32 forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
f
  CmmStaticLit (CmmFloat Rational
d Width
W64) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> DataSectionContent
DataF64 forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
d
  CmmStaticLit (CmmLabel CLabel
lbl) ->
    forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl
      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) ->
    forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl
      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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> DataSectionContent
DataSkip Int
i
  CmmString ByteString
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> DataSectionContent
DataASCII ByteString
b
  CmmFileEmbed String
f Int
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Int -> DataSectionContent
DataIncBin String
f Int
l
  CmmStatic
_ -> 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 VGcPtr
_
    | Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
10 -> forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"__R" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i, SomeWasmType
ty_word)
  FloatReg Int
i
    | Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
6 ->
        forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"__F" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i, forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F32
TagF32)
  DoubleReg Int
i
    | Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
6 ->
        forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"__D" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i, forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F64
TagF64)
  LongReg Int
i
    | Int
i forall a. Eq a => a -> a -> Bool
== Int
1 -> forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"__L" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i, forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I64
TagI64)
  GlobalReg
Sp -> forall a. a -> Maybe a
Just (SymName
"__Sp", SomeWasmType
ty_word)
  GlobalReg
SpLim -> forall a. a -> Maybe a
Just (SymName
"__SpLim", SomeWasmType
ty_word)
  GlobalReg
Hp -> forall a. a -> Maybe a
Just (SymName
"__Hp", SomeWasmType
ty_word)
  GlobalReg
HpLim -> forall a. a -> Maybe a
Just (SymName
"__HpLim", SomeWasmType
ty_word)
  GlobalReg
_ -> forall a. Maybe a
Nothing
  where
    ty_word :: SomeWasmType
ty_word = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag w
t

supportedCmmGlobalRegs :: [GlobalReg]
supportedCmmGlobalRegs :: [GlobalReg]
supportedCmmGlobalRegs =
  [Int -> VGcPtr -> GlobalReg
VanillaReg Int
i VGcPtr
VGcPtr | Int
i <- [Int
1 .. Int
10]]
    forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
FloatReg Int
i | Int
i <- [Int
1 .. Int
6]]
    forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
DoubleReg Int
i | Int
i <- [Int
1 .. Int
6]]
    forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
LongReg Int
i | Int
i <- [Int
1 .. Int
1]]
    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 (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty Integer
0xFF forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty Integer
0xFFFF forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
op WasmTypeTag t
ty
lower_MO_Un_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
          forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
            forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
              forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Homo_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <-
        forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <-
        forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
          forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
            forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
              forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Homo_Ext_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ =
  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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <-
        forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <-
        forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
      WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$
          forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
            forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Rel_Ext forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Rel forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = 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 WasmTypeTag t
t0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  if
      | Just t :~: t
Refl <- WasmTypeTag t
t0 forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
t1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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)
x_instr
      | WasmTypeTag t
TagI32 <- WasmTypeTag t
t0,
        WasmTypeTag t
TagI64 <- WasmTypeTag t
t1 ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Unsigned
      | Bool
otherwise -> forall a. HasCallStack => String -> a
panic String
"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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
          forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
            forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShl WasmTypeTag t
ty
lower_MO_Shl CLabel
_ Width
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShr Signage
Unsigned WasmTypeTag t
ty
lower_MO_U_Shr CLabel
_ Width
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
          forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
            forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShr Signage
Signed WasmTypeTag t
ty
lower_MO_S_Shr CLabel
_ Width
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"hs_mulIntMayOflo" [CmmType
ty_cmm, CmmType
ty_cmm] [CmmType
ty_cmm]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
"hs_mulIntMayOflo"
  where
    ty_cmm :: CmmType
ty_cmm = Width -> CmmType
cmmBits Width
w0
lower_MO_MulMayOflo CLabel
_ Width
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty0 CmmExpr
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty1 forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre)
op WasmTypeTag t
ty0 WasmTypeTag t
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]
_ = 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 forall a. Eq a => a -> a -> Bool
== Width
w1 = 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 forall a. Ord a => a -> a -> Bool
< Width
w1,
    Width
w1 forall a. Ord a => a -> a -> Bool
<= Width
W32 = do
      (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
          forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
            forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
              forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
                forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
                  WasmTypeTag 'I32
TagI32
                  (forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag 'I32
TagI32 (Width -> CmmType
cmmBits Width
w0))
                  Signage
Signed
                  Int
o
                  AlignmentSpec
align
  | Width
w0 forall a. Ord a => a -> a -> Bool
> Width
w1 =
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
      forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
        forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
          forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
            WasmTypeTag 'I64
TagI64
            (forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag 'I64
TagI64 (Width -> CmmType
cmmBits Width
w0))
            Signage
Signed
            Int
o
            AlignmentSpec
align
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
  | Width
w0 forall a. Ord a => a -> a -> Bool
< Width
w1,
    Width
w1 forall a. Ord a => a -> a -> Bool
<= Width
W32 = do
      WasmExpr w 'I32
x_expr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
          forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
            forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag 'I32
TagI32 WasmExpr w 'I32
x_expr
  | Width
W32 forall a. Ord a => a -> a -> Bool
>= Width
w0,
    Width
w0 forall a. Ord a => a -> a -> Bool
> Width
w1 = do
      WasmExpr w 'I32
x_expr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 WasmExpr w 'I32
x_expr
lower_MO_SS_Conv CLabel
lbl Width
W32 Width
W64 [CmmExpr
x] = do
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
      forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
        forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Signed
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
W64 [CmmExpr
x] = do
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Unsigned
lower_MO_SS_Conv CLabel
lbl Width
W64 Width
w1 [CmmExpr
x] = do
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I32 : pre)
WasmI32WrapI64
lower_MO_SS_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = 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 ->
      forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (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 forall a. Eq a => a -> a -> Bool
== Width
w1 = forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  | Width
w0 forall a. Ord a => a -> a -> Bool
< Width
w1, Width
w1 forall a. Ord a => a -> a -> Bool
<= Width
W32 = forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  | Width
W32 forall a. Ord a => a -> a -> Bool
>= Width
w0,
    Width
w0 forall a. Ord a => a -> a -> Bool
> Width
w1 = do
      WasmExpr w 'I32
x_expr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 WasmExpr w 'I32
x_expr
lower_MO_UU_Conv CLabel
lbl Width
_ Width
W64 [CmmExpr
x] = do
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
      forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
        forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Unsigned
lower_MO_UU_Conv CLabel
lbl Width
W64 Width
w1 [CmmExpr
x] = do
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
      forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I32 : pre)
WasmI32WrapI64
lower_MO_UU_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = 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 forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F32
TagF32 CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F64
TagF64 forall a b. (a -> b) -> a -> b
$
      forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
        forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('F32 : pre) ('F64 : pre)
WasmF64PromoteF32
lower_MO_FF_Conv CLabel
lbl Width
W64 Width
W32 [CmmExpr
x] = do
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F64
TagF64 CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F32
TagF32 forall a b. (a -> b) -> a -> b
$
      forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
        forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('F64 : pre) ('F32 : pre)
WasmF32DemoteF64
lower_MO_FF_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_FF_Conv: 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_Add Width
w0) [CmmExpr]
xs = 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 (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 (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 (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 (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 (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 (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 (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 (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 (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 = 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 (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 (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 (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 (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] =
  forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp
    CLabel
lbl
    (Width -> MachOp
MO_Sub Width
w0)
    [CmmLit -> CmmExpr
CmmLit 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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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_And Width
w0) [CmmExpr]
xs =
  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 (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 (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 (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 (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 (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] =
  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 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 = 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 = 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 = 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_Conv Width
w0 Width
w1) [CmmExpr]
xs =
  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 (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_Conv Width
w0 Width
w1) [CmmExpr]
xs =
  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 (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 = 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 = 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 = 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 = 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
_ MachOp
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_CmmMachOp: unreachable"

-- | Lower a 'CmmLit'. Note that we don't emit 'f32.const' or
-- 'f64.const' for the time being, and instead emit their relative bit
-- pattern as int literals, then use an reinterpret cast. This is
-- simpler than dealing with textual representation of floating point
-- values.
lower_CmmLit :: CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit :: forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit CmmLit
lit = do
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  case CmmLit
lit of
    CmmInt Integer
i Width
w -> case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w) of
      SomeWasmType WasmTypeTag t
ty ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
            forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
              forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
                Width -> Integer -> Integer
narrowU Width
w Integer
i
    CmmFloat Rational
f Width
W32 ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F32
TagF32 forall a b. (a -> b) -> a -> b
$
          forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
            forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
              WasmTypeTag 'I32
TagI32
              (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
f)
              forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F64
TagF64 forall a b. (a -> b) -> a -> b
$
          forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
            forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
              WasmTypeTag 'I64
TagI64
              (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
f)
              forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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
      forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl'
      let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
sym
    CmmLabelOff CLabel
lbl' Int
o -> do
      forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl'
      let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$
          forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
            forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
sym
              forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag w
ty_word (forall a. Integral a => a -> Integer
toInteger Int
o)
              forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd WasmTypeTag w
ty_word
    CmmBlock BlockId
bid -> forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel forall a b. (a -> b) -> a -> b
$ BlockId -> CLabel
infoTblLbl BlockId
bid
    CmmLit
_ -> 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
  (Int
reg_i, SomeWasmType WasmTypeTag t
ty) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a b (t : b)
WasmLocalGet WasmTypeTag t
ty Int
reg_i
lower_CmmReg CLabel
_ (CmmGlobal GlobalReg
EagerBlackholeInfo) = do
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$
      forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
        forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"stg_EAGER_BLACKHOLE_info"
lower_CmmReg CLabel
_ (CmmGlobal GlobalReg
GCEnter1) = do
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"__stg_gc_enter_1" [] [CmmType
ty_word_cmm]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_gc_enter_1"
lower_CmmReg CLabel
_ (CmmGlobal GlobalReg
GCFun) = do
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"__stg_gc_fun" [] [CmmType
ty_word_cmm]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_gc_fun"
lower_CmmReg CLabel
lbl (CmmGlobal GlobalReg
BaseReg) = do
  Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl forall a b. (a -> b) -> a -> b
$ Platform -> Int -> CmmExpr
regTableOffset Platform
platform Int
0
lower_CmmReg CLabel
lbl (CmmGlobal GlobalReg
reg) = do
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  if
      | Just (SymName
sym_global, SomeWasmType WasmTypeTag t
ty) <-
          forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
ty_word GlobalReg
reg ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ 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
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
          case CmmType -> SomeWasmType
someWasmTypeFromCmmType forall a b. (a -> b) -> a -> b
$ Platform -> GlobalReg -> CmmType
globalRegType Platform
platform GlobalReg
reg of
            SomeWasmType WasmTypeTag t
ty -> do
              (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <-
                forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl forall a b. (a -> b) -> a -> b
$
                  Platform -> GlobalReg -> CmmExpr
get_GlobalReg_addr Platform
platform GlobalReg
reg
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
                  forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
                    forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
                      forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
                        WasmTypeTag t
ty
                        forall a. Maybe a
Nothing
                        Signage
Unsigned
                        Int
o
                        AlignmentSpec
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 = 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 WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
reg_instr) <- forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
      forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
        forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
reg_instr
          forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
            WasmTypeTag t
ty
            (forall a. Integral a => a -> Integer
toInteger Int
o)
          forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd WasmTypeTag t
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 forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr_expr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
      forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
          WasmTypeTag t
ty
          (forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm)
          Signage
Unsigned
          Int
o
          AlignmentSpec
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 ->
    forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit CmmLit
lit
  CmmLoad CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align -> 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 -> forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
  CmmRegOff CmmReg
reg Int
o -> forall (w :: WasmType).
CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
o
  CmmMachOp MachOp
op [CmmExpr]
xs -> forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp CLabel
lbl MachOp
op [CmmExpr]
xs
  CmmExpr
_ -> 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 WasmTypeTag t
ty' WasmExpr w t
r <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
expr
  if
      | Just t :~: t
Refl <- WasmTypeTag t
ty' forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
ty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WasmExpr w t
r
      | Bool
otherwise -> forall a. HasCallStack => String -> a
panic String
"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
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  case CmmExpr
ptr of
    CmmLit (CmmLabelOff CLabel
lbl Int
o)
      | Int
o forall a. Ord a => a -> a -> Bool
>= Int
0 -> do
          WasmExpr w w
instrs <-
            forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed
              CLabel
lbl
              WasmTypeTag w
ty_word
              (CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w w
instrs, Int
o)
    CmmMachOp (MO_Add Width
_) [CmmExpr
base, CmmLit (CmmInt Integer
o Width
_)]
      | Integer
o forall a. Ord a => a -> a -> Bool
>= Integer
0 -> do
          WasmExpr w w
instrs <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word CmmExpr
base
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w w
instrs, forall a. Num a => Integer -> a
fromInteger Integer
o)
    CmmExpr
_ -> do
      WasmExpr w w
instrs <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word CmmExpr
ptr
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w w
instrs, Int
0)

-- | Push a series of values onto the wasm value stack, returning the
-- result stack type.
type family
  WasmPushes (ts :: [WasmType]) (pre :: [WasmType]) ::
    [WasmType]
  where
  WasmPushes '[] pre = pre
  WasmPushes (t : ts) pre = WasmPushes ts (t : pre)

-- | Push the arguments onto the wasm value stack before a ccall.
data SomeWasmPreCCall w where
  SomeWasmPreCCall ::
    TypeList ts ->
    (forall pre. WasmInstr w pre (WasmPushes ts pre)) ->
    SomeWasmPreCCall w

-- | Pop the results into locals after a ccall.
data SomeWasmPostCCall w where
  SomeWasmPostCCall ::
    TypeList ts ->
    (forall post. WasmInstr w (WasmPushes ts post) post) ->
    SomeWasmPostCCall w

-- | Lower an unary homogeneous 'CallishMachOp' to a ccall.
lower_CMO_Un_Homo ::
  CLabel ->
  SymName ->
  [CmmFormal] ->
  [CmmActual] ->
  WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo :: forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
op [LocalReg
reg] [CmmExpr
x] = do
  (Int
ri, SomeWasmType WasmTypeTag t
ty) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
  let ty_cmm :: CmmType
ty_cmm = LocalReg -> CmmType
localRegType LocalReg
reg
  forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
op [CmmType
ty_cmm] [CmmType
ty_cmm]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
      forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
op forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
ty Int
ri
lower_CMO_Un_Homo CLabel
_ SymName
_ [LocalReg]
_ [CmmExpr]
_ = 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
  (Int
ri, SomeWasmType WasmTypeTag t
ty) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- 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 forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
  let ty_cmm :: CmmType
ty_cmm = LocalReg -> CmmType
localRegType LocalReg
reg
  forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
op [CmmType
ty_cmm, CmmType
ty_cmm] [CmmType
ty_cmm]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
      forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
op
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
ty Int
ri
lower_CMO_Bin_Homo CLabel
_ SymName
_ [LocalReg]
_ [CmmExpr]
_ = 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
  Int
ri <- forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag 'F32
TagF32 LocalReg
reg
  SomeWasmExpr WasmTypeTag t
ty0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
      forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmConvert Signage
Unsigned WasmTypeTag t
ty0 WasmTypeTag 'F32
TagF32
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag 'F32
TagF32 Int
ri
lower_MO_UF_Conv CLabel
lbl Width
W64 [LocalReg
reg] [CmmExpr
x] = do
  Int
ri <- forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag 'F64
TagF64 LocalReg
reg
  SomeWasmExpr WasmTypeTag t
ty0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
      forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmConvert Signage
Unsigned WasmTypeTag t
ty0 WasmTypeTag 'F64
TagF64
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag 'F64
TagF64 Int
ri
lower_MO_UF_Conv CLabel
_ Width
_ [LocalReg]
_ [CmmExpr]
_ = 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
      Int
reg_i <- forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg
      let narrowing :: Maybe Int
narrowing = forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm
      (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
expected_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
expected
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
new_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
new
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad WasmTypeTag t
ty Maybe Int
narrowing Signage
Unsigned Int
o AlignmentSpec
NaturallyAligned
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : pre) (t : pre)
WasmLocalTee WasmTypeTag t
ty Int
reg_i
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
expected_instr
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq WasmTypeTag t
ty
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (c :: [WasmType]).
WasmInstr a c c -> WasmInstr a (a : c) c
WasmCond
              ( forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
                  forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
new_instr
                  forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t
-> Maybe Int -> Int -> AlignmentSpec -> WasmInstr a (t : a : c) c
WasmStore WasmTypeTag t
ty Maybe Int
narrowing Int
o AlignmentSpec
NaturallyAligned
              )
  where
    ty_cmm :: CmmType
ty_cmm = Width -> CmmType
cmmBits Width
w0
lower_MO_Cmpxchg CLabel
_ Width
_ [LocalReg]
_ [CmmExpr]
_ = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 =
  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 =
  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 =
  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 = 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 =
  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 = 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 =
  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 = 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 = 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 = 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_ReadBarrier [LocalReg]
_ [CmmExpr]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_WriteBarrier [LocalReg]
_ [CmmExpr]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_Touch [LocalReg]
_ [CmmExpr]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ (MO_Prefetch_Data {}) [LocalReg]
_ [CmmExpr]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
lbl (MO_Memcpy {}) [] [CmmExpr]
xs = do
  CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
"memcpy" CmmType
ty_word_cmm [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Memset {}) [] [CmmExpr]
xs = do
  CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
"memset" CmmType
ty_word_cmm [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Memmove {}) [] [CmmExpr]
xs = do
  CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
"memmove" CmmType
ty_word_cmm [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Memcmp {}) [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left SymName
"memcmp")
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_PopCnt Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_popcnt" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Pdep Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_pdep" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Pext Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_pext" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Clz Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_clz" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Ctz Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_ctz" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_BSwap Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_bswap" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_BRev Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_bitrev" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    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 =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    ( forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
        forall a. IsString a => String -> a
fromString 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"
          )
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0)
    )
    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 WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
ret_instr) <-
    forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad
      CLabel
lbl
      CmmExpr
ptr
      (Width -> CmmType
cmmBits Width
w0)
      AlignmentSpec
NaturallyAligned
  Int
ri <- forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
ret_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
ty Int
ri
lower_CallishMachOp CLabel
lbl (MO_AtomicWrite Width
_ MemoryOrdering
_) [] [CmmExpr
ptr, CmmExpr
val] =
  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 = 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 =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_xchg" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_SuspendThread [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left SymName
"suspendThread")
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_ResumeThread [LocalReg]
rs [CmmExpr]
xs =
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left SymName
"resumeThread")
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
_ CallishMachOp
_ [LocalReg]
_ [CmmExpr]
_ = 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
  Unique
ret_uniq <- forall (w :: WasmType). WasmCodeGenM w Unique
wasmUniq
  let ret_local :: LocalReg
ret_local = Unique -> CmmType -> LocalReg
LocalReg Unique
ret_uniq CmmType
ret_cmm_ty
  forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (forall a b. a -> Either a b
Left SymName
sym_callee)
    forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg
ret_local]
    [CmmExpr]
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
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  SomeWasmPreCCall TypeList ts
arg_tys forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr <-
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
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 WasmTypeTag t
arg_ty WasmExpr w t
arg_wasm_expr <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
arg_expr
          let WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
arg_instr = case ForeignHint
arg_hint of
                ForeignHint
SignedHint ->
                  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
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (pre :: [WasmType]).
    WasmInstr w pre (WasmPushes ts pre))
-> SomeWasmPreCCall w
SomeWasmPreCCall (WasmTypeTag t
arg_ty forall (t :: WasmType) (ts :: [WasmType]).
WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
`TypeListCons` TypeList ts
acc_tys) forall a b. (a -> b) -> a -> b
$
              forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
arg_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
acc_instr
      )
      (forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (pre :: [WasmType]).
    WasmInstr w pre (WasmPushes ts pre))
-> SomeWasmPreCCall w
SomeWasmPreCCall TypeList '[]
TypeListNil forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop)
      [(CmmExpr, ForeignHint)]
arg_exprs_hints
  SomeWasmPostCCall TypeList ts
ret_tys forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr <-
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM
      ( \(LocalReg
reg, ForeignHint
ret_hint) (SomeWasmPostCCall TypeList ts
acc_tys forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr) -> do
          (Int
reg_i, SomeWasmType WasmTypeTag t
reg_ty) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (post :: [WasmType]).
    WasmInstr w (WasmPushes ts post) post)
-> SomeWasmPostCCall w
SomeWasmPostCCall (WasmTypeTag t
reg_ty forall (t :: WasmType) (ts :: [WasmType]).
WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
`TypeListCons` TypeList ts
acc_tys) forall a b. (a -> b) -> a -> b
$
              case (# ForeignHint
ret_hint, Platform -> CmmReg -> Width
cmmRegWidth Platform
platform forall a b. (a -> b) -> a -> b
$ LocalReg -> CmmReg
CmmLocal LocalReg
reg #) of
                (# ForeignHint
SignedHint, Width
W8 #) ->
                  forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr
                    forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
reg_ty Integer
0xFF
                    forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
reg_ty
                    forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 #) ->
                  forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr
                    forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
reg_ty Integer
0xFFFF
                    forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
reg_ty
                    forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` 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 #)
_ -> forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
      )
      (forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (post :: [WasmType]).
    WasmInstr w (WasmPushes ts post) post)
-> SomeWasmPostCCall w
SomeWasmPostCCall TypeList '[]
TypeListNil forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop)
      [(LocalReg, ForeignHint)]
ret_locals_hints
  case Either SymName CmmExpr
target of
    Left SymName
sym_callee -> do
      Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
      let arg_cmm_tys :: [CmmType]
arg_cmm_tys = forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) [CmmExpr]
arg_exprs
          ret_cmm_tys :: [CmmType]
ret_cmm_tys = forall a b. (a -> b) -> [a] -> [b]
map LocalReg -> CmmType
localRegType [LocalReg]
ret_locals
      forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
sym_callee [CmmType]
arg_cmm_tys [CmmType]
ret_cmm_tys
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
sym_callee
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` ( case CmmReturnInfo
ret_info of
                             CmmReturnInfo
CmmMayReturn -> forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr
                             CmmReturnInfo
CmmNeverReturns -> forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
WasmInstr a b c
WasmUnreachable
                         )
    Right CmmExpr
fptr_callee -> do
      (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
instr_callee, Int
_) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
fptr_callee
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
          forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
instr_callee
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (arg_tys :: [WasmType]) (ret_tys :: [WasmType])
       (a :: WasmType) (pre :: [WasmType]) (c :: [WasmType]).
TypeList arg_tys -> TypeList ret_tys -> WasmInstr a (a : pre) c
WasmCCallIndirect TypeList ts
arg_tys TypeList ts
ret_tys
            forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` ( case CmmReturnInfo
ret_info of
                             CmmReturnInfo
CmmMayReturn -> forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr
                             CmmReturnInfo
CmmNeverReturns -> 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) ->
        (# forall a b. [a] -> [b] -> [(a, b)]
zip [CmmExpr]
arg_exprs [ForeignHint]
arg_hints, forall a b. [a] -> [b] -> [(a, b)]
zip [LocalReg]
ret_locals [ForeignHint]
ret_hints #)
      Maybe ([ForeignHint], [ForeignHint])
_ -> (# forall a b. (a -> b) -> [a] -> [b]
map (,ForeignHint
NoHint) [CmmExpr]
arg_exprs, 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
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
  let ty_cmm :: CmmType
ty_cmm = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
val
  SomeWasmExpr WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
val_instr) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
val
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
      forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
val_instr
        forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t
-> Maybe Int -> Int -> AlignmentSpec -> WasmInstr a (t : a : c) c
WasmStore WasmTypeTag t
ty (forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm) Int
o AlignmentSpec
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
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  case CmmNode O O
act of
    CmmComment {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
    CmmTick {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
    CmmUnwind {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
    CmmAssign (CmmLocal LocalReg
reg) CmmExpr
e -> do
      (Int
i, SomeWasmType WasmTypeTag t
ty_reg) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs <- 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
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
ty_reg Int
i
    CmmAssign (CmmGlobal GlobalReg
reg) CmmExpr
e
      | GlobalReg
BaseReg <- GlobalReg
reg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
      | Just (SymName
sym_global, SomeWasmType WasmTypeTag t
ty_reg) <-
          forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
ty_word GlobalReg
reg -> do
          WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs <- 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
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
              forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> SymName -> WasmInstr a (t : c) c
WasmGlobalSet WasmTypeTag t
ty_reg SymName
sym_global
      | Bool
otherwise -> do
          (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <-
            forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl forall a b. (a -> b) -> a -> b
$ Platform -> GlobalReg -> CmmExpr
get_GlobalReg_addr Platform
platform GlobalReg
reg
          SomeWasmExpr WasmTypeTag t
ty_e (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
e
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
              forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
                forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs
                forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t
-> Maybe Int -> Int -> AlignmentSpec -> WasmInstr a (t : a : c) c
WasmStore WasmTypeTag t
ty_e forall a. Maybe a
Nothing Int
o AlignmentSpec
NaturallyAligned
    CmmStore CmmExpr
ptr CmmExpr
val AlignmentSpec
align -> 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CCallConv
CCallConv, CCallConv
CApiConv] ->
            forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
              CLabel
lbl
              (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CLabel -> SymName
symNameFromCLabel CLabel
lbl_callee)
              (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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CCallConv
CCallConv, CCallConv
CApiConv] ->
            forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
              CLabel
lbl
              (forall a b. b -> Either a b
Right CmmExpr
target_expr)
              (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 ->
      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
_ -> 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 =
  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 (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre pre
acc forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre pre
stmts)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (w :: WasmType).
CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w)
lower_CmmAction CLabel
lbl CmmNode O O
act
    )
    (forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop)
    [CmmNode O O]
acts
  where
    acts :: [CmmNode O O]
acts = 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
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32]
body <-
    forall expr stmt (m :: * -> *).
Applicative m =>
Platform
-> (BlockId -> CmmExpr -> m expr)
-> (BlockId -> Block CmmNode O O -> m stmt)
-> CmmGraph
-> m (WasmControl stmt expr '[] '[ 'I32])
structuredControl
      Platform
platform
      (\BlockId
_ -> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word)
      (forall (w :: WasmType).
CLabel
-> BlockId
-> Block CmmNode O O
-> WasmCodeGenM w (WasmStatements w)
lower_CmmActions CLabel
lbl)
      CmmGraph
g
  [SomeWasmType]
locals <- forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
    (#
      forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k k0 a. Ord k => UniqFM k0 (k, a) -> [(k, a)]
detEltsUFM forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegs WasmCodeGenState w
s,
      WasmCodeGenState w
s {localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegs = forall key elt. UniqFM key elt
emptyUFM, localRegsCount :: Int
localRegsCount = Int
0}
    #)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure FuncBody {funcLocals :: [SomeWasmType]
funcLocals = [SomeWasmType]
locals, funcBody :: WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
funcBody = forall s e (pre :: [WasmType]) (post :: [WasmType])
       (pre' :: [WasmType]) (post' :: [WasmType]).
WasmControl s e pre post -> WasmControl s e pre' post'
wasmControlCast forall a b. (a -> b) -> a -> b
$ WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32]
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 -> forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
    WasmCodeGenState w
s
      { defaultSyms :: SymSet
defaultSyms =
          Int -> SymSet -> SymSet
IS.insert
            (Unique -> Int
getKey forall a b. (a -> b) -> a -> b
$ forall a. Uniquable a => a -> Unique
getUnique SymName
sym)
            forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType). WasmCodeGenState w -> SymSet
defaultSyms WasmCodeGenState w
s
      }
  SymVisibility
_ -> 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 = forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$
  \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
SymSet
Platform
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
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
wasmUniqSupply :: UniqSupply
localRegsCount :: Int
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
ctors :: [SymName]
dataSections :: SymMap DataSection
funcBodies :: SymMap (FuncBody w)
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
defaultSyms :: SymSet
wasmPlatform :: Platform
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> SymSet
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
..} ->
    WasmCodeGenState w
s
      { funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcTypes =
          forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap
            SymMap ([SomeWasmType], [SomeWasmType])
funcTypes
            SymName
sym
            ( forall a b. (a -> b) -> [a] -> [b]
map CmmType -> SomeWasmType
someWasmTypeFromCmmType [CmmType]
arg_tys,
              forall a b. (a -> b) -> [a] -> [b]
map CmmType -> SomeWasmType
someWasmTypeFromCmmType [CmmType]
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
    WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
    forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
SymSet
Platform
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
wasmUniqSupply :: UniqSupply
localRegsCount :: Int
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
ctors :: [SymName]
dataSections :: SymMap DataSection
funcBodies :: SymMap (FuncBody w)
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
defaultSyms :: SymSet
wasmPlatform :: Platform
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
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
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> SymSet
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
..} ->
      WasmCodeGenState w
s {funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcTypes = forall k a.
Uniquable k =>
(a -> a -> a) -> UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap_C forall a b. a -> b -> a
const SymMap ([SomeWasmType], [SomeWasmType])
funcTypes SymName
sym ([], [forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag w
ty_word])}
  SymKind
_ -> 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 = forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM forall a b. (a -> b) -> a -> b
$ \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
SymSet
Platform
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
wasmUniqSupply :: UniqSupply
localRegsCount :: Int
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
ctors :: [SymName]
dataSections :: SymMap DataSection
funcBodies :: SymMap (FuncBody w)
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
defaultSyms :: SymSet
wasmPlatform :: Platform
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
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
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> SymSet
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
..} ->
  let reg_info :: (Int, SomeWasmType)
reg_info =
        (Int
localRegsCount, CmmType -> SomeWasmType
someWasmTypeFromCmmType forall a b. (a -> b) -> a -> b
$ LocalReg -> CmmType
localRegType LocalReg
reg)
   in case 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 :: UniqFM LocalReg (Int, SomeWasmType)
localRegs = UniqFM LocalReg (Int, SomeWasmType)
localRegs',
                localRegsCount :: Int
localRegsCount =
                  Int
localRegsCount forall a. Num a => a -> a -> a
+ Int
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
  (Int
i, SomeWasmType WasmTypeTag t
ty') <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  if
      | Just t :~: t
Refl <- WasmTypeTag t
ty' forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
ty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
      | Bool
otherwise -> forall a. HasCallStack => String -> a
panic String
"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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SymName]
syms
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n_finis forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ 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
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [CLabel]
lbls forall a b. (a -> b) -> a -> b
$ \CLabel
lbl -> forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym (CLabel -> SymName
symNameFromCLabel CLabel
lbl) [] []
  case InitOrFini
iof of
    InitOrFini
IsInitArray -> forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s -> WasmCodeGenState w
s {ctors :: [SymName]
ctors = [SymName]
syms forall a. Semigroup a => a -> a -> a
<> forall (w :: WasmType). WasmCodeGenState w -> [SymName]
ctors WasmCodeGenState w
s}
    InitOrFini
IsFiniArray -> forall (w :: WasmType). [SymName] -> WasmCodeGenM w ()
onFini [SymName]
syms
  where
    syms :: [SymName]
syms = 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
  WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onTopSym CLabel
lbl
  [DataSectionContent]
cs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CmmStatic]
statics forall (w :: WasmType).
CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic
  let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl
      sec :: DataSection
sec =
        DataSection
          { dataSectionKind :: DataSectionKind
dataSectionKind =
              Section -> DataSectionKind
dataSectionKindFromCmmSection Section
s,
            dataSectionAlignment :: Alignment
dataSectionAlignment =
              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 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
          }
  forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
    WasmCodeGenState w
s
      { dataSections :: SymMap DataSection
dataSections =
          forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap (forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
dataSections WasmCodeGenState w
s) SymName
sym DataSection
sec
      }

-- | Invoked for each 'CmmProc'.
onCmmProc :: CLabel -> CmmGraph -> WasmCodeGenM w ()
onCmmProc :: forall (w :: WasmType). CLabel -> CmmGraph -> WasmCodeGenM w ()
onCmmProc CLabel
lbl CmmGraph
g = do
  CmmType
ty_word <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onTopSym CLabel
lbl
  forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
sym [] [CmmType
ty_word]
  FuncBody w
body <- forall (w :: WasmType).
CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph CLabel
lbl CmmGraph
g
  forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s -> WasmCodeGenState w
s {funcBodies :: SymMap (FuncBody w)
funcBodies = forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap (forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcBodies WasmCodeGenState w
s) SymName
sym FuncBody w
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 = forall (w :: WasmType). InitOrFini -> [CLabel] -> WasmCodeGenM w ()
onCmmInitFini InitOrFini
iof [CLabel]
lbls
onCmmDecl (CmmData Section
s (CmmStaticsRaw CLabel
lbl [CmmStatic]
statics)) = forall (w :: WasmType).
CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData CLabel
lbl Section
s [CmmStatic]
statics
onCmmDecl (CmmProc LabelMap (GenCmmStatics 'True)
_ CLabel
lbl [GlobalReg]
_ CmmGraph
g) = 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 = forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s0 ->
  (# (), forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\WasmCodeGenState w
s RawCmmDecl
cmm -> forall (w :: WasmType) a.
WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w
wasmExecM (forall (w :: WasmType). RawCmmDecl -> WasmCodeGenM w ()
onCmmDecl RawCmmDecl
cmm) WasmCodeGenState w
s) WasmCodeGenState w
s0 RawCmmGroup
cmms #)