{-# 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 = WasmTypeTag 'I32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType -> Bool
isWord64 CmmType
t = WasmTypeTag 'I64 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I64
TagI64
  | CmmType
t CmmType -> CmmType -> Bool
`cmmEqType` CmmType
b16 = WasmTypeTag 'I32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType
t CmmType -> CmmType -> Bool
`cmmEqType` CmmType
b8 = WasmTypeTag 'I32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
  | CmmType -> Bool
isFloat64 CmmType
t = WasmTypeTag 'F64 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F64
TagF64
  | CmmType -> Bool
isFloat32 CmmType
t = WasmTypeTag 'F32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F32
TagF32
  | Bool
otherwise =
      String -> SomeWasmType
forall a. HasCallStack => String -> a
panic (String -> SomeWasmType) -> String -> SomeWasmType
forall a b. (a -> b) -> a -> b
$
        String
"someWasmTypeFromCmmType: unsupported CmmType "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext (CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
t)

-- | Calculate the optional memory narrowing of a 'CmmLoad' or
-- 'CmmStore'.
wasmMemoryNarrowing :: WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing :: forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm = case (# WasmTypeTag t
ty, CmmType -> Width
typeWidth CmmType
ty_cmm #) of
  (# WasmTypeTag t
TagI32, Width
W8 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
  (# WasmTypeTag t
TagI32, Width
W16 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
16
  (# WasmTypeTag t
TagI32, Width
W32 #) -> Maybe Int
forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagI64, Width
W8 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
  (# WasmTypeTag t
TagI64, Width
W16 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
16
  (# WasmTypeTag t
TagI64, Width
W32 #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
32
  (# WasmTypeTag t
TagI64, Width
W64 #) -> Maybe Int
forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagF32, Width
W32 #) -> Maybe Int
forall a. Maybe a
Nothing
  (# WasmTypeTag t
TagF64, Width
W64 #) -> Maybe Int
forall a. Maybe a
Nothing
  (# WasmTypeTag t, Width #)
_ -> String -> Maybe Int
forall a. HasCallStack => String -> a
panic String
"wasmMemoryNarrowing: unreachable"

-- | Despite this is used by the WebAssembly native codegen, we use
-- 'pprCLabel' instead of 'pprAsmLabel' when emitting the textual
-- symbol name. Either one would work, but 'pprCLabel' makes the
-- output assembly code looks closer to the unregisterised codegen
-- output, which can be handy when using the unregisterised codegen as
-- a source of truth when debugging the native codegen.
symNameFromCLabel :: CLabel -> SymName
symNameFromCLabel :: CLabel -> SymName
symNameFromCLabel CLabel
lbl =
  String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$
    SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext {sdocStyle = PprCode} (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$
      Platform -> CLabel -> SDoc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
genericPlatform CLabel
lbl

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

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

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

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

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

-- | Lower a 'CmmStatic'.
lower_CmmStatic :: CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic :: forall (w :: WasmType).
CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic CmmStatic
s = case CmmStatic
s of
  CmmStaticLit (CmmInt Integer
i Width
W8) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Word8 -> DataSectionContent
DataI8 (Word8 -> DataSectionContent) -> Word8 -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W8 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W16) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Word16 -> DataSectionContent
DataI16 (Word16 -> DataSectionContent) -> Word16 -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Integer -> Word16
forall a. Num a => Integer -> a
fromInteger (Integer -> Word16) -> Integer -> Word16
forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W16 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W32) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Word32 -> DataSectionContent
DataI32 (Word32 -> DataSectionContent) -> Word32 -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W32 Integer
i
  CmmStaticLit (CmmInt Integer
i Width
W64) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Word64 -> DataSectionContent
DataI64 (Word64 -> DataSectionContent) -> Word64 -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W64 Integer
i
  CmmStaticLit (CmmFloat Rational
f Width
W32) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Float -> DataSectionContent
DataF32 (Float -> DataSectionContent) -> Float -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
f
  CmmStaticLit (CmmFloat Rational
d Width
W64) -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Double -> DataSectionContent
DataF64 (Double -> DataSectionContent) -> Double -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
d
  CmmStaticLit (CmmLabel CLabel
lbl) ->
    CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl
      WasmCodeGenM w ()
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SymName -> Int -> DataSectionContent
DataSym
        (CLabel -> SymName
symNameFromCLabel CLabel
lbl)
        Int
0
  CmmStaticLit (CmmLabelOff CLabel
lbl Int
o) ->
    CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl
      WasmCodeGenM w ()
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SymName -> Int -> DataSectionContent
DataSym
        (CLabel -> SymName
symNameFromCLabel CLabel
lbl)
        Int
o
  CmmUninitialised Int
i -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ Int -> DataSectionContent
DataSkip Int
i
  CmmString ByteString
b -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ ByteString -> DataSectionContent
DataASCII ByteString
b
  CmmFileEmbed String
f Int
l -> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSectionContent -> WasmCodeGenM w DataSectionContent)
-> DataSectionContent -> WasmCodeGenM w DataSectionContent
forall a b. (a -> b) -> a -> b
$ String -> Int -> DataSectionContent
DataIncBin String
f Int
l
  CmmStatic
_ -> String -> WasmCodeGenM w DataSectionContent
forall a. HasCallStack => String -> a
panic String
"lower_CmmStatic: unreachable"

{-
Note [Register mapping on WebAssembly]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Unlike typical ISAs, WebAssembly doesn't expose a fixed set of
registers. For now, we map each Cmm LocalReg to a wasm local, and each
Cmm GlobalReg to a wasm global. The wasm globals are defined in
rts/wasm/Wasm.S, and must be kept in sync with
'globalInfoFromCmmGlobalReg' and 'supportedCmmGlobalRegs' here.

There are some other Cmm GlobalRegs which are still represented by
StgRegTable fields instead of wasm globals (e.g. HpAlloc). It's cheap
to add wasm globals, but other parts of rts logic only work with the
StgRegTable fields, so we also need to instrument StgRun/StgReturn to
sync the wasm globals with the StgRegTable. It's not really worth the
trouble.

-}
globalInfoFromCmmGlobalReg :: WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg :: forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
t GlobalReg
reg = case GlobalReg
reg of
  VanillaReg Int
i VGcPtr
_
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"__R" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i, SomeWasmType
ty_word)
  FloatReg Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 ->
        GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"__F" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i, WasmTypeTag 'F32 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F32
TagF32)
  DoubleReg Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 ->
        GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"__D" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i, WasmTypeTag 'F64 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F64
TagF64)
  LongReg Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"__L" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i, WasmTypeTag 'I64 -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I64
TagI64)
  GlobalReg
Sp -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (SymName
"__Sp", SomeWasmType
ty_word)
  GlobalReg
SpLim -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (SymName
"__SpLim", SomeWasmType
ty_word)
  GlobalReg
Hp -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (SymName
"__Hp", SomeWasmType
ty_word)
  GlobalReg
HpLim -> GlobalInfo -> Maybe GlobalInfo
forall a. a -> Maybe a
Just (SymName
"__HpLim", SomeWasmType
ty_word)
  GlobalReg
_ -> Maybe GlobalInfo
forall a. Maybe a
Nothing
  where
    ty_word :: SomeWasmType
ty_word = WasmTypeTag w -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag w
t

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

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

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

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

-- | Lower a binary homogeneous operation. Homogeneous: result type is
-- the same with operand types.
lower_MO_Bin_Homo ::
  ( forall pre t.
    WasmTypeTag t ->
    WasmInstr
      w
      (t : t : pre)
      (t : pre)
  ) ->
  CLabel ->
  CmmType ->
  [CmmExpr] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl CmmType
t0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0 of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (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]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Homo: unreachable"

-- | Lower a binary homogeneous operation, and truncate the result if
-- it's a subword.
lower_MO_Bin_Homo_Trunc ::
  (forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)) ->
  CLabel ->
  Width ->
  [CmmExpr] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
    SomeWasmType WasmTypeTag t
ty -> do
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t) -> WasmExpr w t -> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
            (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
              WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (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]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Homo_Trunc: unreachable"

-- | Lower a binary homogeneous operation, first sign extending the
-- operands, then truncating the result.
lower_MO_Bin_Homo_Ext_Trunc ::
  (forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)) ->
  CLabel ->
  Width ->
  [CmmExpr] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
    SomeWasmType WasmTypeTag t
ty -> do
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <-
        Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (WasmExpr w t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <-
        Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (WasmExpr w t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t) -> WasmExpr w t -> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
            (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
              WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (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]
_ =
  String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Homo_Ext_Trunc: unreachable"

-- | Lower a relational binary operation, first sign extending the
-- operands. Relational: result type is a boolean (word type).
lower_MO_Bin_Rel_Ext ::
  (forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)) ->
  CLabel ->
  Width ->
  [CmmExpr] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
    SomeWasmType WasmTypeTag t
ty -> do
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <-
        Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (WasmExpr w t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <-
        Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (WasmExpr w t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
      WasmTypeTag w
ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$
            WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (w : pre) -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
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]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Rel_Ext: unreachable"

-- | Lower a relational binary operation.
lower_MO_Bin_Rel ::
  ( forall pre t.
    WasmTypeTag t ->
    WasmInstr
      w
      (t : t : pre)
      (w : pre)
  ) ->
  CLabel ->
  CmmType ->
  [CmmExpr] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op CLabel
lbl CmmType
t0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0 of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    WasmTypeTag w
ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
    SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (w : pre) -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
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]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Rel: unreachable"

-- | Cast a shiftL/shiftR RHS to the same type as LHS. Because we may
-- have a 64-bit LHS and 32-bit RHS, but wasm shift operators are
-- homogeneous.
shiftRHSCast ::
  CLabel ->
  WasmTypeTag t ->
  CmmExpr ->
  WasmCodeGenM
    w
    (WasmExpr w t)
shiftRHSCast :: forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
t1 CmmExpr
x = do
  SomeWasmExpr WasmTypeTag t
t0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  if
      | Just t :~: t
Refl <- WasmTypeTag t
t0 WasmTypeTag t -> WasmTypeTag t -> Maybe (t :~: t)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: WasmType) (b :: WasmType).
WasmTypeTag a -> WasmTypeTag b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
t1 -> WasmExpr w t -> WasmCodeGenM w (WasmExpr w t)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w t -> WasmCodeGenM w (WasmExpr w t))
-> WasmExpr w t -> WasmCodeGenM w (WasmExpr w t)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr WasmInstr w pre (t : pre)
WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
      | WasmTypeTag t
TagI32 <- WasmTypeTag t
t0,
        WasmTypeTag t
TagI64 <- WasmTypeTag t
t1 ->
          WasmExpr w t -> WasmCodeGenM w (WasmExpr w t)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w t -> WasmCodeGenM w (WasmExpr w t))
