{-# 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
someWasmTypeFromCmmType :: CmmType -> SomeWasmType
someWasmTypeFromCmmType :: CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t
| CmmType -> Bool
isWord32 CmmType
t = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
| CmmType -> Bool
isWord64 CmmType
t = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I64
TagI64
| CmmType
t CmmType -> CmmType -> Bool
`cmmEqType` CmmType
b16 = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
| CmmType
t CmmType -> CmmType -> Bool
`cmmEqType` CmmType
b8 = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I32
TagI32
| CmmType -> Bool
isFloat64 CmmType
t = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F64
TagF64
| CmmType -> Bool
isFloat32 CmmType
t = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F32
TagF32
| Bool
otherwise =
forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$
String
"someWasmTypeFromCmmType: unsupported CmmType "
forall a. Semigroup a => a -> a -> a
<> SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext (forall a. Outputable a => a -> SDoc
ppr CmmType
t)
wasmMemoryNarrowing :: WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing :: forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm = case (# WasmTypeTag t
ty, CmmType -> Width
typeWidth CmmType
ty_cmm #) of
(# WasmTypeTag t
TagI32, Width
W8 #) -> forall a. a -> Maybe a
Just Int
8
(# WasmTypeTag t
TagI32, Width
W16 #) -> forall a. a -> Maybe a
Just Int
16
(# WasmTypeTag t
TagI32, Width
W32 #) -> forall a. Maybe a
Nothing
(# WasmTypeTag t
TagI64, Width
W8 #) -> forall a. a -> Maybe a
Just Int
8
(# WasmTypeTag t
TagI64, Width
W16 #) -> forall a. a -> Maybe a
Just Int
16
(# WasmTypeTag t
TagI64, Width
W32 #) -> forall a. a -> Maybe a
Just Int
32
(# WasmTypeTag t
TagI64, Width
W64 #) -> forall a. Maybe a
Nothing
(# WasmTypeTag t
TagF32, Width
W32 #) -> forall a. Maybe a
Nothing
(# WasmTypeTag t
TagF64, Width
W64 #) -> forall a. Maybe a
Nothing
(# WasmTypeTag t, Width #)
_ -> forall a. HasCallStack => String -> a
panic String
"wasmMemoryNarrowing: unreachable"
symNameFromCLabel :: CLabel -> SymName
symNameFromCLabel :: CLabel -> SymName
symNameFromCLabel CLabel
lbl =
forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$
SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext {sdocStyle :: PprStyle
sdocStyle = PprStyle
PprCode} forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
genericPlatform CLabel
lbl
symVisibilityFromCLabel :: CLabel -> SymVisibility
symVisibilityFromCLabel :: CLabel -> SymVisibility
symVisibilityFromCLabel CLabel
lbl
| CLabel -> Bool
externallyVisibleCLabel CLabel
lbl = SymVisibility
SymDefault
| Bool
otherwise = SymVisibility
SymStatic
symKindFromCLabel :: CLabel -> SymKind
symKindFromCLabel :: CLabel -> SymKind
symKindFromCLabel CLabel
lbl
| CLabel -> Bool
isCFunctionLabel CLabel
lbl = SymKind
SymFunc
| Bool
otherwise = SymKind
SymData
dataSectionKindFromCmmSection :: Section -> DataSectionKind
dataSectionKindFromCmmSection :: Section -> DataSectionKind
dataSectionKindFromCmmSection Section
s = case Section -> SectionProtection
sectionProtection Section
s of
SectionProtection
ReadWriteSection -> DataSectionKind
SectionData
SectionProtection
_ -> DataSectionKind
SectionROData
alignmentFromWordType :: WasmTypeTag w -> Alignment
alignmentFromWordType :: forall (w :: WasmType). WasmTypeTag w -> Alignment
alignmentFromWordType WasmTypeTag w
TagI32 = Int -> Alignment
mkAlignment Int
4
alignmentFromWordType WasmTypeTag w
TagI64 = Int -> Alignment
mkAlignment Int
8
alignmentFromWordType WasmTypeTag w
_ = forall a. HasCallStack => String -> a
panic String
"alignmentFromWordType: unreachable"
alignmentFromCmmSection :: WasmTypeTag w -> [DataSectionContent] -> Alignment
alignmentFromCmmSection :: forall (w :: WasmType).
WasmTypeTag w -> [DataSectionContent] -> Alignment
alignmentFromCmmSection WasmTypeTag w
_ [DataASCII {}] = Int -> Alignment
mkAlignment Int
1
alignmentFromCmmSection WasmTypeTag w
_ [DataIncBin {}] = Int -> Alignment
mkAlignment Int
1
alignmentFromCmmSection WasmTypeTag w
t [DataSectionContent]
_ = forall (w :: WasmType). WasmTypeTag w -> Alignment
alignmentFromWordType WasmTypeTag w
t
lower_CmmStatic :: CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic :: forall (w :: WasmType).
CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic CmmStatic
s = case CmmStatic
s of
CmmStaticLit (CmmInt Integer
i Width
W8) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word8 -> DataSectionContent
DataI8 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W8 Integer
i
CmmStaticLit (CmmInt Integer
i Width
W16) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word16 -> DataSectionContent
DataI16 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W16 Integer
i
CmmStaticLit (CmmInt Integer
i Width
W32) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> DataSectionContent
DataI32 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W32 Integer
i
CmmStaticLit (CmmInt Integer
i Width
W64) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word64 -> DataSectionContent
DataI64 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Width -> Integer -> Integer
narrowU Width
W64 Integer
i
CmmStaticLit (CmmFloat Rational
f Width
W32) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Float -> DataSectionContent
DataF32 forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
f
CmmStaticLit (CmmFloat Rational
d Width
W64) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> DataSectionContent
DataF64 forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
d
CmmStaticLit (CmmLabel CLabel
lbl) ->
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SymName -> Int -> DataSectionContent
DataSym
(CLabel -> SymName
symNameFromCLabel CLabel
lbl)
Int
0
CmmStaticLit (CmmLabelOff CLabel
lbl Int
o) ->
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SymName -> Int -> DataSectionContent
DataSym
(CLabel -> SymName
symNameFromCLabel CLabel
lbl)
Int
o
CmmUninitialised Int
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> DataSectionContent
DataSkip Int
i
CmmString ByteString
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> DataSectionContent
DataASCII ByteString
b
CmmFileEmbed String
f Int
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Int -> DataSectionContent
DataIncBin String
f Int
l
CmmStatic
_ -> forall a. HasCallStack => String -> a
panic String
"lower_CmmStatic: unreachable"
globalInfoFromCmmGlobalReg :: WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg :: forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
t GlobalReg
reg = case GlobalReg
reg of
VanillaReg Int
i VGcPtr
_
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
10 -> forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"__R" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i, SomeWasmType
ty_word)
FloatReg Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
6 ->
forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"__F" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i, forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F32
TagF32)
DoubleReg Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
6 ->
forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"__D" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i, forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'F64
TagF64)
LongReg Int
i
| Int
i forall a. Eq a => a -> a -> Bool
== Int
1 -> forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"__L" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i, forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag 'I64
TagI64)
GlobalReg
Sp -> forall a. a -> Maybe a
Just (SymName
"__Sp", SomeWasmType
ty_word)
GlobalReg
SpLim -> forall a. a -> Maybe a
Just (SymName
"__SpLim", SomeWasmType
ty_word)
GlobalReg
Hp -> forall a. a -> Maybe a
Just (SymName
"__Hp", SomeWasmType
ty_word)
GlobalReg
HpLim -> forall a. a -> Maybe a
Just (SymName
"__HpLim", SomeWasmType
ty_word)
GlobalReg
_ -> forall a. Maybe a
Nothing
where
ty_word :: SomeWasmType
ty_word = forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag w
t
supportedCmmGlobalRegs :: [GlobalReg]
supportedCmmGlobalRegs :: [GlobalReg]
supportedCmmGlobalRegs =
[Int -> VGcPtr -> GlobalReg
VanillaReg Int
i VGcPtr
VGcPtr | Int
i <- [Int
1 .. Int
10]]
forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
FloatReg Int
i | Int
i <- [Int
1 .. Int
6]]
forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
DoubleReg Int
i | Int
i <- [Int
1 .. Int
6]]
forall a. Semigroup a => a -> a -> a
<> [Int -> GlobalReg
LongReg Int
i | Int
i <- [Int
1 .. Int
1]]
forall a. Semigroup a => a -> a -> a
<> [GlobalReg
Sp, GlobalReg
SpLim, GlobalReg
Hp, GlobalReg
HpLim]
truncSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword :: forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
W8 WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty Integer
0xFF forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
ty
truncSubword Width
W16 WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty Integer
0xFFFF forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
ty
truncSubword Width
_ WasmTypeTag t
_ WasmExpr w t
expr = WasmExpr w t
expr
extendSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword :: forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
W8 WasmTypeTag t
TagI32 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I32 : pre) ('I32 : pre)
WasmI32Extend8S
extendSubword Width
W16 WasmTypeTag t
TagI32 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I32 : pre) ('I32 : pre)
WasmI32Extend16S
extendSubword Width
W8 WasmTypeTag t
TagI64 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I64 : pre)
WasmI64Extend8S
extendSubword Width
W16 WasmTypeTag t
TagI64 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I64 : pre)
WasmI64Extend16S
extendSubword Width
W32 WasmTypeTag t
TagI64 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr) =
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I64 : pre)
WasmI64Extend32S
extendSubword Width
_ WasmTypeTag t
_ WasmExpr w t
expr = WasmExpr w t
expr
lower_MO_Un_Homo ::
( forall pre t.
WasmTypeTag t ->
WasmInstr
w
(t : pre)
(t : pre)
) ->
CLabel ->
CmmType ->
[CmmExpr] ->
WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Homo :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
op CLabel
lbl CmmType
t0 [CmmExpr
x] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0 of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
op WasmTypeTag t
ty
lower_MO_Un_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_Un_Homo: unreachable"
lower_MO_Bin_Homo ::
( forall pre t.
WasmTypeTag t ->
WasmInstr
w
(t : t : pre)
(t : pre)
) ->
CLabel ->
CmmType ->
[CmmExpr] ->
WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl CmmType
t0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0 of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Homo forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Homo: unreachable"
lower_MO_Bin_Homo_Trunc ::
(forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)) ->
CLabel ->
Width ->
[CmmExpr] ->
WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Homo_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Homo_Trunc: unreachable"
lower_MO_Bin_Homo_Ext_Trunc ::
(forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)) ->
CLabel ->
Width ->
[CmmExpr] ->
WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <-
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <-
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Homo_Ext_Trunc forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ =
forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Homo_Ext_Trunc: unreachable"
lower_MO_Bin_Rel_Ext ::
(forall pre t. WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)) ->
CLabel ->
Width ->
[CmmExpr] ->
WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] =
case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <-
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <-
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Rel_Ext forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
_ CLabel
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Rel_Ext: unreachable"
lower_MO_Bin_Rel ::
( forall pre t.
WasmTypeTag t ->
WasmInstr
w
(t : t : pre)
(w : pre)
) ->
CLabel ->
CmmType ->
[CmmExpr] ->
WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op CLabel
lbl CmmType
t0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0 of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
op WasmTypeTag t
ty
lower_MO_Bin_Rel forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
_ CLabel
_ CmmType
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_Bin_Rel: unreachable"
shiftRHSCast ::
CLabel ->
WasmTypeTag t ->
CmmExpr ->
WasmCodeGenM
w
(WasmExpr w t)
shiftRHSCast :: forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
t1 CmmExpr
x = do
SomeWasmExpr WasmTypeTag t
t0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
if
| Just t :~: t
Refl <- WasmTypeTag t
t0 forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
t1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
| WasmTypeTag t
TagI32 <- WasmTypeTag t
t0,
WasmTypeTag t
TagI64 <- WasmTypeTag t
t1 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Unsigned
| Bool
otherwise -> forall a. HasCallStack => String -> a
panic String
"shiftRHSCast: unreachable"
lower_MO_Shl ::
CLabel ->
Width ->
[CmmExpr] ->
WasmCodeGenM
w
(SomeWasmExpr w)
lower_MO_Shl :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Shl CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShl WasmTypeTag t
ty
lower_MO_Shl CLabel
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_Shl: unreachable"
lower_MO_U_Shr ::
CLabel ->
Width ->
[CmmExpr] ->
WasmCodeGenM
w
(SomeWasmExpr w)
lower_MO_U_Shr :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_U_Shr CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShr Signage
Unsigned WasmTypeTag t
ty
lower_MO_U_Shr CLabel
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_U_Shr: unreachable"
lower_MO_S_Shr ::
CLabel ->
Width ->
[CmmExpr] ->
WasmCodeGenM
w
(SomeWasmExpr w)
lower_MO_S_Shr :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_S_Shr CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w0) of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
shiftRHSCast CLabel
lbl WasmTypeTag t
ty CmmExpr
y
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w0 WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmShr Signage
Signed WasmTypeTag t
ty
lower_MO_S_Shr CLabel
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_S_Shr: unreachable"
lower_MO_MulMayOflo ::
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo :: forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo CLabel
lbl Width
w0 [CmmExpr
x, CmmExpr
y] = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
ty_cmm of
SomeWasmType WasmTypeTag t
ty -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"hs_mulIntMayOflo" [CmmType
ty_cmm, CmmType
ty_cmm] [CmmType
ty_cmm]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
"hs_mulIntMayOflo"
where
ty_cmm :: CmmType
ty_cmm = Width -> CmmType
cmmBits Width
w0
lower_MO_MulMayOflo CLabel
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_MulMayOflo: unreachable"
lower_MO_Un_Conv ::
( forall pre t0 t1.
WasmTypeTag t0 ->
WasmTypeTag t1 ->
WasmInstr w (t0 : pre) (t1 : pre)
) ->
CLabel ->
CmmType ->
CmmType ->
[CmmExpr] ->
WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv :: forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre)
op CLabel
lbl CmmType
t0 CmmType
t1 [CmmExpr
x] =
case (# CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t0, CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
t1 #) of
(# SomeWasmType WasmTypeTag t
ty0, SomeWasmType WasmTypeTag t
ty1 #) -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty0 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty1 forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre)
op WasmTypeTag t
ty0 WasmTypeTag t
ty1
lower_MO_Un_Conv forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre)
_ CLabel
_ CmmType
_ CmmType
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_Un_Conv: unreachable"
lower_MO_SS_Conv ::
CLabel ->
Width ->
Width ->
[CmmExpr] ->
WasmCodeGenM
w
(SomeWasmExpr w)
lower_MO_SS_Conv :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
| Width
w0 forall a. Eq a => a -> a -> Bool
== Width
w1 = forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align]
| Width
w0 forall a. Ord a => a -> a -> Bool
< Width
w1,
Width
w1 forall a. Ord a => a -> a -> Bool
<= Width
W32 = do
(WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
WasmTypeTag 'I32
TagI32
(forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag 'I32
TagI32 (Width -> CmmType
cmmBits Width
w0))
Signage
Signed
Int
o
AlignmentSpec
align
| Width
w0 forall a. Ord a => a -> a -> Bool
> Width
w1 =
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed
CLabel
lbl
CmmExpr
ptr
WasmTypeTag 'I32
TagI32
(Width -> CmmType
cmmBits Width
w1)
AlignmentSpec
align
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
W64 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align] = do
(WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
WasmTypeTag 'I64
TagI64
(forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag 'I64
TagI64 (Width -> CmmType
cmmBits Width
w0))
Signage
Signed
Int
o
AlignmentSpec
align
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
| Width
w0 forall a. Ord a => a -> a -> Bool
< Width
w1,
Width
w1 forall a. Ord a => a -> a -> Bool
<= Width
W32 = do
WasmExpr w 'I32
x_expr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag 'I32
TagI32 WasmExpr w 'I32
x_expr
| Width
W32 forall a. Ord a => a -> a -> Bool
>= Width
w0,
Width
w0 forall a. Ord a => a -> a -> Bool
> Width
w1 = do
WasmExpr w 'I32
x_expr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 WasmExpr w 'I32
x_expr
lower_MO_SS_Conv CLabel
lbl Width
W32 Width
W64 [CmmExpr
x] = do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Signed
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
W64 [CmmExpr
x] = do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword Width
w0 WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Unsigned
lower_MO_SS_Conv CLabel
lbl Width
W64 Width
w1 [CmmExpr
x] = do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I32 : pre)
WasmI32WrapI64
lower_MO_SS_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_SS_Conv: unreachable"
lower_MO_UU_Conv ::
CLabel ->
Width ->
Width ->
[CmmExpr] ->
WasmCodeGenM
w
(SomeWasmExpr w)
lower_MO_UU_Conv :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmLoad CmmExpr
ptr CmmType
_ AlignmentSpec
align] =
case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w1) of
SomeWasmType WasmTypeTag t
ty ->
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed
CLabel
lbl
CmmExpr
ptr
WasmTypeTag t
ty
(Width -> CmmType
cmmBits (forall a. Ord a => a -> a -> a
min Width
w0 Width
w1))
AlignmentSpec
align
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr
x]
| Width
w0 forall a. Eq a => a -> a -> Bool
== Width
w1 = forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
| Width
w0 forall a. Ord a => a -> a -> Bool
< Width
w1, Width
w1 forall a. Ord a => a -> a -> Bool
<= Width
W32 = forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
| Width
W32 forall a. Ord a => a -> a -> Bool
>= Width
w0,
Width
w0 forall a. Ord a => a -> a -> Bool
> Width
w1 = do
WasmExpr w 'I32
x_expr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 WasmExpr w 'I32
x_expr
lower_MO_UU_Conv CLabel
lbl Width
_ Width
W64 [CmmExpr
x] = do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I32
TagI32 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I64
TagI64 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre ('I32 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmInstr a ('I32 : pre) ('I64 : pre)
WasmI64ExtendI32 Signage
Unsigned
lower_MO_UU_Conv CLabel
lbl Width
W64 Width
w1 [CmmExpr
x] = do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'I64
TagI64 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
truncSubword Width
w1 WasmTypeTag 'I32
TagI32 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre ('I64 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('I64 : pre) ('I32 : pre)
WasmI32WrapI64
lower_MO_UU_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_UU_Conv: unreachable"
lower_MO_FF_Conv ::
CLabel ->
Width ->
Width ->
[CmmExpr] ->
WasmCodeGenM
w
(SomeWasmExpr w)
lower_MO_FF_Conv :: forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FF_Conv CLabel
lbl Width
W32 Width
W64 [CmmExpr
x] = do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F32
TagF32 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F64
TagF64 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre ('F32 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('F32 : pre) ('F64 : pre)
WasmF64PromoteF32
lower_MO_FF_Conv CLabel
lbl Width
W64 Width
W32 [CmmExpr
x] = do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag 'F64
TagF64 CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F32
TagF32 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre ('F64 : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (pre :: [WasmType]).
WasmInstr a ('F64 : pre) ('F32 : pre)
WasmF32DemoteF64
lower_MO_FF_Conv CLabel
_ Width
_ Width
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_FF_Conv: unreachable"
lower_CmmMachOp ::
CLabel ->
MachOp ->
[CmmExpr] ->
WasmCodeGenM
w
(SomeWasmExpr w)
lower_CmmMachOp :: forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp CLabel
lbl (MO_Add Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Sub Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmSub CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Eq Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Ne Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmNe CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Mul Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Trunc forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmMul CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_MulMayOflo Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_MulMayOflo CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Quot Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Signed)
CLabel
lbl
Width
w0
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Rem Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo_Ext_Trunc
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmRem Signage
Signed)
CLabel
lbl
Width
w0
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Neg Width
w0) [CmmExpr
x] =
forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp
CLabel
lbl
(Width -> MachOp
MO_Sub Width
w0)
[CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
w0, CmmExpr
x]
lower_CmmMachOp CLabel
lbl (MO_U_Quot Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Unsigned)
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Rem Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmRem Signage
Unsigned)
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Ge Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Signed)
CLabel
lbl
Width
w0
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Le Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Signed)
CLabel
lbl
Width
w0
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Gt Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Signed)
CLabel
lbl
Width
w0
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Lt Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel_Ext
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Signed)
CLabel
lbl
Width
w0
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Ge Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Unsigned)
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Le Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Unsigned)
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Gt Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Unsigned)
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Lt Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Unsigned)
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Add Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Sub Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmSub
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Neg Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Homo
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : pre) (t : pre)
WasmNeg
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Mul Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmMul
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Quot Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmDiv Signage
Signed)
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Eq Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Ne Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmNe
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Ge Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGe Signage
Signed)
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Le Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLe Signage
Signed)
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Gt Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmGt Signage
Signed)
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_F_Lt Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Rel
(forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
Signage -> WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmLt Signage
Signed)
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_And Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Or Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmOr CLabel
lbl (Width -> CmmType
cmmBits Width
w0) [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Xor Width
w0) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t :: WasmType).
WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre))
-> CLabel
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Bin_Homo
forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmXor
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_Not Width
w0) [CmmExpr
x] =
forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp
CLabel
lbl
(Width -> MachOp
MO_Xor Width
w0)
[CmmExpr
x, CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt (Width -> Integer
widthMax Width
w0) Width
w0]
lower_CmmMachOp CLabel
lbl (MO_Shl Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Shl CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_U_Shr Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_U_Shr CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_S_Shr Width
w0) [CmmExpr]
xs = forall (w :: WasmType).
CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_S_Shr CLabel
lbl Width
w0 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_SF_Conv Width
w0 Width
w1) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv
(forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
(pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmConvert Signage
Signed)
CLabel
lbl
(Width -> CmmType
cmmBits Width
w0)
(Width -> CmmType
cmmFloat Width
w1)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_FS_Conv Width
w0 Width
w1) [CmmExpr]
xs =
forall (w :: WasmType).
(forall (pre :: [WasmType]) (t0 :: WasmType) (t1 :: WasmType).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr w (t0 : pre) (t1 : pre))
-> CLabel
-> CmmType
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_Un_Conv
(forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
(pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmTruncSat Signage
Signed)
CLabel
lbl
(Width -> CmmType
cmmFloat Width
w0)
(Width -> CmmType
cmmBits Width
w1)
[CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_SS_Conv Width
w0 Width
w1) [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_SS_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_UU_Conv Width
w0 Width
w1) [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_XX_Conv Width
w0 Width
w1) [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_UU_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
lbl (MO_FF_Conv Width
w0 Width
w1) [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> Width -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_MO_FF_Conv CLabel
lbl Width
w0 Width
w1 [CmmExpr]
xs
lower_CmmMachOp CLabel
_ MachOp
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_CmmMachOp: unreachable"
lower_CmmLit :: CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit :: forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit CmmLit
lit = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
case CmmLit
lit of
CmmInt Integer
i Width
w -> case CmmType -> SomeWasmType
someWasmTypeFromCmmType (Width -> CmmType
cmmBits Width
w) of
SomeWasmType WasmTypeTag t
ty ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
Width -> Integer -> Integer
narrowU Width
w Integer
i
CmmFloat Rational
f Width
W32 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F32
TagF32 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
WasmTypeTag 'I32
TagI32
(forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
f)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
(pre :: [WasmType]).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr a (t0 : pre) (t1 : pre)
WasmReinterpret WasmTypeTag 'I32
TagI32 WasmTypeTag 'F32
TagF32
CmmFloat Rational
f Width
W64 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag 'F64
TagF64 forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
WasmTypeTag 'I64
TagI64
(forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
f)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
(pre :: [WasmType]).
WasmTypeTag t0
-> WasmTypeTag t1 -> WasmInstr a (t0 : pre) (t1 : pre)
WasmReinterpret WasmTypeTag 'I64
TagI64 WasmTypeTag 'F64
TagF64
CmmLabel CLabel
lbl' -> do
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl'
let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
sym
CmmLabelOff CLabel
lbl' Int
o -> do
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl'
let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
sym
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag w
ty_word (forall a. Integral a => a -> Integer
toInteger Int
o)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd WasmTypeTag w
ty_word
CmmBlock BlockId
bid -> forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel forall a b. (a -> b) -> a -> b
$ BlockId -> CLabel
infoTblLbl BlockId
bid
CmmLit
_ -> forall a. HasCallStack => String -> a
panic String
"lower_CmmLit: unreachable"
lower_CmmReg :: CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg :: forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
_ (CmmLocal LocalReg
reg) = do
(Int
reg_i, SomeWasmType WasmTypeTag t
ty) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a b (t : b)
WasmLocalGet WasmTypeTag t
ty Int
reg_i
lower_CmmReg CLabel
_ (CmmGlobal GlobalReg
EagerBlackholeInfo) = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"stg_EAGER_BLACKHOLE_info"
lower_CmmReg CLabel
_ (CmmGlobal GlobalReg
GCEnter1) = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"__stg_gc_enter_1" [] [CmmType
ty_word_cmm]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_gc_enter_1"
lower_CmmReg CLabel
_ (CmmGlobal GlobalReg
GCFun) = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
"__stg_gc_fun" [] [CmmType
ty_word_cmm]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag w
ty_word forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (a :: WasmType) (b :: [WasmType]).
SymName -> WasmInstr a b (a : b)
WasmSymConst SymName
"__stg_gc_fun"
lower_CmmReg CLabel
lbl (CmmGlobal GlobalReg
BaseReg) = do
Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl forall a b. (a -> b) -> a -> b
$ Platform -> Int -> CmmExpr
regTableOffset Platform
platform Int
0
lower_CmmReg CLabel
lbl (CmmGlobal GlobalReg
reg) = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
if
| Just (SymName
sym_global, SomeWasmType WasmTypeTag t
ty) <-
forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
ty_word GlobalReg
reg ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$ forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> SymName -> WasmInstr a b (t : b)
WasmGlobalGet WasmTypeTag t
ty SymName
sym_global
| Bool
otherwise -> do
Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
case CmmType -> SomeWasmType
someWasmTypeFromCmmType forall a b. (a -> b) -> a -> b
$ Platform -> GlobalReg -> CmmType
globalRegType Platform
platform GlobalReg
reg of
SomeWasmType WasmTypeTag t
ty -> do
(WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <-
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl forall a b. (a -> b) -> a -> b
$
Platform -> GlobalReg -> CmmExpr
get_GlobalReg_addr Platform
platform GlobalReg
reg
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
WasmTypeTag t
ty
forall a. Maybe a
Nothing
Signage
Unsigned
Int
o
AlignmentSpec
NaturallyAligned
lower_CmmRegOff :: CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmRegOff :: forall (w :: WasmType).
CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
0 = forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
o = do
SomeWasmExpr WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
reg_instr) <- forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
reg_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst
WasmTypeTag t
ty
(forall a. Integral a => a -> Integer
toInteger Int
o)
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAdd WasmTypeTag t
ty
lower_CmmLoad_Typed ::
CLabel ->
CmmExpr ->
WasmTypeTag t ->
CmmType ->
AlignmentSpec ->
WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed :: forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed CLabel
lbl CmmExpr
ptr_expr WasmTypeTag t
ty CmmType
ty_cmm AlignmentSpec
align = do
(WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr_expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType) (t :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre (t : pre))
-> WasmExpr w t
WasmExpr forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad
WasmTypeTag t
ty
(forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm)
Signage
Unsigned
Int
o
AlignmentSpec
align
lower_CmmLoad ::
CLabel ->
CmmExpr ->
CmmType ->
AlignmentSpec ->
WasmCodeGenM
w
(SomeWasmExpr w)
lower_CmmLoad :: forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad CLabel
lbl CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align = case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
ty_cmm of
SomeWasmType WasmTypeTag t
ty ->
forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w
SomeWasmExpr WasmTypeTag t
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: WasmType) (w :: WasmType).
CLabel
-> CmmExpr
-> WasmTypeTag t
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (WasmExpr w t)
lower_CmmLoad_Typed CLabel
lbl CmmExpr
ptr_expr WasmTypeTag t
ty CmmType
ty_cmm AlignmentSpec
align
lower_CmmExpr :: CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr :: forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
expr = case CmmExpr
expr of
CmmLit CmmLit
lit -> forall (w :: WasmType). CmmLit -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLit CmmLit
lit
CmmLoad CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align -> forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad CLabel
lbl CmmExpr
ptr_expr CmmType
ty_cmm AlignmentSpec
align
CmmReg CmmReg
reg -> forall (w :: WasmType).
CLabel -> CmmReg -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmReg CLabel
lbl CmmReg
reg
CmmRegOff CmmReg
reg Int
o -> forall (w :: WasmType).
CLabel -> CmmReg -> Int -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmRegOff CLabel
lbl CmmReg
reg Int
o
CmmMachOp MachOp
op [CmmExpr]
xs -> forall (w :: WasmType).
CLabel -> MachOp -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmMachOp CLabel
lbl MachOp
op [CmmExpr]
xs
CmmExpr
_ -> forall a. HasCallStack => String -> a
panic String
"lower_CmmExpr: unreachable"
lower_CmmExpr_Typed ::
CLabel ->
WasmTypeTag t ->
CmmExpr ->
WasmCodeGenM
w
(WasmExpr w t)
lower_CmmExpr_Typed :: forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
expr = do
SomeWasmExpr WasmTypeTag t
ty' WasmExpr w t
r <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
expr
if
| Just t :~: t
Refl <- WasmTypeTag t
ty' forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
ty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WasmExpr w t
r
| Bool
otherwise -> forall a. HasCallStack => String -> a
panic String
"lower_CmmExpr_Typed: unreachable"
lower_CmmExpr_Ptr :: CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr :: forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
case CmmExpr
ptr of
CmmLit (CmmLabelOff CLabel
lbl Int
o)
| Int
o forall a. Ord a => a -> a -> Bool
>= Int
0 -> do
WasmExpr w w
instrs <-
forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed
CLabel
lbl
WasmTypeTag w
ty_word
(CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w w
instrs, Int
o)
CmmMachOp (MO_Add Width
_) [CmmExpr
base, CmmLit (CmmInt Integer
o Width
_)]
| Integer
o forall a. Ord a => a -> a -> Bool
>= Integer
0 -> do
WasmExpr w w
instrs <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word CmmExpr
base
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w w
instrs, forall a. Num a => Integer -> a
fromInteger Integer
o)
CmmExpr
_ -> do
WasmExpr w w
instrs <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word CmmExpr
ptr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WasmExpr w w
instrs, Int
0)
type family
WasmPushes (ts :: [WasmType]) (pre :: [WasmType]) ::
[WasmType]
where
WasmPushes '[] pre = pre
WasmPushes (t : ts) pre = WasmPushes ts (t : pre)
data SomeWasmPreCCall w where
SomeWasmPreCCall ::
TypeList ts ->
(forall pre. WasmInstr w pre (WasmPushes ts pre)) ->
SomeWasmPreCCall w
data SomeWasmPostCCall w where
SomeWasmPostCCall ::
TypeList ts ->
(forall post. WasmInstr w (WasmPushes ts post) post) ->
SomeWasmPostCCall w
lower_CMO_Un_Homo ::
CLabel ->
SymName ->
[CmmFormal] ->
[CmmActual] ->
WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo :: forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
op [LocalReg
reg] [CmmExpr
x] = do
(Int
ri, SomeWasmType WasmTypeTag t
ty) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
let ty_cmm :: CmmType
ty_cmm = LocalReg -> CmmType
localRegType LocalReg
reg
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
op [CmmType
ty_cmm] [CmmType
ty_cmm]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
op forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
ty Int
ri
lower_CMO_Un_Homo CLabel
_ SymName
_ [LocalReg]
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_CMO_Un_Homo: unreachable"
lower_CMO_Bin_Homo ::
CLabel ->
SymName ->
[CmmFormal] ->
[CmmActual] ->
WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo :: forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
op [LocalReg
reg] [CmmExpr
x, CmmExpr
y] = do
(Int
ri, SomeWasmType WasmTypeTag t
ty) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
x
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
y
let ty_cmm :: CmmType
ty_cmm = LocalReg -> CmmType
localRegType LocalReg
reg
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
op [CmmType
ty_cmm, CmmType
ty_cmm] [CmmType
ty_cmm]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
y_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
op
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
ty Int
ri
lower_CMO_Bin_Homo CLabel
_ SymName
_ [LocalReg]
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_CMO_Bin_Homo: unreachable"
lower_MO_UF_Conv ::
CLabel ->
Width ->
[CmmFormal] ->
[CmmActual] ->
WasmCodeGenM w (WasmStatements w)
lower_MO_UF_Conv :: forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_UF_Conv CLabel
lbl Width
W32 [LocalReg
reg] [CmmExpr
x] = do
Int
ri <- forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag 'F32
TagF32 LocalReg
reg
SomeWasmExpr WasmTypeTag t
ty0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
(pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmConvert Signage
Unsigned WasmTypeTag t
ty0 WasmTypeTag 'F32
TagF32
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag 'F32
TagF32 Int
ri
lower_MO_UF_Conv CLabel
lbl Width
W64 [LocalReg
reg] [CmmExpr
x] = do
Int
ri <- forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag 'F64
TagF64 LocalReg
reg
SomeWasmExpr WasmTypeTag t
ty0 (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
x_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t0 :: WasmType) (t1 :: WasmType) (a :: WasmType)
(pre :: [WasmType]).
Signage
-> WasmTypeTag t0
-> WasmTypeTag t1
-> WasmInstr a (t0 : pre) (t1 : pre)
WasmConvert Signage
Unsigned WasmTypeTag t
ty0 WasmTypeTag 'F64
TagF64
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag 'F64
TagF64 Int
ri
lower_MO_UF_Conv CLabel
_ Width
_ [LocalReg]
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_UF_Conv: unreachable"
lower_MO_Cmpxchg ::
CLabel ->
Width ->
[CmmFormal] ->
[CmmActual] ->
WasmCodeGenM w (WasmStatements w)
lower_MO_Cmpxchg :: forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_Cmpxchg CLabel
lbl Width
w0 [LocalReg
reg] [CmmExpr
ptr, CmmExpr
expected, CmmExpr
new] =
case CmmType -> SomeWasmType
someWasmTypeFromCmmType CmmType
ty_cmm of
SomeWasmType WasmTypeTag t
ty -> do
Int
reg_i <- forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg
let narrowing :: Maybe Int
narrowing = forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm
(WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
expected_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
expected
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
new_instr <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty CmmExpr
new
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t
-> Maybe Int
-> Signage
-> Int
-> AlignmentSpec
-> WasmInstr a (a : pre) (t : pre)
WasmLoad WasmTypeTag t
ty Maybe Int
narrowing Signage
Unsigned Int
o AlignmentSpec
NaturallyAligned
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : pre) (t : pre)
WasmLocalTee WasmTypeTag t
ty Int
reg_i
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
expected_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (a : pre)
WasmEq WasmTypeTag t
ty
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (c :: [WasmType]).
WasmInstr a c c -> WasmInstr a (a : c) c
WasmCond
( forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
new_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t
-> Maybe Int -> Int -> AlignmentSpec -> WasmInstr a (t : a : c) c
WasmStore WasmTypeTag t
ty Maybe Int
narrowing Int
o AlignmentSpec
NaturallyAligned
)
where
ty_cmm :: CmmType
ty_cmm = Width -> CmmType
cmmBits Width
w0
lower_MO_Cmpxchg CLabel
_ Width
_ [LocalReg]
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_MO_Cmpxchg: unreachable"
lower_CallishMachOp ::
CLabel ->
CallishMachOp ->
[CmmFormal] ->
[CmmActual] ->
WasmCodeGenM w (WasmStatements w)
lower_CallishMachOp :: forall (w :: WasmType).
CLabel
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Pwr [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
"pow" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sin [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sin" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Cos [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cos" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Tan [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tan" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sinh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Cosh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cosh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Tanh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Asin [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asin" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Acos [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acos" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Atan [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atan" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Asinh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Acosh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acosh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Atanh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanh" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Log [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Log1P [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log1p" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Exp [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"exp" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_ExpM1 [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expm1" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Fabs [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"fabs" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F64_Sqrt [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sqrt" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Pwr [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Bin_Homo CLabel
lbl SymName
"powf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sin [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Cos [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"cosf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Tan [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sinh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sinhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Cosh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"coshf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Tanh [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"tanhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Asin [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Acos [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acosf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Atan [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Asinh [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"asinhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Acosh [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"acoshf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Atanh [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"atanhf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Log [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"logf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Log1P [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"log1pf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Exp [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_ExpM1 [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"expm1f" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Fabs [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"fabsf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_F32_Sqrt [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> SymName
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CMO_Un_Homo CLabel
lbl SymName
"sqrtf" [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_UF_Conv Width
w0) [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_UF_Conv CLabel
lbl Width
w0 [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
_ CallishMachOp
MO_ReadBarrier [LocalReg]
_ [CmmExpr]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_WriteBarrier [LocalReg]
_ [CmmExpr]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ CallishMachOp
MO_Touch [LocalReg]
_ [CmmExpr]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
_ (MO_Prefetch_Data {}) [LocalReg]
_ [CmmExpr]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
lower_CallishMachOp CLabel
lbl (MO_Memcpy {}) [] [CmmExpr]
xs = do
CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
"memcpy" CmmType
ty_word_cmm [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Memset {}) [] [CmmExpr]
xs = do
CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
"memset" CmmType
ty_word_cmm [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Memmove {}) [] [CmmExpr]
xs = do
CmmType
ty_word_cmm <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
"memmove" CmmType
ty_word_cmm [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Memcmp {}) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left SymName
"memcmp")
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_PopCnt Width
w0) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_popcnt" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Pdep Width
w0) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_pdep" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Pext Width
w0) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_pext" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Clz Width
w0) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_clz" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Ctz Width
w0) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_ctz" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_BSwap Width
w0) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_bswap" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_BRev Width
w0) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_bitrev" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_AtomicRMW Width
w0 AtomicMachOp
op) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
( forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$
( case AtomicMachOp
op of
AtomicMachOp
AMO_Add -> String
"hs_atomic_add"
AtomicMachOp
AMO_Sub -> String
"hs_atomic_sub"
AtomicMachOp
AMO_And -> String
"hs_atomic_and"
AtomicMachOp
AMO_Nand -> String
"hs_atomic_nand"
AtomicMachOp
AMO_Or -> String
"hs_atomic_or"
AtomicMachOp
AMO_Xor -> String
"hs_atomic_xor"
)
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0)
)
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_AtomicRead Width
w0 MemoryOrdering
_) [LocalReg
reg] [CmmExpr
ptr] = do
SomeWasmExpr WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
ret_instr) <-
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmType
-> AlignmentSpec
-> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmLoad
CLabel
lbl
CmmExpr
ptr
(Width -> CmmType
cmmBits Width
w0)
AlignmentSpec
NaturallyAligned
Int
ri <- forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
ret_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
ty Int
ri
lower_CallishMachOp CLabel
lbl (MO_AtomicWrite Width
_ MemoryOrdering
_) [] [CmmExpr
ptr, CmmExpr
val] =
forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
lower_CmmStore CLabel
lbl CmmExpr
ptr CmmExpr
val AlignmentSpec
NaturallyAligned
lower_CallishMachOp CLabel
lbl (MO_Cmpxchg Width
w0) [LocalReg]
rs [CmmExpr]
xs = forall (w :: WasmType).
CLabel
-> Width
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_MO_Cmpxchg CLabel
lbl Width
w0 [LocalReg]
rs [CmmExpr]
xs
lower_CallishMachOp CLabel
lbl (MO_Xchg Width
w0) [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"hs_xchg" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Width -> Int
widthInBits Width
w0))
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_SuspendThread [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left SymName
"suspendThread")
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
lbl CallishMachOp
MO_ResumeThread [LocalReg]
rs [CmmExpr]
xs =
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left SymName
"resumeThread")
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg]
rs
[CmmExpr]
xs
lower_CallishMachOp CLabel
_ CallishMachOp
_ [LocalReg]
_ [CmmExpr]
_ = forall a. HasCallStack => String -> a
panic String
"lower_CallishMachOp: unreachable"
lower_CmmUnsafeForeignCall_Drop ::
CLabel ->
SymName ->
CmmType ->
[CmmActual] ->
WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop :: forall (w :: WasmType).
CLabel
-> SymName
-> CmmType
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop CLabel
lbl SymName
sym_callee CmmType
ret_cmm_ty [CmmExpr]
arg_exprs = do
Unique
ret_uniq <- forall (w :: WasmType). WasmCodeGenM w Unique
wasmUniq
let ret_local :: LocalReg
ret_local = Unique -> CmmType -> LocalReg
LocalReg Unique
ret_uniq CmmType
ret_cmm_ty
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left SymName
sym_callee)
forall a. Maybe a
Nothing
CmmReturnInfo
CmmMayReturn
[LocalReg
ret_local]
[CmmExpr]
arg_exprs
lower_CmmUnsafeForeignCall ::
CLabel ->
(Either SymName CmmExpr) ->
Maybe
([ForeignHint], [ForeignHint]) ->
CmmReturnInfo ->
[CmmFormal] ->
[CmmActual] ->
WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall :: forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall CLabel
lbl Either SymName CmmExpr
target Maybe ([ForeignHint], [ForeignHint])
mb_hints CmmReturnInfo
ret_info [LocalReg]
ret_locals [CmmExpr]
arg_exprs = do
Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
SomeWasmPreCCall TypeList ts
arg_tys forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr <-
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM
( \(CmmExpr
arg_expr, ForeignHint
arg_hint) (SomeWasmPreCCall TypeList ts
acc_tys forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
acc_instr) -> do
SomeWasmExpr WasmTypeTag t
arg_ty WasmExpr w t
arg_wasm_expr <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
arg_expr
let WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
arg_instr = case ForeignHint
arg_hint of
ForeignHint
SignedHint ->
forall (t :: WasmType) (w :: WasmType).
Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t
extendSubword
(Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
arg_expr)
WasmTypeTag t
arg_ty
WasmExpr w t
arg_wasm_expr
ForeignHint
_ -> WasmExpr w t
arg_wasm_expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (pre :: [WasmType]).
WasmInstr w pre (WasmPushes ts pre))
-> SomeWasmPreCCall w
SomeWasmPreCCall (WasmTypeTag t
arg_ty forall (t :: WasmType) (ts :: [WasmType]).
WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
`TypeListCons` TypeList ts
acc_tys) forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
arg_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
acc_instr
)
(forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (pre :: [WasmType]).
WasmInstr w pre (WasmPushes ts pre))
-> SomeWasmPreCCall w
SomeWasmPreCCall TypeList '[]
TypeListNil forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop)
[(CmmExpr, ForeignHint)]
arg_exprs_hints
SomeWasmPostCCall TypeList ts
ret_tys forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr <-
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM
( \(LocalReg
reg, ForeignHint
ret_hint) (SomeWasmPostCCall TypeList ts
acc_tys forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr) -> do
(Int
reg_i, SomeWasmType WasmTypeTag t
reg_ty) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (post :: [WasmType]).
WasmInstr w (WasmPushes ts post) post)
-> SomeWasmPostCCall w
SomeWasmPostCCall (WasmTypeTag t
reg_ty forall (t :: WasmType) (ts :: [WasmType]).
WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
`TypeListCons` TypeList ts
acc_tys) forall a b. (a -> b) -> a -> b
$
case (# ForeignHint
ret_hint, Platform -> CmmReg -> Width
cmmRegWidth Platform
platform forall a b. (a -> b) -> a -> b
$ LocalReg -> CmmReg
CmmLocal LocalReg
reg #) of
(# ForeignHint
SignedHint, Width
W8 #) ->
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
reg_ty Integer
0xFF
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
reg_ty
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
(# ForeignHint
SignedHint, Width
W16 #) ->
forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (b :: [WasmType]).
WasmTypeTag t -> Integer -> WasmInstr a b (t : b)
WasmConst WasmTypeTag t
reg_ty Integer
0xFFFF
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (pre :: [WasmType]).
WasmTypeTag t -> WasmInstr a (t : t : pre) (t : pre)
WasmAnd WasmTypeTag t
reg_ty
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
(# ForeignHint, Width #)
_ -> forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
acc_instr forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
reg_ty Int
reg_i
)
(forall (ts :: [WasmType]) (w :: WasmType).
TypeList ts
-> (forall (post :: [WasmType]).
WasmInstr w (WasmPushes ts post) post)
-> SomeWasmPostCCall w
SomeWasmPostCCall TypeList '[]
TypeListNil forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop)
[(LocalReg, ForeignHint)]
ret_locals_hints
case Either SymName CmmExpr
target of
Left SymName
sym_callee -> do
Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
let arg_cmm_tys :: [CmmType]
arg_cmm_tys = forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) [CmmExpr]
arg_exprs
ret_cmm_tys :: [CmmType]
ret_cmm_tys = forall a b. (a -> b) -> [a] -> [b]
map LocalReg -> CmmType
localRegType [LocalReg]
ret_locals
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
sym_callee [CmmType]
arg_cmm_tys [CmmType]
ret_cmm_tys
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
SymName -> WasmInstr a b c
WasmCCall SymName
sym_callee
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` ( case CmmReturnInfo
ret_info of
CmmReturnInfo
CmmMayReturn -> forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr
CmmReturnInfo
CmmNeverReturns -> forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
WasmInstr a b c
WasmUnreachable
)
Right CmmExpr
fptr_callee -> do
(WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
instr_callee, Int
_) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
fptr_callee
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (WasmPushes ts pre)
args_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
instr_callee
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (arg_tys :: [WasmType]) (ret_tys :: [WasmType])
(a :: WasmType) (pre :: [WasmType]) (c :: [WasmType]).
TypeList arg_tys -> TypeList ret_tys -> WasmInstr a (a : pre) c
WasmCCallIndirect TypeList ts
arg_tys TypeList ts
ret_tys
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` ( case CmmReturnInfo
ret_info of
CmmReturnInfo
CmmMayReturn -> forall (post :: [WasmType]). WasmInstr w (WasmPushes ts post) post
ret_instr
CmmReturnInfo
CmmNeverReturns -> forall (a :: WasmType) (b :: [WasmType]) (c :: [WasmType]).
WasmInstr a b c
WasmUnreachable
)
where
(# [(CmmExpr, ForeignHint)]
arg_exprs_hints, [(LocalReg, ForeignHint)]
ret_locals_hints #) = case Maybe ([ForeignHint], [ForeignHint])
mb_hints of
Just ([ForeignHint]
arg_hints, [ForeignHint]
ret_hints) ->
(# forall a b. [a] -> [b] -> [(a, b)]
zip [CmmExpr]
arg_exprs [ForeignHint]
arg_hints, forall a b. [a] -> [b] -> [(a, b)]
zip [LocalReg]
ret_locals [ForeignHint]
ret_hints #)
Maybe ([ForeignHint], [ForeignHint])
_ -> (# forall a b. (a -> b) -> [a] -> [b]
map (,ForeignHint
NoHint) [CmmExpr]
arg_exprs, forall a b. (a -> b) -> [a] -> [b]
map (,ForeignHint
NoHint) [LocalReg]
ret_locals #)
lower_CmmStore ::
CLabel ->
CmmExpr ->
CmmExpr ->
AlignmentSpec ->
WasmCodeGenM
w
(WasmStatements w)
lower_CmmStore :: forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
lower_CmmStore CLabel
lbl CmmExpr
ptr CmmExpr
val AlignmentSpec
align = do
Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
(WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl CmmExpr
ptr
let ty_cmm :: CmmType
ty_cmm = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
val
SomeWasmExpr WasmTypeTag t
ty (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
val_instr) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
val
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
val_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t
-> Maybe Int -> Int -> AlignmentSpec -> WasmInstr a (t : a : c) c
WasmStore WasmTypeTag t
ty (forall (t :: WasmType). WasmTypeTag t -> CmmType -> Maybe Int
wasmMemoryNarrowing WasmTypeTag t
ty CmmType
ty_cmm) Int
o AlignmentSpec
align
lower_CmmAction :: CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w)
lower_CmmAction :: forall (w :: WasmType).
CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w)
lower_CmmAction CLabel
lbl CmmNode O O
act = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
case CmmNode O O
act of
CmmComment {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
CmmTick {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
CmmUnwind {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
CmmAssign (CmmLocal LocalReg
reg) CmmExpr
e -> do
(Int
i, SomeWasmType WasmTypeTag t
ty_reg) <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty_reg CmmExpr
e
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> Int -> WasmInstr a (t : c) c
WasmLocalSet WasmTypeTag t
ty_reg Int
i
CmmAssign (CmmGlobal GlobalReg
reg) CmmExpr
e
| GlobalReg
BaseReg <- GlobalReg
reg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop
| Just (SymName
sym_global, SomeWasmType WasmTypeTag t
ty_reg) <-
forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe GlobalInfo
globalInfoFromCmmGlobalReg WasmTypeTag w
ty_word GlobalReg
reg -> do
WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs <- forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag t
ty_reg CmmExpr
e
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t -> SymName -> WasmInstr a (t : c) c
WasmGlobalSet WasmTypeTag t
ty_reg SymName
sym_global
| Bool
otherwise -> do
(WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr, Int
o) <-
forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
lower_CmmExpr_Ptr CLabel
lbl forall a b. (a -> b) -> a -> b
$ Platform -> GlobalReg -> CmmExpr
get_GlobalReg_addr Platform
platform GlobalReg
reg
SomeWasmExpr WasmTypeTag t
ty_e (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs) <- forall (w :: WasmType).
CLabel -> CmmExpr -> WasmCodeGenM w (SomeWasmExpr w)
lower_CmmExpr CLabel
lbl CmmExpr
e
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$
forall (pre :: [WasmType]). WasmInstr w pre (w : pre)
ptr_instr
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre (t : pre)
instrs
forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (t :: WasmType) (a :: WasmType) (c :: [WasmType]).
WasmTypeTag t
-> Maybe Int -> Int -> AlignmentSpec -> WasmInstr a (t : a : c) c
WasmStore WasmTypeTag t
ty_e forall a. Maybe a
Nothing Int
o AlignmentSpec
NaturallyAligned
CmmStore CmmExpr
ptr CmmExpr
val AlignmentSpec
align -> forall (w :: WasmType).
CLabel
-> CmmExpr
-> CmmExpr
-> AlignmentSpec
-> WasmCodeGenM w (WasmStatements w)
lower_CmmStore CLabel
lbl CmmExpr
ptr CmmExpr
val AlignmentSpec
align
CmmUnsafeForeignCall
( ForeignTarget
(CmmLit (CmmLabel CLabel
lbl_callee))
(ForeignConvention CCallConv
conv [ForeignHint]
arg_hints [ForeignHint]
ret_hints CmmReturnInfo
ret_info)
)
[LocalReg]
ret_locals
[CmmExpr]
arg_exprs
| CCallConv
conv forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CCallConv
CCallConv, CCallConv
CApiConv] ->
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CLabel -> SymName
symNameFromCLabel CLabel
lbl_callee)
(forall a. a -> Maybe a
Just ([ForeignHint]
arg_hints, [ForeignHint]
ret_hints))
CmmReturnInfo
ret_info
[LocalReg]
ret_locals
[CmmExpr]
arg_exprs
CmmUnsafeForeignCall
(ForeignTarget CmmExpr
target_expr (ForeignConvention CCallConv
conv [ForeignHint]
arg_hints [ForeignHint]
ret_hints CmmReturnInfo
ret_info))
[LocalReg]
ret_locals
[CmmExpr]
arg_exprs
| CCallConv
conv forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CCallConv
CCallConv, CCallConv
CApiConv] ->
forall (w :: WasmType).
CLabel
-> Either SymName CmmExpr
-> Maybe ([ForeignHint], [ForeignHint])
-> CmmReturnInfo
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall
CLabel
lbl
(forall a b. b -> Either a b
Right CmmExpr
target_expr)
(forall a. a -> Maybe a
Just ([ForeignHint]
arg_hints, [ForeignHint]
ret_hints))
CmmReturnInfo
ret_info
[LocalReg]
ret_locals
[CmmExpr]
arg_exprs
CmmUnsafeForeignCall (PrimTarget CallishMachOp
op) [LocalReg]
ret_locals [CmmExpr]
arg_exprs ->
forall (w :: WasmType).
CLabel
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> WasmCodeGenM w (WasmStatements w)
lower_CallishMachOp CLabel
lbl CallishMachOp
op [LocalReg]
ret_locals [CmmExpr]
arg_exprs
CmmNode O O
_ -> forall a. HasCallStack => String -> a
panic String
"lower_CmmAction: unreachable"
lower_CmmActions ::
CLabel ->
Label ->
Block CmmNode O O ->
WasmCodeGenM
w
(WasmStatements w)
lower_CmmActions :: forall (w :: WasmType).
CLabel
-> BlockId
-> Block CmmNode O O
-> WasmCodeGenM w (WasmStatements w)
lower_CmmActions CLabel
lbl BlockId
_ Block CmmNode O O
blk =
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
( \(WasmStatements forall (pre :: [WasmType]). WasmInstr w pre pre
acc) CmmNode O O
act ->
(\(WasmStatements forall (pre :: [WasmType]). WasmInstr w pre pre
stmts) -> forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall a b. (a -> b) -> a -> b
$ forall (pre :: [WasmType]). WasmInstr w pre pre
acc forall (a :: WasmType) (b :: [WasmType]) (mid :: [WasmType])
(c :: [WasmType]).
WasmInstr a b mid -> WasmInstr a mid c -> WasmInstr a b c
`WasmConcat` forall (pre :: [WasmType]). WasmInstr w pre pre
stmts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (w :: WasmType).
CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w)
lower_CmmAction CLabel
lbl CmmNode O O
act
)
(forall (w :: WasmType).
(forall (pre :: [WasmType]). WasmInstr w pre pre)
-> WasmStatements w
WasmStatements forall (a :: WasmType) (b :: [WasmType]). WasmInstr a b b
WasmNop)
[CmmNode O O]
acts
where
acts :: [CmmNode O O]
acts = forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
blk
lower_CmmGraph :: CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph :: forall (w :: WasmType).
CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph CLabel
lbl CmmGraph
g = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
Platform
platform <- forall (w :: WasmType). WasmCodeGenM w Platform
wasmPlatformM
WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32]
body <-
forall expr stmt (m :: * -> *).
Applicative m =>
Platform
-> (BlockId -> CmmExpr -> m expr)
-> (BlockId -> Block CmmNode O O -> m stmt)
-> CmmGraph
-> m (WasmControl stmt expr '[] '[ 'I32])
structuredControl
Platform
platform
(\BlockId
_ -> forall (t :: WasmType) (w :: WasmType).
CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t)
lower_CmmExpr_Typed CLabel
lbl WasmTypeTag w
ty_word)
(forall (w :: WasmType).
CLabel
-> BlockId
-> Block CmmNode O O
-> WasmCodeGenM w (WasmStatements w)
lower_CmmActions CLabel
lbl)
CmmGraph
g
[SomeWasmType]
locals <- forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
(#
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k k0 a. Ord k => UniqFM k0 (k, a) -> [(k, a)]
detEltsUFM forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
localRegs WasmCodeGenState w
s,
WasmCodeGenState w
s {localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegs = forall key elt. UniqFM key elt
emptyUFM, localRegsCount :: Int
localRegsCount = Int
0}
#)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FuncBody {funcLocals :: [SomeWasmType]
funcLocals = [SomeWasmType]
locals, funcBody :: WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
funcBody = forall s e (pre :: [WasmType]) (post :: [WasmType])
(pre' :: [WasmType]) (post' :: [WasmType]).
WasmControl s e pre post -> WasmControl s e pre' post'
wasmControlCast forall a b. (a -> b) -> a -> b
$ WasmControl (WasmStatements w) (WasmExpr w w) '[] '[ 'I32]
body}
onTopSym :: CLabel -> WasmCodeGenM w ()
onTopSym :: forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onTopSym CLabel
lbl = case SymVisibility
sym_vis of
SymVisibility
SymDefault -> forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
WasmCodeGenState w
s
{ defaultSyms :: SymSet
defaultSyms =
Int -> SymSet -> SymSet
IS.insert
(Unique -> Int
getKey forall a b. (a -> b) -> a -> b
$ forall a. Uniquable a => a -> Unique
getUnique SymName
sym)
forall a b. (a -> b) -> a -> b
$ forall (w :: WasmType). WasmCodeGenState w -> SymSet
defaultSyms WasmCodeGenState w
s
}
SymVisibility
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl
sym_vis :: SymVisibility
sym_vis = CLabel -> SymVisibility
symVisibilityFromCLabel CLabel
lbl
onFuncSym :: SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym :: forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
sym [CmmType]
arg_tys [CmmType]
ret_tys = forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$
\s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
SymSet
Platform
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
wasmUniqSupply :: UniqSupply
localRegsCount :: Int
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
ctors :: [SymName]
dataSections :: SymMap DataSection
funcBodies :: SymMap (FuncBody w)
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
defaultSyms :: SymSet
wasmPlatform :: Platform
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> SymSet
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
..} ->
WasmCodeGenState w
s
{ funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcTypes =
forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap
SymMap ([SomeWasmType], [SomeWasmType])
funcTypes
SymName
sym
( forall a b. (a -> b) -> [a] -> [b]
map CmmType -> SomeWasmType
someWasmTypeFromCmmType [CmmType]
arg_tys,
forall a b. (a -> b) -> [a] -> [b]
map CmmType -> SomeWasmType
someWasmTypeFromCmmType [CmmType]
ret_tys
)
}
onAnySym :: CLabel -> WasmCodeGenM w ()
onAnySym :: forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onAnySym CLabel
lbl = case SymKind
sym_kind of
SymKind
SymFunc -> do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
SymSet
Platform
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
wasmUniqSupply :: UniqSupply
localRegsCount :: Int
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
ctors :: [SymName]
dataSections :: SymMap DataSection
funcBodies :: SymMap (FuncBody w)
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
defaultSyms :: SymSet
wasmPlatform :: Platform
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> SymSet
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
..} ->
WasmCodeGenState w
s {funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcTypes = forall k a.
Uniquable k =>
(a -> a -> a) -> UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap_C forall a b. a -> b -> a
const SymMap ([SomeWasmType], [SomeWasmType])
funcTypes SymName
sym ([], [forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag w
ty_word])}
SymKind
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl
sym_kind :: SymKind
sym_kind = CLabel -> SymKind
symKindFromCLabel CLabel
lbl
onCmmLocalReg :: LocalReg -> WasmCodeGenM w LocalInfo
onCmmLocalReg :: forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg = forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM forall a b. (a -> b) -> a -> b
$ \s :: WasmCodeGenState w
s@WasmCodeGenState {Int
[SymName]
SymSet
Platform
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
UniqFM LocalReg (Int, SomeWasmType)
UniqSupply
wasmUniqSupply :: UniqSupply
localRegsCount :: Int
localRegs :: UniqFM LocalReg (Int, SomeWasmType)
ctors :: [SymName]
dataSections :: SymMap DataSection
funcBodies :: SymMap (FuncBody w)
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
defaultSyms :: SymSet
wasmPlatform :: Platform
wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> SymSet
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg (Int, SomeWasmType)
..} ->
let reg_info :: (Int, SomeWasmType)
reg_info =
(Int
localRegsCount, CmmType -> SomeWasmType
someWasmTypeFromCmmType forall a b. (a -> b) -> a -> b
$ LocalReg -> CmmType
localRegType LocalReg
reg)
in case forall key elt.
Uniquable key =>
(key -> elt -> elt -> elt)
-> key -> elt -> UniqFM key elt -> (Maybe elt, UniqFM key elt)
addToUFM_L (\LocalReg
_ (Int, SomeWasmType)
i (Int, SomeWasmType)
_ -> (Int, SomeWasmType)
i) LocalReg
reg (Int, SomeWasmType)
reg_info UniqFM LocalReg (Int, SomeWasmType)
localRegs of
(Just (Int, SomeWasmType)
i, UniqFM LocalReg (Int, SomeWasmType)
_) -> (# (Int, SomeWasmType)
i, WasmCodeGenState w
s #)
(Maybe (Int, SomeWasmType)
_, UniqFM LocalReg (Int, SomeWasmType)
localRegs') ->
(#
(Int, SomeWasmType)
reg_info,
WasmCodeGenState w
s
{ localRegs :: UniqFM LocalReg (Int, SomeWasmType)
localRegs = UniqFM LocalReg (Int, SomeWasmType)
localRegs',
localRegsCount :: Int
localRegsCount =
Int
localRegsCount forall a. Num a => a -> a -> a
+ Int
1
}
#)
onCmmLocalReg_Typed :: WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed :: forall (t :: WasmType) (w :: WasmType).
WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int
onCmmLocalReg_Typed WasmTypeTag t
ty LocalReg
reg = do
(Int
i, SomeWasmType WasmTypeTag t
ty') <- forall (w :: WasmType).
LocalReg -> WasmCodeGenM w (Int, SomeWasmType)
onCmmLocalReg LocalReg
reg
if
| Just t :~: t
Refl <- WasmTypeTag t
ty' forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` WasmTypeTag t
ty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
| Bool
otherwise -> forall a. HasCallStack => String -> a
panic String
"onCmmLocalReg_Typed: unreachable"
onFini :: [SymName] -> WasmCodeGenM w ()
onFini :: forall (w :: WasmType). [SymName] -> WasmCodeGenM w ()
onFini [SymName]
syms = do
let n_finis :: Int
n_finis = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SymName]
syms
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n_finis forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
panic String
"dtors unsupported by wasm32 NCG"
onCmmInitFini :: InitOrFini -> [CLabel] -> WasmCodeGenM w ()
onCmmInitFini :: forall (w :: WasmType). InitOrFini -> [CLabel] -> WasmCodeGenM w ()
onCmmInitFini InitOrFini
iof [CLabel]
lbls = do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [CLabel]
lbls forall a b. (a -> b) -> a -> b
$ \CLabel
lbl -> forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym (CLabel -> SymName
symNameFromCLabel CLabel
lbl) [] []
case InitOrFini
iof of
InitOrFini
IsInitArray -> forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s -> WasmCodeGenState w
s {ctors :: [SymName]
ctors = [SymName]
syms forall a. Semigroup a => a -> a -> a
<> forall (w :: WasmType). WasmCodeGenState w -> [SymName]
ctors WasmCodeGenState w
s}
InitOrFini
IsFiniArray -> forall (w :: WasmType). [SymName] -> WasmCodeGenM w ()
onFini [SymName]
syms
where
syms :: [SymName]
syms = forall a b. (a -> b) -> [a] -> [b]
map CLabel -> SymName
symNameFromCLabel [CLabel]
lbls
onCmmData :: CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData :: forall (w :: WasmType).
CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData CLabel
lbl Section
s [CmmStatic]
statics = do
WasmTypeTag w
ty_word <- forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
wasmWordTypeM
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onTopSym CLabel
lbl
[DataSectionContent]
cs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CmmStatic]
statics forall (w :: WasmType).
CmmStatic -> WasmCodeGenM w DataSectionContent
lower_CmmStatic
let sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl
sec :: DataSection
sec =
DataSection
{ dataSectionKind :: DataSectionKind
dataSectionKind =
Section -> DataSectionKind
dataSectionKindFromCmmSection Section
s,
dataSectionAlignment :: Alignment
dataSectionAlignment =
forall (w :: WasmType).
WasmTypeTag w -> [DataSectionContent] -> Alignment
alignmentFromCmmSection WasmTypeTag w
ty_word [DataSectionContent]
cs,
dataSectionContents :: [DataSectionContent]
dataSectionContents =
case [DataSectionContent]
cs of
[DataASCII ByteString
buf] -> [ByteString -> DataSectionContent
DataASCII forall a b. (a -> b) -> a -> b
$ ByteString
buf ByteString -> Word8 -> ByteString
`BS.snoc` Word8
0]
[DataIncBin String
p Int
l] -> [String -> Int -> DataSectionContent
DataIncBin String
p Int
l, Word8 -> DataSectionContent
DataI8 Word8
0]
[DataSectionContent]
_ -> [DataSectionContent]
cs
}
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s ->
WasmCodeGenState w
s
{ dataSections :: SymMap DataSection
dataSections =
forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap (forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
dataSections WasmCodeGenState w
s) SymName
sym DataSection
sec
}
onCmmProc :: CLabel -> CmmGraph -> WasmCodeGenM w ()
onCmmProc :: forall (w :: WasmType). CLabel -> CmmGraph -> WasmCodeGenM w ()
onCmmProc CLabel
lbl CmmGraph
g = do
CmmType
ty_word <- forall (w :: WasmType). WasmCodeGenM w CmmType
wasmWordCmmTypeM
forall (w :: WasmType). CLabel -> WasmCodeGenM w ()
onTopSym CLabel
lbl
forall (w :: WasmType).
SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w ()
onFuncSym SymName
sym [] [CmmType
ty_word]
FuncBody w
body <- forall (w :: WasmType).
CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph CLabel
lbl CmmGraph
g
forall (w :: WasmType).
(WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s -> WasmCodeGenState w
s {funcBodies :: SymMap (FuncBody w)
funcBodies = forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap (forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcBodies WasmCodeGenState w
s) SymName
sym FuncBody w
body}
where
sym :: SymName
sym = CLabel -> SymName
symNameFromCLabel CLabel
lbl
onCmmDecl :: RawCmmDecl -> WasmCodeGenM w ()
onCmmDecl :: forall (w :: WasmType). RawCmmDecl -> WasmCodeGenM w ()
onCmmDecl RawCmmDecl
decl
| Just (InitOrFini
iof, [CLabel]
lbls) <- RawCmmDecl -> Maybe (InitOrFini, [CLabel])
isInitOrFiniArray RawCmmDecl
decl = forall (w :: WasmType). InitOrFini -> [CLabel] -> WasmCodeGenM w ()
onCmmInitFini InitOrFini
iof [CLabel]
lbls
onCmmDecl (CmmData Section
s (CmmStaticsRaw CLabel
lbl [CmmStatic]
statics)) = forall (w :: WasmType).
CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w ()
onCmmData CLabel
lbl Section
s [CmmStatic]
statics
onCmmDecl (CmmProc LabelMap (GenCmmStatics 'True)
_ CLabel
lbl [GlobalReg]
_ CmmGraph
g) = forall (w :: WasmType). CLabel -> CmmGraph -> WasmCodeGenM w ()
onCmmProc CLabel
lbl CmmGraph
g
onCmmGroup :: RawCmmGroup -> WasmCodeGenM w ()
onCmmGroup :: forall (w :: WasmType). RawCmmGroup -> WasmCodeGenM w ()
onCmmGroup RawCmmGroup
cmms = forall (w :: WasmType) a.
(WasmCodeGenState w -> (# a, WasmCodeGenState w #))
-> WasmCodeGenM w a
wasmStateM forall a b. (a -> b) -> a -> b
$ \WasmCodeGenState w
s0 ->
(# (), forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\WasmCodeGenState w
s RawCmmDecl
cmm -> forall (w :: WasmType) a.
WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w
wasmExecM (forall (w :: WasmType). RawCmmDecl -> WasmCodeGenM w ()
onCmmDecl RawCmmDecl
cmm) WasmCodeGenState w
s) WasmCodeGenState w
s0 RawCmmGroup
cmms #)