-> WasmExpr w t -> WasmCodeGenM w (WasmExpr w t)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` Signage -> WasmInstr w ('I32 : pre) ('I64 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Unsigned
      | Bool
otherwise -> String -> WasmCodeGenM w (WasmExpr w t)
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 <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
        Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t) -> WasmExpr w t -> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
            WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShl WasmTypeTag t
ty
lower_MO_Shl CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Shl: unreachable"

-- | Lower a 'MO_U_Shr' operation.
lower_MO_U_Shr ::
  CLabel ->
  Width ->
  [CmmExpr] ->
  WasmCodeGenM
    w
    (SomeWasmExpr w)
lower_MO_U_Shr :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_U_Shr CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShr Signage
Unsigned WasmTypeTag t
ty
lower_MO_U_Shr CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_U_Shr: unreachable"

-- | Lower a 'MO_S_Shr' operation, first sign-extending the LHS, then
-- truncating the result.
lower_MO_S_Shr ::
  CLabel ->
  Width ->
  [CmmExpr] ->
  WasmCodeGenM
    w
    (SomeWasmExpr w)
lower_MO_S_Shr :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_S_Shr CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (WasmExpr w t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
        Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty (WasmExpr w t -> WasmExpr w t) -> WasmExpr w t -> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
            WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShr Signage
Signed WasmTypeTag t
ty
lower_MO_S_Shr CLabel
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_S_Shr: unreachable"

-- | Lower a 'MO_MulMayOflo' operation. It's translated to a ccall to
-- @hs_mulIntMayOflo@ function in @ghc-prim/cbits/mulIntMayOflo@,
-- otherwise it's quite non-trivial to implement as inline assembly.
lower_MO_MulMayOflo ::
  CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
ty_cmm of
  SomeWasmType WasmTypeTag t
ty -> do
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
    WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
    SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"hs_mulIntMayOflo" [CmmType
ty_cmm, CmmType
ty_cmm] [CmmType
ty_cmm]
    SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
            WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr
            WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` SymName -> WasmInstr w (t : t : pre) (t : pre)
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]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_MulMayOflo: unreachable"

-- | Lower an unary conversion operation.
lower_MO_Un_Conv ::
  ( forall pre t0 t1.
    WasmTypeTag t0 ->
    WasmTypeTag t1 ->
    WasmInstr w (t0 : pre) (t1 : pre)
  ) ->
  CLabel ->
  CmmType ->
  CmmType ->
  [CmmExpr] ->
  WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre)
op CLabel
lbl CmmType
t0 CmmType
t1 [CmmExpr
x] =
  case (# CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0, CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t1 #) of
    (# SomeWasmType WasmTypeTag t
ty0, SomeWasmType WasmTypeTag t
ty1 #) -> do
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty0 CmmExpr
x
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty1 (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
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]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Un_Conv: unreachable"

-- | Lower a 'MO_SS_Conv' operation.
lower_MO_SS_Conv ::
  CLabel ->
  Width ->
  Width ->
  [CmmExpr] ->
  WasmCodeGenM
    w
    (SomeWasmExpr w)
lower_MO_SS_Conv :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
  | Width
w0 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
w1 = CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align]
  | Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
w1,
    Width
w1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W32 = do
      (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag 'I32 -> WasmExpr w 'I32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> SomeWasmExpr w)
-> WasmExpr w 'I32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          Width -> WasmTypeTag 'I32 -> WasmExpr w 'I32 -> WasmExpr w 'I32
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> WasmExpr w 'I32)
-> WasmExpr w 'I32 -> WasmExpr w 'I32
forall a b. (a -> b) -> a -> b
$
            (forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
-> WasmExpr w 'I32
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
 -> WasmExpr w 'I32)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
-> WasmExpr w 'I32
forall a b. (a -> b) -> a -> b
$
              WasmInstr w pre (w : pre)
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
                WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) ('I32 : pre)
-> WasmInstr w pre ('I32 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag 'I32
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr w (w : pre) ('I32 : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
                  WasmTypeTag 'I32
TagI32
                  (WasmTypeTag 'I32 -> CmmType -> Maybe Int
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 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
w1 =
      WasmTypeTag 'I32 -> WasmExpr w 'I32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32
        (WasmExpr w 'I32 -> SomeWasmExpr w)
-> WasmCodeGenM w (WasmExpr w 'I32)
-> WasmCodeGenM w (SomeWasmExpr w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel
-> CmmExpr
-> WasmTypeTag 'I32
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed
          CLabel
lbl
          CmmExpr
ptr
          WasmTypeTag 'I32
TagI32
          (Width -> CmmType
cmmBits Width
w1)
          AlignmentSpec
align
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
W64 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align] = do
  (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag 'I64 -> WasmExpr w 'I64 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 (WasmExpr w 'I64 -> SomeWasmExpr w)
-> WasmExpr w 'I64 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      (forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
-> WasmExpr w 'I64
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
 -> WasmExpr w 'I64)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
-> WasmExpr w 'I64
forall a b. (a -> b) -> a -> b
$
        WasmInstr w pre (w : pre)
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
          WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) ('I64 : pre)
-> WasmInstr w pre ('I64 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag 'I64
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr w (w : pre) ('I64 : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
            WasmTypeTag 'I64
TagI64
            (WasmTypeTag 'I64 -> CmmType -> Maybe Int
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 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
w1,
    Width
w1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W32 = do
      WasmExpr w 'I32
x_expr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag 'I32 -> WasmExpr w 'I32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> SomeWasmExpr w)
-> WasmExpr w 'I32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          Width -> WasmTypeTag 'I32 -> WasmExpr w 'I32 -> WasmExpr w 'I32
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> WasmExpr w 'I32)
-> WasmExpr w 'I32 -> WasmExpr w 'I32
forall a b. (a -> b) -> a -> b
$
            Width -> WasmTypeTag 'I32 -> WasmExpr w 'I32 -> WasmExpr w 'I32
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 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
>= Width
w0,
    Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
w1 = do
      WasmExpr w 'I32
x_expr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag 'I32 -> WasmExpr w 'I32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> SomeWasmExpr w)
-> WasmExpr w 'I32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ Width -> WasmTypeTag 'I32 -> WasmExpr w 'I32 -> WasmExpr w 'I32
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 <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag 'I64 -> WasmExpr w 'I64 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 (WasmExpr w 'I64 -> SomeWasmExpr w)
-> WasmExpr w 'I64 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      (forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
-> WasmExpr w 'I64
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
 -> WasmExpr w 'I64)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
-> WasmExpr w 'I64
forall a b. (a -> b) -> a -> b
$
        WasmInstr w pre ('I32 : pre)
forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr WasmInstr w pre ('I32 : pre)
-> WasmInstr w ('I32 : pre) ('I64 : pre)
-> WasmInstr w pre ('I64 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` Signage -> WasmInstr w ('I32 : pre) ('I64 : pre)
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 <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag 'I64 -> WasmExpr w 'I64 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 (WasmExpr w 'I64 -> SomeWasmExpr w)
-> WasmExpr w 'I64 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      Width -> WasmTypeTag 'I64 -> WasmExpr w 'I64 -> WasmExpr w 'I64
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag 'I64
TagI64 (WasmExpr w 'I64 -> WasmExpr w 'I64)
-> WasmExpr w 'I64 -> WasmExpr w 'I64
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
-> WasmExpr w 'I64
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
 -> WasmExpr w 'I64)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
-> WasmExpr w 'I64
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre ('I32 : pre)
forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr WasmInstr w pre ('I32 : pre)
-> WasmInstr w ('I32 : pre) ('I64 : pre)
-> WasmInstr w pre ('I64 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` Signage -> WasmInstr w ('I32 : pre) ('I64 : pre)
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 <- CLabel
-> WasmTypeTag 'I64 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I64)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag 'I32 -> WasmExpr w 'I32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> SomeWasmExpr w)
-> WasmExpr w 'I32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      Width -> WasmTypeTag 'I32 -> WasmExpr w 'I32 -> WasmExpr w 'I32
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> WasmExpr w 'I32)
-> WasmExpr w 'I32 -> WasmExpr w 'I32
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
-> WasmExpr w 'I32
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
 -> WasmExpr w 'I32)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
-> WasmExpr w 'I32
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre ('I64 : pre)
forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr WasmInstr w pre ('I64 : pre)
-> WasmInstr w ('I64 : pre) ('I32 : pre)
-> WasmInstr w pre ('I32 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w ('I64 : pre) ('I32 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I32 : pre)
WasmI32WrapI64
lower_MO_SS_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_SS_Conv: unreachable"

-- | Lower a 'MO_UU_Conv' operation.
lower_MO_UU_Conv ::
  CLabel ->
  Width ->
  Width ->
  [CmmExpr] ->
  WasmCodeGenM
    w
    (SomeWasmExpr w)
lower_MO_UU_Conv :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w1) of
    SomeWasmType WasmTypeTag t
ty ->
      WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty
        (WasmExpr w t -> SomeWasmExpr w)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (SomeWasmExpr w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed
          CLabel
lbl
          CmmExpr
ptr
          WasmTypeTag t
ty
          (Width -> CmmType
cmmBits (Width -> Width -> Width
forall a. Ord a => a -> a -> a
min Width
w0 Width
w1))
          AlignmentSpec
align
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
  | Width
w0 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
w1 = CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  | Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
w1, Width
w1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W32 = CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  | Width
W32 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
>= Width
w0,
    Width
w0 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
w1 = do
      WasmExpr w 'I32
x_expr <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag 'I32 -> WasmExpr w 'I32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> SomeWasmExpr w)
-> WasmExpr w 'I32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ Width -> WasmTypeTag 'I32 -> WasmExpr w 'I32 -> WasmExpr w 'I32
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 <- CLabel
-> WasmTypeTag 'I32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag 'I64 -> WasmExpr w 'I64 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 (WasmExpr w 'I64 -> SomeWasmExpr w)
-> WasmExpr w 'I64 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      (forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
-> WasmExpr w 'I64
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
 -> WasmExpr w 'I64)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre))
-> WasmExpr w 'I64
forall a b. (a -> b) -> a -> b
$
        WasmInstr w pre ('I32 : pre)
forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr WasmInstr w pre ('I32 : pre)
-> WasmInstr w ('I32 : pre) ('I64 : pre)
-> WasmInstr w pre ('I64 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` Signage -> WasmInstr w ('I32 : pre) ('I64 : pre)
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 <- CLabel
-> WasmTypeTag 'I64 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'I64)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag 'I32 -> WasmExpr w 'I32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> SomeWasmExpr w)
-> WasmExpr w 'I32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      Width -> WasmTypeTag 'I32 -> WasmExpr w 'I32 -> WasmExpr w 'I32
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 (WasmExpr w 'I32 -> WasmExpr w 'I32)
-> WasmExpr w 'I32 -> WasmExpr w 'I32
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
-> WasmExpr w 'I32
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
 -> WasmExpr w 'I32)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre))
-> WasmExpr w 'I32
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre ('I64 : pre)
forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr WasmInstr w pre ('I64 : pre)
-> WasmInstr w ('I64 : pre) ('I32 : pre)
-> WasmInstr w pre ('I32 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w ('I64 : pre) ('I32 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I32 : pre)
WasmI32WrapI64
lower_MO_UU_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_UU_Conv: unreachable"

-- | Lower a 'MO_FF_Conv' operation.
lower_MO_FF_Conv ::
  CLabel ->
  Width ->
  Width ->
  [CmmExpr] ->
  WasmCodeGenM
    w
    (SomeWasmExpr w)
lower_MO_FF_Conv :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FF_Conv CLabel
lbl Width
W32 Width
W64 [CmmExpr
x] = do
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre)
x_instr <- CLabel
-> WasmTypeTag 'F32 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'F32)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F32
TagF32 CmmExpr
x
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag 'F64 -> WasmExpr w 'F64 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F64
TagF64 (WasmExpr w 'F64 -> SomeWasmExpr w)
-> WasmExpr w 'F64 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      (forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
-> WasmExpr w 'F64
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
 -> WasmExpr w 'F64)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
-> WasmExpr w 'F64
forall a b. (a -> b) -> a -> b
$
        WasmInstr w pre ('F32 : pre)
forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre)
x_instr WasmInstr w pre ('F32 : pre)
-> WasmInstr w ('F32 : pre) ('F64 : pre)
-> WasmInstr w pre ('F64 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w ('F32 : pre) ('F64 : pre)
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 <- CLabel
-> WasmTypeTag 'F64 -> CmmExpr -> WasmCodeGenM w (WasmExpr w 'F64)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F64
TagF64 CmmExpr
x
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag 'F32 -> WasmExpr w 'F32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F32
TagF32 (WasmExpr w 'F32 -> SomeWasmExpr w)
-> WasmExpr w 'F32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      (forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
-> WasmExpr w 'F32
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
 -> WasmExpr w 'F32)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
-> WasmExpr w 'F32
forall a b. (a -> b) -> a -> b
$
        WasmInstr w pre ('F64 : pre)
forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre)
x_instr WasmInstr w pre ('F64 : pre)
-> WasmInstr w ('F64 : pre) ('F32 : pre)
-> WasmInstr w pre ('F32 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w ('F64 : pre) ('F32 : pre)
forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('F64 : pre) ('F32 : pre)
WasmF32DemoteF64
lower_MO_FF_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_FF_Conv: unreachable"

-- | Lower a '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 (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Sub Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmSub CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Eq Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Ne Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmNe CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Mul Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmMul CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_MulMayOflo Width
w0) [CmmExpr]
xs = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Quot Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Rem Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmRem Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Neg Width
w0) [CmmExpr
x] =
  CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp
    CLabel
lbl
    (Width -> MachOp
MO_Sub Width
w0)
    [CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
w0, CmmExpr
x]
lower_CmmMachOp CLabel
lbl (MO_U_Quot Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Rem Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmRem Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Ge Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Le Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Gt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Lt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Signed)
    CLabel
lbl
    Width
w0
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Ge Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Le Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Gt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Lt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Unsigned)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Add Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Sub Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmSub
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Neg Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Homo
    WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : pre) (t : pre)
WasmNeg
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Mul Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmMul
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Quot Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Eq Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Ne Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmNe
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Ge Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Le Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Gt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Lt Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
    (Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_And Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Or Width
w0) [CmmExpr]
xs = (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmOr CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Xor Width
w0) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
 WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
    WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmXor
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Not Width
w0) [CmmExpr
x] =
  CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp
    CLabel
lbl
    (Width -> MachOp
MO_Xor Width
w0)
    [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt (Width -> Integer
widthMax Width
w0) Width
w0]
lower_CmmMachOp CLabel
lbl (MO_Shl Width
w0) [CmmExpr]
xs = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Shl CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Shr Width
w0) [CmmExpr]
xs = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_U_Shr CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Shr Width
w0) [CmmExpr]
xs = CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_S_Shr CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_SF_Conv Width
w0 Width
w1) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv
    (Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr w (t0 : pre) (t1 : pre)
forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmConvert Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmBits Width
w0)
    (Width -> CmmType
cmmFloat Width
w1)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_FS_Conv Width
w0 Width
w1) [CmmExpr]
xs =
  (forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
 WasmTypeTag t0
 -> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv
    (Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr w (t0 : pre) (t1 : pre)
forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmTruncSat Signage
Signed)
    CLabel
lbl
    (Width -> CmmType
cmmFloat Width
w0)
    (Width -> CmmType
cmmBits Width
w1)
    [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_SS_Conv Width
w0 Width
w1) [CmmExpr]
xs = CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_UU_Conv Width
w0 Width
w1) [CmmExpr]
xs = CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_XX_Conv Width
w0 Width
w1) [CmmExpr]
xs = CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_FF_Conv Width
w0 Width
w1) [CmmExpr]
xs = CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FF_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
_ MachOp
_ [CmmExpr]
_ = String -> WasmCodeGenM w (SomeWasmExpr w)
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 <- WasmCodeGenM w (WasmTypeTag w)
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 ->
        SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
          WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
            (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
              WasmTypeTag t -> Integer -> WasmInstr w pre (t : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty (Integer -> WasmInstr w pre (t : pre))
-> Integer -> WasmInstr w pre (t : pre)
forall a b. (a -> b) -> a -> b
$
                Width -> Integer -> Integer
narrowU Width
w Integer
i
    CmmFloat Rational
f Width
W32 ->
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag 'F32 -> WasmExpr w 'F32 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F32
TagF32 (WasmExpr w 'F32 -> SomeWasmExpr w)
-> WasmExpr w 'F32 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
-> WasmExpr w 'F32
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
 -> WasmExpr w 'F32)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre))
-> WasmExpr w 'F32
forall a b. (a -> b) -> a -> b
$
            WasmTypeTag 'I32 -> Integer -> WasmInstr w pre ('I32 : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
              WasmTypeTag 'I32
TagI32
              (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 (Float -> Word32) -> Float -> Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
f)
              WasmInstr w pre ('I32 : pre)
-> WasmInstr w ('I32 : pre) ('F32 : pre)
-> WasmInstr w pre ('F32 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag 'I32
-> WasmTypeTag 'F32 -> WasmInstr w ('I32 : pre) ('F32 : pre)
forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr a (t0 : pre) (t1 : pre)
WasmReinterpret WasmTypeTag 'I32
TagI32 WasmTypeTag 'F32
TagF32
    CmmFloat Rational
f Width
W64 ->
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag 'F64 -> WasmExpr w 'F64 -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F64
TagF64 (WasmExpr w 'F64 -> SomeWasmExpr w)
-> WasmExpr w 'F64 -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
-> WasmExpr w 'F64
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
 -> WasmExpr w 'F64)
-> (forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre))
-> WasmExpr w 'F64
forall a b. (a -> b) -> a -> b
$
            WasmTypeTag 'I64 -> Integer -> WasmInstr w pre ('I64 : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
              WasmTypeTag 'I64
TagI64
              (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 (Double -> Word64) -> Double -> Word64
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
f)
              WasmInstr w pre ('I64 : pre)
-> WasmInstr w ('I64 : pre) ('F64 : pre)
-> WasmInstr w pre ('F64 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag 'I64
-> WasmTypeTag 'F64 -> WasmInstr w ('I64 : pre) ('F64 : pre)
forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
       (pre :: [WasmType]).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr a (t0 : pre) (t1 : pre)
WasmReinterpret WasmTypeTag 'I64
TagI64 WasmTypeTag 'F64
TagF64
    CmmLabel CLabel
lbl' -> do
      CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl'
      let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl'
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$ SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
sym
    CmmLabelOff CLabel
lbl' Int
o -> do
      CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl'
      let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl'
      SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
        WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
          (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$
            SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
sym
              WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) (w : w : pre)
-> WasmInstr w pre (w : w : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag w -> Integer -> WasmInstr w (w : pre) (w : w : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag w
ty_word (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
o)
              WasmInstr w pre (w : w : pre)
-> WasmInstr w (w : w : pre) (w : pre) -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag w -> WasmInstr w (w : w : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd WasmTypeTag w
ty_word
    CmmBlock BlockId
bid -> CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit (CmmLit -> WasmCodeGenM w (SomeWasmExpr w))
-> CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
forall a b. (a -> b) -> a -> b
$ BlockId -> CLabel
infoTblLbl BlockId
bid
    CmmLit
_ -> String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_CmmLit: unreachable"

--  | Lower a 'CmmReg'. Some of the logic here wouldn't be needed if
--  we have run 'fixStgRegisters' on the wasm NCG's input Cmm, but we
--  haven't run it yet for certain reasons.
lower_CmmReg :: CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg :: forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
_ (CmmLocal LocalReg
reg) = do
  (Int
reg_i, SomeWasmType WasmTypeTag t
ty) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Int -> WasmInstr w pre (t : pre)
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 <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$
        SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"stg_EAGER_BLACKHOLE_info"
lower_CmmReg CLabel
_ (CmmGlobal GlobalReg
GCEnter1) = do
  WasmTypeTag w
ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  CmmType
ty_word_cmm <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"__stg_gc_enter_1" [] [CmmType
ty_word_cmm]
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$ SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_gc_enter_1"
lower_CmmReg CLabel
_ (CmmGlobal GlobalReg
GCFun) = do
  WasmTypeTag w
ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  CmmType
ty_word_cmm <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"__stg_gc_fun" [] [CmmType
ty_word_cmm]
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> WasmExpr w w -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word (WasmExpr w w -> SomeWasmExpr w) -> WasmExpr w w -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
 -> WasmExpr w w)
-> (forall (pre :: [WasmType]). WasmInstr w pre (w : pre))
-> WasmExpr w w
forall a b. (a -> b) -> a -> b
$ SymName -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_gc_fun"
lower_CmmReg CLabel
lbl (CmmGlobal GlobalReg
BaseReg) = do
  Platform
platform <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl (CmmExpr -> WasmCodeGenM w (SomeWasmExpr w))
-> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
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 <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  if
      | Just (SymName
sym_global, SomeWasmType WasmTypeTag t
ty) <-
          WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
ty_word GlobalReg
reg ->
          SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> SymName -> WasmInstr w pre (t : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> SymName -> WasmInstr a b (t : b)
WasmGlobalGet WasmTypeTag t
ty SymName
sym_global
      | Bool
otherwise -> do
          Platform
platform <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
          case CmmType -> SomeWasmType
someWasmTypeFromCmmType (CmmType -> SomeWasmType) -> CmmType -> SomeWasmType
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) <-
                CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl (CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int))
-> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall a b. (a -> b) -> a -> b
$
                  Platform -> GlobalReg -> CmmExpr
get_GlobalReg_addr Platform
platform GlobalReg
reg
              SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
                WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
                  (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
                    WasmInstr w pre (w : pre)
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
                      WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr w (w : pre) (t : pre)
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
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 = CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
o = do
  SomeWasmExpr WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
reg_instr) <- CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
  SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w))
-> SomeWasmExpr w -> WasmCodeGenM w (SomeWasmExpr w)
forall a b. (a -> b) -> a -> b
$
    WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w) -> WasmExpr w t -> SomeWasmExpr w
forall a b. (a -> b) -> a -> b
$
      (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
        WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
reg_instr
          WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Integer -> WasmInstr w (t : pre) (t : t : pre)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
            WasmTypeTag t
ty
            (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
o)
          WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
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) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr_expr
  WasmExpr w t -> WasmCodeGenM w (WasmExpr w t)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w t -> WasmCodeGenM w (WasmExpr w t))
-> WasmExpr w t -> WasmCodeGenM w (WasmExpr w t)
forall a b. (a -> b) -> a -> b
$
    (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr ((forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
 -> WasmExpr w t)
-> (forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
forall a b. (a -> b) -> a -> b
$
      WasmInstr w pre (w : pre)
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
        WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr w (w : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
          WasmTypeTag t
ty
          (WasmTypeTag t -> CmmType -> Maybe Int
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 ->
    WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty (WasmExpr w t -> SomeWasmExpr w)
-> WasmCodeGenM w (WasmExpr w t) -> WasmCodeGenM w (SomeWasmExpr w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed CLabel
lbl CmmExpr
ptr_expr WasmTypeTag t
ty CmmType
ty_cmm AlignmentSpec
align

-- | Lower a 'CmmExpr'.
lower_CmmExpr :: CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr :: forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
expr = case CmmExpr
expr of
  CmmLit CmmLit
lit -> CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit CmmLit
lit
  CmmLoad CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align -> CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad CLabel
lbl CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align
  CmmReg CmmReg
reg -> CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
  CmmRegOff CmmReg
reg Int
o -> CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
o
  CmmMachOp MachOp
op [CmmExpr]
xs -> CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp CLabel
lbl MachOp
op [CmmExpr]
xs
  CmmExpr
_ -> String -> WasmCodeGenM w (SomeWasmExpr w)
forall a. HasCallStack => String -> a
panic String
"lower_CmmExpr: unreachable"

-- | Lower a 'CmmExpr', passing in the expected wasm representation
-- type.
lower_CmmExpr_Typed ::
  CLabel ->
  WasmTypeTag t ->
  CmmExpr ->
  WasmCodeGenM
    w
    (WasmExpr w t)
lower_CmmExpr_Typed :: forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
expr = do
  SomeWasmExpr WasmTypeTag t
ty' WasmExpr w t
r <- CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
expr
  if
      | Just t :~: t
Refl <- WasmTypeTag t
ty' WasmTypeTag t -> WasmTypeTag t -> Maybe (t :~: t)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: WasmType) (b :: WasmType).
WasmTypeTag a -> WasmTypeTag b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
ty -> WasmExpr w t -> WasmCodeGenM w (WasmExpr w t)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WasmExpr w t
WasmExpr w t
r
      | Bool
otherwise -> String -> WasmCodeGenM w (WasmExpr w t)
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 <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  case CmmExpr
ptr of
    CmmLit (CmmLabelOff CLabel
lbl Int
o)
      | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> do
          WasmExpr w w
instrs <-
            CLabel -> WasmTypeTag w -> CmmExpr -> WasmCodeGenM w (WasmExpr w w)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed
              CLabel
lbl
              WasmTypeTag w
ty_word
              (CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl)
          (WasmExpr w w, Int) -> WasmCodeGenM w (WasmExpr w w, Int)
forall a. a -> WasmCodeGenM w a
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> do
          WasmExpr w w
instrs <- CLabel -> WasmTypeTag w -> CmmExpr -> WasmCodeGenM w (WasmExpr w w)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word CmmExpr
base
          (WasmExpr w w, Int) -> WasmCodeGenM w (WasmExpr w w, Int)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w w
instrs, Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
o)
    CmmExpr
_ -> do
      WasmExpr w w
instrs <- CLabel -> WasmTypeTag w -> CmmExpr -> WasmCodeGenM w (WasmExpr w w)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word CmmExpr
ptr
      (WasmExpr w w, Int) -> WasmCodeGenM w (WasmExpr w w, Int)
forall a. a -> WasmCodeGenM w a
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) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
  let ty_cmm :: CmmType
ty_cmm = LocalReg -> CmmType
localRegType LocalReg
reg
  SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
op [CmmType
ty_cmm] [CmmType
ty_cmm]
  WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$
    (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$
      WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` SymName -> WasmInstr w (t : pre) (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
op WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : pre) pre
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]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"lower_CMO_Un_Homo: unreachable"

-- | Lower a binary homogeneous 'CallishMachOp' to a ccall.
lower_CMO_Bin_Homo ::
  CLabel ->
  SymName ->
  [CmmFormal] ->
  [CmmActual] ->
  WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo :: forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
op [LocalReg
reg] [CmmExpr
x, CmmExpr
y] = do
  (Int
ri, SomeWasmType WasmTypeTag t
ty) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
  WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
  let ty_cmm :: CmmType
ty_cmm = LocalReg -> CmmType
localRegType LocalReg
reg
  SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
op [CmmType
ty_cmm, CmmType
ty_cmm] [CmmType
ty_cmm]
  WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$
    (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$
      WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
        WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr
        WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` SymName -> WasmInstr w (t : t : pre) (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
op
        WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : pre) pre
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]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"lower_CMO_Bin_Homo: unreachable"

-- | Lower a 'MO_UF_Conv' operation.
lower_MO_UF_Conv ::
  CLabel ->
  Width ->
  [CmmFormal] ->
  [CmmActual] ->
  WasmCodeGenM w (WasmStatements w)
lower_MO_UF_Conv :: forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_UF_Conv CLabel
lbl Width
W32 [LocalReg
reg] [CmmExpr
x] = do
  Int
ri <- WasmTypeTag 'F32 -> LocalReg -> WasmCodeGenM w Int
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag 'F32
TagF32 LocalReg
reg
  SomeWasmExpr WasmTypeTag t
ty0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$
    (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$
      WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
        WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) ('F32 : pre)
-> WasmInstr w pre ('F32 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` Signage
-> WasmTypeTag t
-> WasmTypeTag 'F32
-> WasmInstr w (t : pre) ('F32 : pre)
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
        WasmInstr w pre ('F32 : pre)
-> WasmInstr w ('F32 : pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag 'F32 -> Int -> WasmInstr w ('F32 : pre) pre
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 <- WasmTypeTag 'F64 -> LocalReg -> WasmCodeGenM w Int
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag 'F64
TagF64 LocalReg
reg
  SomeWasmExpr WasmTypeTag t
ty0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
  WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$
    (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$
      WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
        WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) ('F64 : pre)
-> WasmInstr w pre ('F64 : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` Signage
-> WasmTypeTag t
-> WasmTypeTag 'F64
-> WasmInstr w (t : pre) ('F64 : pre)
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
        WasmInstr w pre ('F64 : pre)
-> WasmInstr w ('F64 : pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag 'F64 -> Int -> WasmInstr w ('F64 : pre) pre
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]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_UF_Conv: unreachable"

-- | Lower a 'MO_Cmpxchg' operation to inline assembly. Currently we
-- target wasm without atomics and threads, so it's just lowered to
-- regular memory loads and stores.
lower_MO_Cmpxchg ::
  CLabel ->
  Width ->
  [CmmFormal] ->
  [CmmActual] ->
  WasmCodeGenM w (WasmStatements w)
lower_MO_Cmpxchg :: forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_Cmpxchg CLabel
lbl Width
w0 [LocalReg
reg] [CmmExpr
ptr, CmmExpr
expected, CmmExpr
new] =
  case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
ty_cmm of
    SomeWasmType WasmTypeTag t
ty -> do
      Int
reg_i <- WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg
      let narrowing :: Maybe Int
narrowing = WasmTypeTag t -> CmmType -> Maybe Int
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) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
expected_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
expected
      WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
new_instr <- CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
new
      WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre (w : pre)
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
            WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr w (w : pre) (t : pre)
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
            WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : pre) -> WasmInstr w pre (t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : pre) (t : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : pre) (t : pre)
WasmLocalTee WasmTypeTag t
ty Int
reg_i
            WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (t : t : pre)
-> WasmInstr w pre (t : t : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (t : t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
expected_instr
            WasmInstr w pre (t : t : pre)
-> WasmInstr w (t : t : pre) (w : pre) -> WasmInstr w pre (w : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq WasmTypeTag t
ty
            WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w pre pre -> WasmInstr w (w : pre) pre
forall (a :: WasmType) (c :: [WasmType]).
WasmInstr a c c -> WasmInstr a (a : c) c
WasmCond
              ( WasmInstr w pre (w : pre)
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
                  WasmInstr w pre (w : pre)
-> WasmInstr w (w : pre) (t : w : pre)
-> WasmInstr w pre (t : w : pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (w : pre) (t : w : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
new_instr
                  WasmInstr w pre (t : w : pre)
-> WasmInstr w (t : w : pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t
-> Maybe Int
-> Int
-> AlignmentSpec
-> WasmInstr w (t : w : pre) pre
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]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"lower_MO_Cmpxchg: unreachable"

-- | Lower a 'CallishMachOp'.
lower_CallishMachOp ::
  CLabel ->
  CallishMachOp ->
  [CmmFormal] ->
  [CmmActual] ->
  WasmCodeGenM w (WasmStatements w)
lower_CallishMachOp :: forall (w :: WasmType).
CLabel
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Pwr [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
"pow" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sin [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sin" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Cos [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cos" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Tan [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tan" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sinh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Cosh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cosh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Tanh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Asin [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asin" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Acos [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acos" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Atan [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atan" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Asinh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Acosh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acosh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Atanh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Log [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Log1P [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log1p" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Exp [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"exp" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_ExpM1 [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expm1" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Fabs [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"fabs" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sqrt [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sqrt" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Pwr [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
"powf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sin [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Cos [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cosf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Tan [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sinh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Cosh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"coshf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Tanh [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Asin [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Acos [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acosf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Atan [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Asinh [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Acosh [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acoshf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Atanh [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Log [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"logf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Log1P [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log1pf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Exp [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_ExpM1 [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expm1f" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Fabs [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"fabsf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sqrt [LocalReg]
rs [CmmExpr]
xs = CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sqrtf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_UF_Conv Width
w0) [LocalReg]
rs [CmmExpr]
xs = CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_UF_Conv CLabel
lbl Width
w0 [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
_ CallishMachOp
MO_ReadBarrier [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_WriteBarrier [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_Touch [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ (MO_Prefetch_Data {}) [LocalReg]
_ [CmmExpr]
_ = WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements WasmInstr w pre pre
forall (pre :: [WasmType]). WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
lbl (MO_Memcpy {}) [] [CmmExpr]
xs = do
  CmmType
ty_word_cmm <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
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 <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
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 <- WasmCodeGenM w CmmType
forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
  CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
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 =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left SymName
"memcmp")
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_PopCnt Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_popcnt" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Pdep Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_pdep" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Pext Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_pext" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Clz Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_clz" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Ctz Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_ctz" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_BSwap Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_bswap" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_BRev Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_bitrev" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_AtomicRMW Width
w0 AtomicMachOp
op) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    ( SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$
        String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$
          ( case AtomicMachOp
op of
              AtomicMachOp
AMO_Add -> String
"hs_atomic_add"
              AtomicMachOp
AMO_Sub -> String
"hs_atomic_sub"
              AtomicMachOp
AMO_And -> String
"hs_atomic_and"
              AtomicMachOp
AMO_Nand -> String
"hs_atomic_nand"
              AtomicMachOp
AMO_Or -> String
"hs_atomic_or"
              AtomicMachOp
AMO_Xor -> String
"hs_atomic_xor"
          )
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0)
    )
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_AtomicRead Width
w0 MemoryOrdering
_) [LocalReg
reg] [CmmExpr
ptr] = do
  SomeWasmExpr WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
ret_instr) <-
    CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad
      CLabel
lbl
      CmmExpr
ptr
      (Width -> CmmType
cmmBits Width
w0)
      AlignmentSpec
NaturallyAligned
  Int
ri <- WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg
  WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$ (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$ WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
ret_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : pre) pre
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] =
  CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
lower_CmmStore CLabel
lbl CmmExpr
ptr CmmExpr
val AlignmentSpec
NaturallyAligned
lower_CallishMachOp CLabel
lbl (MO_Cmpxchg Width
w0) [LocalReg]
rs [CmmExpr]
xs = CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_Cmpxchg CLabel
lbl Width
w0 [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Xchg Width
w0) [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left (SymName -> Either SymName CmmExpr)
-> SymName -> Either SymName CmmExpr
forall a b. (a -> b) -> a -> b
$ String -> SymName
forall a. IsString a => String -> a
fromString (String -> SymName) -> String -> SymName
forall a b. (a -> b) -> a -> b
$ String
"hs_xchg" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_SuspendThread [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left SymName
"suspendThread")
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_ResumeThread [LocalReg]
rs [CmmExpr]
xs =
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left SymName
"resumeThread")
    Maybe ([ForeignHint], [ForeignHint])
forall a. Maybe a
Nothing
    CmmReturnInfo
CmmMayReturn
    [LocalReg]
rs
    [CmmExpr]
xs
lower_CallishMachOp CLabel
_ CallishMachOp
_ [LocalReg]
_ [CmmExpr]
_ = String -> WasmCodeGenM w (WasmStatements w)
forall a. HasCallStack => String -> a
panic String
"lower_CallishMachOp: unreachable"

-- | Lower a ccall, but drop the result by assigning it to an unused
-- local. This is only used for lowering 'MO_Memcpy' and such, where
-- the libc functions do have a return value, but the corresponding
-- 'CallishMachOp' does not expect one.
lower_CmmUnsafeForeignCall_Drop ::
  CLabel ->
  SymName ->
  CmmType ->
  [CmmActual] ->
  WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop :: forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
sym_callee CmmType
ret_cmm_ty [CmmExpr]
arg_exprs = do
  Unique
ret_uniq <- WasmCodeGenM w Unique
forall (w :: WasmType). WasmCodeGenM w Unique
wasmUniq
  let ret_local :: LocalReg
ret_local = Unique -> CmmType -> LocalReg
LocalReg Unique
ret_uniq CmmType
ret_cmm_ty
  CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
    CLabel
lbl
    (SymName -> Either SymName CmmExpr
forall a b. a -> Either a b
Left SymName
sym_callee)
    Maybe ([ForeignHint], [ForeignHint])
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 <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  SomeWasmPreCCall TypeList ts
arg_tys forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr <-
    ((CmmExpr, ForeignHint)
 -> SomeWasmPreCCall w -> WasmCodeGenM w (SomeWasmPreCCall w))
-> SomeWasmPreCCall w
-> [(CmmExpr, ForeignHint)]
-> WasmCodeGenM w (SomeWasmPreCCall w)
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 <- CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
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 ->
                  Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword
                    (Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
arg_expr)
                    WasmTypeTag t
arg_ty
                    WasmExpr w t
arg_wasm_expr
                ForeignHint
_ -> WasmExpr w t
arg_wasm_expr
          SomeWasmPreCCall w -> WasmCodeGenM w (SomeWasmPreCCall w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmPreCCall w -> WasmCodeGenM w (SomeWasmPreCCall w))
-> SomeWasmPreCCall w -> WasmCodeGenM w (SomeWasmPreCCall w)
forall a b. (a -> b) -> a -> b
$
            TypeList (t : ts)
-> (forall {pre :: [WasmType]}.
    WasmInstr w pre (WasmPushes (t : ts) pre))
-> SomeWasmPreCCall w
forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (pre :: [WasmType]).
    WasmInstr w pre (WasmPushes ts pre))
-> SomeWasmPreCCall w
SomeWasmPreCCall (WasmTypeTag t
arg_ty WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
forall (t :: WasmType) (ts :: [WasmType]).
WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
`TypeListCons` TypeList ts
acc_tys) ((forall {pre :: [WasmType]}.
  WasmInstr w pre (WasmPushes (t : ts) pre))
 -> SomeWasmPreCCall w)
-> (forall {pre :: [WasmType]}.
    WasmInstr w pre (WasmPushes (t : ts) pre))
-> SomeWasmPreCCall w
forall a b. (a -> b) -> a -> b
$
              WasmInstr w pre (t : pre)
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
arg_instr WasmInstr w pre (t : pre)
-> WasmInstr w (t : pre) (WasmPushes ts (t : pre))
-> WasmInstr w pre (WasmPushes ts (t : pre))
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (t : pre) (WasmPushes ts (t : pre))
forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
acc_instr
      )
      (TypeList '[]
-> (forall (pre :: [WasmType]).
    WasmInstr w pre (WasmPushes '[] pre))
-> SomeWasmPreCCall w
forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (pre :: [WasmType]).
    WasmInstr w pre (WasmPushes ts pre))
-> SomeWasmPreCCall w
SomeWasmPreCCall TypeList '[]
TypeListNil WasmInstr w pre pre
WasmInstr w pre (WasmPushes '[] pre)
forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes '[] pre)
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 <-
    ((LocalReg, ForeignHint)
 -> SomeWasmPostCCall w -> WasmCodeGenM w (SomeWasmPostCCall w))
-> SomeWasmPostCCall w
-> [(LocalReg, ForeignHint)]
-> WasmCodeGenM w (SomeWasmPostCCall w)
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) <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
          SomeWasmPostCCall w -> WasmCodeGenM w (SomeWasmPostCCall w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeWasmPostCCall w -> WasmCodeGenM w (SomeWasmPostCCall w))
-> SomeWasmPostCCall w -> WasmCodeGenM w (SomeWasmPostCCall w)
forall a b. (a -> b) -> a -> b
$
            TypeList (t : ts)
-> (forall {post :: [WasmType]}.
    WasmInstr w (WasmPushes (t : ts) post) post)
-> SomeWasmPostCCall w
forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (post :: [WasmType]).
    WasmInstr w (WasmPushes ts post) post)
-> SomeWasmPostCCall w
SomeWasmPostCCall (WasmTypeTag t
reg_ty WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
forall (t :: WasmType) (ts :: [WasmType]).
WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
`TypeListCons` TypeList ts
acc_tys) ((forall {post :: [WasmType]}.
  WasmInstr w (WasmPushes (t : ts) post) post)
 -> SomeWasmPostCCall w)
-> (forall {post :: [WasmType]}.
    WasmInstr w (WasmPushes (t : ts) post) post)
-> SomeWasmPostCCall w
forall a b. (a -> b) -> a -> b
$
              case (# ForeignHint
ret_hint, Platform -> CmmReg -> Width
cmmRegWidth Platform
platform (CmmReg -> Width) -> CmmReg -> Width
forall a b. (a -> b) -> a -> b
$ LocalReg -> CmmReg
CmmLocal LocalReg
reg #) of
                (# ForeignHint
SignedHint, Width
W8 #) ->
                  WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr
                    WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) (t : t : post)
-> WasmInstr w (WasmPushes ts (t : post)) (t : t : post)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Integer -> WasmInstr w (t : post) (t : t : post)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
reg_ty Integer
0xFF
                    WasmInstr w (WasmPushes ts (t : post)) (t : t : post)
-> WasmInstr w (t : t : post) (t : post)
-> WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : post) (t : post)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
reg_ty
                    WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) post
-> WasmInstr w (WasmPushes ts (t : post)) post
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : post) post
forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
                (# ForeignHint
SignedHint, Width
W16 #) ->
                  WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr
                    WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) (t : t : post)
-> WasmInstr w (WasmPushes ts (t : post)) (t : t : post)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Integer -> WasmInstr w (t : post) (t : t : post)
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
reg_ty Integer
0xFFFF
                    WasmInstr w (WasmPushes ts (t : post)) (t : t : post)
-> WasmInstr w (t : t : post) (t : post)
-> WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> WasmInstr w (t : t : post) (t : post)
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
reg_ty
                    WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) post
-> WasmInstr w (WasmPushes ts (t : post)) post
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : post) post
forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
                (# ForeignHint, Width #)
_ -> WasmInstr w (WasmPushes ts (t : post)) (t : post)
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr WasmInstr w (WasmPushes ts (t : post)) (t : post)
-> WasmInstr w (t : post) post
-> WasmInstr w (WasmPushes ts (t : post)) post
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmTypeTag t -> Int -> WasmInstr w (t : post) post
forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
      )
      (TypeList '[]
-> (forall (post :: [WasmType]).
    WasmInstr w (WasmPushes '[] post) post)
-> SomeWasmPostCCall w
forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (post :: [WasmType]).
    WasmInstr w (WasmPushes ts post) post)
-> SomeWasmPostCCall w
SomeWasmPostCCall TypeList '[]
TypeListNil WasmInstr w post post
WasmInstr w (WasmPushes '[] post) post
forall (post :: [WasmType]). WasmInstr w (WasmPushes '[] post) post
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 <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
      let arg_cmm_tys :: [CmmType]
arg_cmm_tys = (CmmExpr -> CmmType) -> [CmmExpr] -> [CmmType]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) [CmmExpr]
arg_exprs
          ret_cmm_tys :: [CmmType]
ret_cmm_tys = (LocalReg -> CmmType) -> [LocalReg] -> [CmmType]
forall a b. (a -> b) -> [a] -> [b]
map LocalReg -> CmmType
localRegType [LocalReg]
ret_locals
      SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
sym_callee [CmmType]
arg_cmm_tys [CmmType]
ret_cmm_tys
      WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre (WasmPushes ts pre)
forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr
            WasmInstr w pre (WasmPushes ts pre)
-> WasmInstr w (WasmPushes ts pre) (WasmPushes ts pre)
-> WasmInstr w pre (WasmPushes ts pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` SymName -> WasmInstr w (WasmPushes ts pre) (WasmPushes ts pre)
forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
sym_callee
            WasmInstr w pre (WasmPushes ts pre)
-> WasmInstr w (WasmPushes ts pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` ( case CmmReturnInfo
ret_info of
                             CmmReturnInfo
CmmMayReturn -> WasmInstr w (WasmPushes ts pre) pre
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr
                             CmmReturnInfo
CmmNeverReturns -> WasmInstr w (WasmPushes ts pre) pre
forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
WasmInstr a b c
WasmUnreachable
                         )
    Right CmmExpr
fptr_callee -> do
      (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
instr_callee, Int
_) <- CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
fptr_callee
      WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmStatements w -> WasmCodeGenM w (WasmStatements w))
-> WasmStatements w -> WasmCodeGenM w (WasmStatements w)
forall a b. (a -> b) -> a -> b
$
        (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements ((forall (pre :: [WasmType]). WasmInstr w pre pre)
 -> WasmStatements w)
-> (forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
forall a b. (a -> b) -> a -> b
$
          WasmInstr w pre (WasmPushes ts pre)
forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr
            WasmInstr w pre (WasmPushes ts pre)
-> WasmInstr w (WasmPushes ts pre) (w : WasmPushes ts pre)
-> WasmInstr w pre (w : WasmPushes ts pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` WasmInstr w (WasmPushes ts pre) (w : WasmPushes ts pre)
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
instr_callee
            WasmInstr w pre (w : WasmPushes ts pre)
-> WasmInstr w (w : WasmPushes ts pre) (WasmPushes ts pre)
-> WasmInstr w pre (WasmPushes ts pre)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` TypeList ts
-> TypeList ts
-> WasmInstr w (w : WasmPushes ts pre) (WasmPushes ts pre)
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
            WasmInstr w pre (WasmPushes ts pre)
-> WasmInstr w (WasmPushes ts pre) pre -> WasmInstr w pre pre
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
       (c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` ( case CmmReturnInfo
ret_info of
                             CmmReturnInfo
CmmMayReturn -> WasmInstr w (WasmPushes ts pre) pre
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr
                             CmmReturnInfo
CmmNeverReturns -> WasmInstr w (WasmPushes ts pre) pre
forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
WasmInstr a b c
WasmUnreachable
                         )
  where
    (# [(CmmExpr, ForeignHint)]
arg_exprs_hints, [(LocalReg, ForeignHint)]
ret_locals_hints #) = case Maybe ([ForeignHint], [ForeignHint])
mb_hints of
      Just ([ForeignHint]
arg_hints, [ForeignHint]
ret_hints) ->
        (# [CmmExpr] -> [ForeignHint] -> [(CmmExpr, ForeignHint)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CmmExpr]
arg_exprs [ForeignHint]
arg_hints, [LocalReg] -> [ForeignHint] -> [(LocalReg, ForeignHint)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LocalReg]
ret_locals [ForeignHint]
ret_hints #)
      Maybe ([ForeignHint], [ForeignHint])
_ -> (# (CmmExpr -> (CmmExpr, ForeignHint))
-> [CmmExpr] -> [(CmmExpr, ForeignHint)]
forall a b. (a -> b) -> [a] -> [b]
map (,ForeignHint
NoHint) [CmmExpr]
arg_exprs, (LocalReg -> (LocalReg, ForeignHint))
-> [LocalReg] -> [(LocalReg, ForeignHint)]
forall a b. (a -> b) -> [a] -> [b]
map (,ForeignHint
NoHint) [LocalReg]
ret_locals #)

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

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

-- | Lower a 'CmmGraph'.
lower_CmmGraph :: CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph :: forall (w :: WasmType).
CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph CLabel
lbl CmmGraph
g = do
  WasmTypeTag w
ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  Platform
platform <- WasmCodeGenM w Platform
forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
  WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32]
body <-
    Platform
-> (BlockId -> CmmExpr -> WasmCodeGenM w (WasmExpr w w))
-> (BlockId
    -> Block CmmNode O O -> WasmCodeGenM w (WasmStatements w))
-> CmmGraph
-> WasmCodeGenM
     w (WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32])
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
_ -> CLabel -> WasmTypeTag w -> CmmExpr -> WasmCodeGenM w (WasmExpr w w)
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word)
      (CLabel
-> BlockId
-> Block CmmNode O O
-> WasmCodeGenM w (WasmStatements w)
forall (w :: WasmType).
CLabel
-> BlockId
-> Block CmmNode O O
-> WasmCodeGenM w (WasmStatements w)
lower_CmmActions CLabel
lbl)
      CmmGraph
g
  [SomeWasmType]
locals <- (WasmCodeGenState w -> (# [SomeWasmType], WasmCodeGenState w #))
-> WasmCodeGenM w [SomeWasmType]
forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM ((WasmCodeGenState w -> (# [SomeWasmType], WasmCodeGenState w #))
 -> WasmCodeGenM w [SomeWasmType])
-> (WasmCodeGenState w -> (# [SomeWasmType], WasmCodeGenState w #))
-> WasmCodeGenM w [SomeWasmType]
forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
    (#
      ((Int, SomeWasmType) -> SomeWasmType)
-> [(Int, SomeWasmType)] -> [SomeWasmType]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SomeWasmType) -> SomeWasmType
forall a b. (a, b) -> b
snd ([(Int, SomeWasmType)] -> [SomeWasmType])
-> [(Int, SomeWasmType)] -> [SomeWasmType]
forall a b. (a -> b) -> a -> b
$ UniqFM LocalReg (Int, SomeWasmType) -> [(Int, SomeWasmType)]
forall k k0 a. Ord k => UniqFM k0 (k, a) -> [(k, a)]
detEltsUFM (UniqFM LocalReg (Int, SomeWasmType) -> [(Int, SomeWasmType)])
-> UniqFM LocalReg (Int, SomeWasmType) -> [(Int, SomeWasmType)]
forall a b. (a -> b) -> a -> b
$ WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegs WasmCodeGenState w
s,
      WasmCodeGenState w
s {localRegs = emptyUFM, localRegsCount = 0}
    #)
  FuncBody w -> WasmCodeGenM w (FuncBody w)
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FuncBody {funcLocals :: [SomeWasmType]
funcLocals = [SomeWasmType]
locals, funcBody :: WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
funcBody = WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32]
-> WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
forall s e (pre :: [WasmType]) (post :: [WasmType])
       (pre' :: [WasmType]) (post' :: [WasmType]).
WasmControl s e pre post -> WasmControl s e pre' post'
wasmControlCast (WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32]
 -> WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w])
-> WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32]
-> WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
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 -> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM ((WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ())
-> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
    WasmCodeGenState w
s
      { defaultSyms =
          IS.insert
            (getKey $ getUnique sym)
            $ defaultSyms s
      }
  SymVisibility
_ -> () -> WasmCodeGenM w ()
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl

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

-- | Invoked for each function 'CLabel' with known type (e.g. a
-- 'CmmProc', or callee of 'CmmUnsafeForeignCall').
onFuncSym :: SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym :: forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
sym [CmmType]
arg_tys [CmmType]
ret_tys = (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM ((WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ())
-> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$
  \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
IntSet
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
Platform
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> IntSet
wasmPlatform :: Platform
defaultSyms :: IntSet
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: SymMap (FuncBody w)
dataSections :: SymMap DataSection
ctors :: [SymName]
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: Int
wasmUniqSupply :: UniqSupply
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
..} ->
    WasmCodeGenState w
s
      { funcTypes =
          addToUniqMap
            funcTypes
            sym
            ( map someWasmTypeFromCmmType arg_tys,
              map someWasmTypeFromCmmType ret_tys
            )
      }

-- | Invoked for all other 'CLabel's along the way, e.g. in
-- 'CmmStatic's or 'CmmExpr's.
onAnySym :: CLabel -> WasmCodeGenM w ()
onAnySym :: forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl = case SymKind
sym_kind of
  SymKind
SymFunc -> do
    WasmTypeTag w
ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
    (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM ((WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ())
-> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
IntSet
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
Platform
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> IntSet
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
wasmPlatform :: Platform
defaultSyms :: IntSet
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: SymMap (FuncBody w)
dataSections :: SymMap DataSection
ctors :: [SymName]
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: Int
wasmUniqSupply :: UniqSupply
..} ->
      WasmCodeGenState w
s {funcTypes = addToUniqMap_C const funcTypes sym ([], [SomeWasmType ty_word])}
  SymKind
_ -> () -> WasmCodeGenM w ()
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl

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

-- | Invoked for each 'LocalReg', returning its wasm local id and
-- representation type.
onCmmLocalReg :: LocalReg -> WasmCodeGenM w LocalInfo
onCmmLocalReg :: forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg = (WasmCodeGenState w
 -> (# (Int, SomeWasmType), WasmCodeGenState w #))
-> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM ((WasmCodeGenState w
  -> (# (Int, SomeWasmType), WasmCodeGenState w #))
 -> WasmCodeGenM w (Int, SomeWasmType))
-> (WasmCodeGenState w
    -> (# (Int, SomeWasmType), WasmCodeGenState w #))
-> WasmCodeGenM w (Int, SomeWasmType)
forall a b. (a -> b) -> a -> b
$ \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
IntSet
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
Platform
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> IntSet
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
wasmPlatform :: Platform
defaultSyms :: IntSet
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: SymMap (FuncBody w)
dataSections :: SymMap DataSection
ctors :: [SymName]
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegsCount :: Int
wasmUniqSupply :: UniqSupply
..} ->
  let reg_info :: (Int, SomeWasmType)
reg_info =
        (Int
localRegsCount, CmmType -> SomeWasmType
someWasmTypeFromCmmType (CmmType -> SomeWasmType) -> CmmType -> SomeWasmType
forall a b. (a -> b) -> a -> b
$ LocalReg -> CmmType
localRegType LocalReg
reg)
   in case (LocalReg
 -> (Int, SomeWasmType)
 -> (Int, SomeWasmType)
 -> (Int, SomeWasmType))
-> LocalReg
-> (Int, SomeWasmType)
-> UniqFM LocalReg (Int, SomeWasmType)
-> (Maybe (Int, SomeWasmType), UniqFM LocalReg (Int, SomeWasmType))
forall key elt.
Uniquable key =>
(key -> elt -> elt -> elt)
-> key -> elt -> UniqFM key elt -> (Maybe elt, UniqFM key elt)
addToUFM_L (\LocalReg
_ (Int, SomeWasmType)
i (Int, SomeWasmType)
_ -> (Int, SomeWasmType)
i) LocalReg
reg (Int, SomeWasmType)
reg_info UniqFM LocalReg (Int, SomeWasmType)
localRegs of
        (Just (Int, SomeWasmType)
i, UniqFM LocalReg (Int, SomeWasmType)
_) -> (# (Int, SomeWasmType)
i, WasmCodeGenState w
s #)
        (Maybe (Int, SomeWasmType)
_, UniqFM LocalReg (Int, SomeWasmType)
localRegs') ->
          (#
            (Int, SomeWasmType)
reg_info,
            WasmCodeGenState w
s
              { localRegs = localRegs',
                localRegsCount =
                  localRegsCount + 1
              }
          #)

-- | Invoked for each 'LocalReg' with expected representation type,
-- only returning its wasm local id.
onCmmLocalReg_Typed :: WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed :: forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg = do
  (Int
i, SomeWasmType WasmTypeTag t
ty') <- LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
  if
      | Just t :~: t
Refl <- WasmTypeTag t
ty' WasmTypeTag t -> WasmTypeTag t -> Maybe (t :~: t)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: WasmType) (b :: WasmType).
WasmTypeTag a -> WasmTypeTag b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
ty -> Int -> WasmCodeGenM w Int
forall a. a -> WasmCodeGenM w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
      | Bool
otherwise -> String -> WasmCodeGenM w Int
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 = [SymName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SymName]
syms
  Bool -> WasmCodeGenM w () -> WasmCodeGenM w ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n_finis Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (WasmCodeGenM w () -> WasmCodeGenM w ())
-> WasmCodeGenM w () -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ String -> WasmCodeGenM w ()
forall a. HasCallStack => String -> a
panic String
"dtors unsupported by wasm32 NCG"

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

-- | Invoked for each data section.
onCmmData :: CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData :: forall (w :: WasmType).
CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData CLabel
lbl Section
s [CmmStatic]
statics = do
  WasmTypeTag w
ty_word <- WasmCodeGenM w (WasmTypeTag w)
forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
  CLabel -> WasmCodeGenM w ()
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onTopSym CLabel
lbl
  [DataSectionContent]
cs <- [CmmStatic]
-> (CmmStatic -> WasmCodeGenM w DataSectionContent)
-> WasmCodeGenM w [DataSectionContent]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CmmStatic]
statics CmmStatic -> WasmCodeGenM w DataSectionContent
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 =
              WasmTypeTag w -> [DataSectionContent] -> Alignment
forall (w :: WasmType).
WasmTypeTag w -> [DataSectionContent] -> Alignment
alignmentFromCmmSection WasmTypeTag w
ty_word [DataSectionContent]
cs,
            dataSectionContents :: [DataSectionContent]
dataSectionContents =
              case [DataSectionContent]
cs of
                [DataASCII ByteString
buf] -> [ByteString -> DataSectionContent
DataASCII (ByteString -> DataSectionContent)
-> ByteString -> DataSectionContent
forall a b. (a -> b) -> a -> b
$ ByteString
buf ByteString -> Word8 -> ByteString
`BS.snoc` Word8
0]
                [DataIncBin String
p Int
l] -> [String -> Int -> DataSectionContent
DataIncBin String
p Int
l, Word8 -> DataSectionContent
DataI8 Word8
0]
                [DataSectionContent]
_ -> [DataSectionContent]
cs
          }
  (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM ((WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ())
-> (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
    WasmCodeGenState w
s
      { dataSections =
          addToUniqMap (dataSections s) sym sec
      }

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

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

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