{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Wasm.Builder (
GenMod,
genMod,
global, typedef, fun, funRec, declare, implement, table, memory, dataSegment,
importFunction, importGlobal, importMemory, importTable,
export,
nextFuncIndex, setGlobalInitializer,
GenFun,
Glob, Loc, Fn(..), Mem, Tbl, Label,
param, local, label,
ret,
arg,
i32, i64, f32, f64,
i32c, i64c, f32c, f64c,
add, inc, sub, dec, mul, div_u, div_s, rem_u, rem_s, and, or, xor, shl, shr_u, shr_s, rotl, rotr,
clz, ctz, popcnt,
eq, ne, lt_s, lt_u, gt_s, gt_u, le_s, le_u, ge_s, ge_u,
eqz,
div_f, min_f, max_f, copySign,
abs_f, neg_f, ceil_f, floor_f, trunc_f, nearest_f, sqrt_f,
lt_f, gt_f, le_f, ge_f,
wrap, trunc_s, trunc_u, extend_s, extend_u, convert_s, convert_u, demote, promote, reinterpret,
load, load8_u, load8_s, load16_u, load16_s, load32_u, load32_s,
store, store8, store16, store32,
memorySize, growMemory,
nop, Language.Wasm.Builder.drop, select,
call, callIndirect, finish, br, brIf, brTable,
trap, unreachable,
appendExpr, after,
Producer, OutType, produce, Consumer, (.=)
) where
import Prelude hiding (and, or)
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import Control.Monad.State (State, execState, get, gets, put, modify)
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Numeric.Natural
import Data.Word (Word32, Word64)
import Data.Int (Int32, Int64)
import Data.Proxy
import qualified Data.Text.Lazy as TL
import qualified Data.ByteString.Lazy as LBS
import Language.Wasm.Structure
data FuncDef = FuncDef {
FuncDef -> [ValueType]
args :: [ValueType],
FuncDef -> [ValueType]
returns :: [ValueType],
FuncDef -> [ValueType]
locals :: [ValueType],
FuncDef -> Expression
instrs :: Expression
} deriving (Int -> FuncDef -> ShowS
[FuncDef] -> ShowS
FuncDef -> String
(Int -> FuncDef -> ShowS)
-> (FuncDef -> String) -> ([FuncDef] -> ShowS) -> Show FuncDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuncDef] -> ShowS
$cshowList :: [FuncDef] -> ShowS
show :: FuncDef -> String
$cshow :: FuncDef -> String
showsPrec :: Int -> FuncDef -> ShowS
$cshowsPrec :: Int -> FuncDef -> ShowS
Show, FuncDef -> FuncDef -> Bool
(FuncDef -> FuncDef -> Bool)
-> (FuncDef -> FuncDef -> Bool) -> Eq FuncDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuncDef -> FuncDef -> Bool
$c/= :: FuncDef -> FuncDef -> Bool
== :: FuncDef -> FuncDef -> Bool
$c== :: FuncDef -> FuncDef -> Bool
Eq)
type GenFun = ReaderT Natural (State FuncDef)
genExpr :: Natural -> GenFun a -> Expression
genExpr :: Natural -> GenFun a -> Expression
genExpr Natural
deep GenFun a
gen = FuncDef -> Expression
instrs (FuncDef -> Expression) -> FuncDef -> Expression
forall a b. (a -> b) -> a -> b
$ (State FuncDef a -> FuncDef -> FuncDef)
-> FuncDef -> State FuncDef a -> FuncDef
forall a b c. (a -> b -> c) -> b -> a -> c
flip State FuncDef a -> FuncDef -> FuncDef
forall s a. State s a -> s -> s
execState ([ValueType] -> [ValueType] -> [ValueType] -> Expression -> FuncDef
FuncDef [] [] [] []) (State FuncDef a -> FuncDef) -> State FuncDef a -> FuncDef
forall a b. (a -> b) -> a -> b
$ GenFun a -> Natural -> State FuncDef a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT GenFun a
gen Natural
deep
newtype Loc t = Loc Natural deriving (Int -> Loc t -> ShowS
[Loc t] -> ShowS
Loc t -> String
(Int -> Loc t -> ShowS)
-> (Loc t -> String) -> ([Loc t] -> ShowS) -> Show (Loc t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> Loc t -> ShowS
forall k (t :: k). [Loc t] -> ShowS
forall k (t :: k). Loc t -> String
showList :: [Loc t] -> ShowS
$cshowList :: forall k (t :: k). [Loc t] -> ShowS
show :: Loc t -> String
$cshow :: forall k (t :: k). Loc t -> String
showsPrec :: Int -> Loc t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> Loc t -> ShowS
Show, Loc t -> Loc t -> Bool
(Loc t -> Loc t -> Bool) -> (Loc t -> Loc t -> Bool) -> Eq (Loc t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). Loc t -> Loc t -> Bool
/= :: Loc t -> Loc t -> Bool
$c/= :: forall k (t :: k). Loc t -> Loc t -> Bool
== :: Loc t -> Loc t -> Bool
$c== :: forall k (t :: k). Loc t -> Loc t -> Bool
Eq)
param :: (ValueTypeable t) => Proxy t -> GenFun (Loc t)
param :: Proxy t -> GenFun (Loc t)
param Proxy t
t = do
f :: FuncDef
f@FuncDef { [ValueType]
args :: [ValueType]
$sel:args:FuncDef :: FuncDef -> [ValueType]
args } <- ReaderT Natural (State FuncDef) FuncDef
forall s (m :: * -> *). MonadState s m => m s
get
FuncDef -> ReaderT Natural (State FuncDef) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (FuncDef -> ReaderT Natural (State FuncDef) ())
-> FuncDef -> ReaderT Natural (State FuncDef) ()
forall a b. (a -> b) -> a -> b
$ FuncDef
f { $sel:args:FuncDef :: [ValueType]
args = [ValueType]
args [ValueType] -> [ValueType] -> [ValueType]
forall a. [a] -> [a] -> [a]
++ [Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t] }
Loc t -> GenFun (Loc t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Loc t -> GenFun (Loc t)) -> Loc t -> GenFun (Loc t)
forall a b. (a -> b) -> a -> b
$ Natural -> Loc t
forall k (t :: k). Natural -> Loc t
Loc (Natural -> Loc t) -> Natural -> Loc t
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [ValueType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValueType]
args
local :: (ValueTypeable t) => Proxy t -> GenFun (Loc t)
local :: Proxy t -> GenFun (Loc t)
local Proxy t
t = do
f :: FuncDef
f@FuncDef { [ValueType]
args :: [ValueType]
$sel:args:FuncDef :: FuncDef -> [ValueType]
args, [ValueType]
locals :: [ValueType]
$sel:locals:FuncDef :: FuncDef -> [ValueType]
locals } <- ReaderT Natural (State FuncDef) FuncDef
forall s (m :: * -> *). MonadState s m => m s
get
FuncDef -> ReaderT Natural (State FuncDef) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (FuncDef -> ReaderT Natural (State FuncDef) ())
-> FuncDef -> ReaderT Natural (State FuncDef) ()
forall a b. (a -> b) -> a -> b
$ FuncDef
f { $sel:locals:FuncDef :: [ValueType]
locals = [ValueType]
locals [ValueType] -> [ValueType] -> [ValueType]
forall a. [a] -> [a] -> [a]
++ [Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t]}
Loc t -> GenFun (Loc t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Loc t -> GenFun (Loc t)) -> Loc t -> GenFun (Loc t)
forall a b. (a -> b) -> a -> b
$ Natural -> Loc t
forall k (t :: k). Natural -> Loc t
Loc (Natural -> Loc t) -> Natural -> Loc t
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [ValueType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValueType]
args Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ValueType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValueType]
locals
appendExpr :: Expression -> GenFun ()
appendExpr :: Expression -> ReaderT Natural (State FuncDef) ()
appendExpr Expression
expr = do
(FuncDef -> FuncDef) -> ReaderT Natural (State FuncDef) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FuncDef -> FuncDef) -> ReaderT Natural (State FuncDef) ())
-> (FuncDef -> FuncDef) -> ReaderT Natural (State FuncDef) ()
forall a b. (a -> b) -> a -> b
$ \FuncDef
def -> FuncDef
def { $sel:instrs:FuncDef :: Expression
instrs = FuncDef -> Expression
instrs FuncDef
def Expression -> Expression -> Expression
forall a. [a] -> [a] -> [a]
++ Expression
expr }
() -> ReaderT Natural (State FuncDef) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
after :: Expression -> GenFun a -> GenFun a
after :: Expression -> GenFun a -> GenFun a
after Expression
instr GenFun a
expr = do
a
res <- GenFun a
expr
(FuncDef -> FuncDef) -> ReaderT Natural (State FuncDef) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FuncDef -> FuncDef) -> ReaderT Natural (State FuncDef) ())
-> (FuncDef -> FuncDef) -> ReaderT Natural (State FuncDef) ()
forall a b. (a -> b) -> a -> b
$ \FuncDef
def -> FuncDef
def { $sel:instrs:FuncDef :: Expression
instrs = FuncDef -> Expression
instrs FuncDef
def Expression -> Expression -> Expression
forall a. [a] -> [a] -> [a]
++ Expression
instr }
a -> GenFun a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
data TypedExpr
= ExprI32 (GenFun (Proxy I32))
| ExprI64 (GenFun (Proxy I64))
| ExprF32 (GenFun (Proxy F32))
| ExprF64 (GenFun (Proxy F64))
class Producer expr where
type OutType expr
asTypedExpr :: expr -> TypedExpr
asValueType :: expr -> ValueType
produce :: expr -> GenFun (OutType expr)
instance (ValueTypeable t) => Producer (Loc t) where
type OutType (Loc t) = Proxy t
asTypedExpr :: Loc t -> TypedExpr
asTypedExpr Loc t
e = case Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType (Loc t -> Proxy t
t Loc t
e) of
ValueType
I32 -> GenFun (Proxy 'I32) -> TypedExpr
ExprI32 (Loc t -> GenFun (OutType (Loc t))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce Loc t
e ReaderT Natural (State FuncDef) (Proxy t)
-> GenFun (Proxy 'I32) -> GenFun (Proxy 'I32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy)
ValueType
I64 -> GenFun (Proxy 'I64) -> TypedExpr
ExprI64 (Loc t -> GenFun (OutType (Loc t))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce Loc t
e ReaderT Natural (State FuncDef) (Proxy t)
-> GenFun (Proxy 'I64) -> GenFun (Proxy 'I64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I64 -> GenFun (Proxy 'I64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I64
forall k (t :: k). Proxy t
Proxy)
ValueType
F32 -> GenFun (Proxy 'F32) -> TypedExpr
ExprF32 (Loc t -> GenFun (OutType (Loc t))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce Loc t
e ReaderT Natural (State FuncDef) (Proxy t)
-> GenFun (Proxy 'F32) -> GenFun (Proxy 'F32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'F32 -> GenFun (Proxy 'F32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F32
forall k (t :: k). Proxy t
Proxy)
ValueType
F64 -> GenFun (Proxy 'F64) -> TypedExpr
ExprF64 (Loc t -> GenFun (OutType (Loc t))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce Loc t
e ReaderT Natural (State FuncDef) (Proxy t)
-> GenFun (Proxy 'F64) -> GenFun (Proxy 'F64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'F64 -> GenFun (Proxy 'F64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F64
forall k (t :: k). Proxy t
Proxy)
where
t :: Loc t -> Proxy t
t :: Loc t -> Proxy t
t Loc t
_ = Proxy t
forall k (t :: k). Proxy t
Proxy
asValueType :: Loc t -> ValueType
asValueType Loc t
e = Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType (Loc t -> Proxy t
t Loc t
e)
where
t :: Loc t -> Proxy t
t :: Loc t -> Proxy t
t Loc t
_ = Proxy t
forall k (t :: k). Proxy t
Proxy
produce :: Loc t -> GenFun (OutType (Loc t))
produce (Loc Natural
i) = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Natural -> Instruction Natural
forall index. index -> Instruction index
GetLocal Natural
i] ReaderT Natural (State FuncDef) ()
-> ReaderT Natural (State FuncDef) (Proxy t)
-> ReaderT Natural (State FuncDef) (Proxy t)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy t -> ReaderT Natural (State FuncDef) (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
instance (ValueTypeable t) => Producer (Glob t) where
type OutType (Glob t) = Proxy t
asTypedExpr :: Glob t -> TypedExpr
asTypedExpr Glob t
e = case Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType (Glob t -> Proxy t
t Glob t
e) of
ValueType
I32 -> GenFun (Proxy 'I32) -> TypedExpr
ExprI32 (Glob t -> GenFun (OutType (Glob t))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce Glob t
e ReaderT Natural (State FuncDef) (Proxy t)
-> GenFun (Proxy 'I32) -> GenFun (Proxy 'I32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy)
ValueType
I64 -> GenFun (Proxy 'I64) -> TypedExpr
ExprI64 (Glob t -> GenFun (OutType (Glob t))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce Glob t
e ReaderT Natural (State FuncDef) (Proxy t)
-> GenFun (Proxy 'I64) -> GenFun (Proxy 'I64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I64 -> GenFun (Proxy 'I64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I64
forall k (t :: k). Proxy t
Proxy)
ValueType
F32 -> GenFun (Proxy 'F32) -> TypedExpr
ExprF32 (Glob t -> GenFun (OutType (Glob t))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce Glob t
e ReaderT Natural (State FuncDef) (Proxy t)
-> GenFun (Proxy 'F32) -> GenFun (Proxy 'F32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'F32 -> GenFun (Proxy 'F32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F32
forall k (t :: k). Proxy t
Proxy)
ValueType
F64 -> GenFun (Proxy 'F64) -> TypedExpr
ExprF64 (Glob t -> GenFun (OutType (Glob t))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce Glob t
e ReaderT Natural (State FuncDef) (Proxy t)
-> GenFun (Proxy 'F64) -> GenFun (Proxy 'F64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'F64 -> GenFun (Proxy 'F64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F64
forall k (t :: k). Proxy t
Proxy)
where
t :: Glob t -> Proxy t
t :: Glob t -> Proxy t
t Glob t
_ = Proxy t
forall k (t :: k). Proxy t
Proxy
asValueType :: Glob t -> ValueType
asValueType Glob t
e = Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType (Glob t -> Proxy t
t Glob t
e)
where
t :: Glob t -> Proxy t
t :: Glob t -> Proxy t
t Glob t
_ = Proxy t
forall k (t :: k). Proxy t
Proxy
produce :: Glob t -> GenFun (OutType (Glob t))
produce (Glob Natural
i) = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Natural -> Instruction Natural
forall index. index -> Instruction index
GetGlobal Natural
i] ReaderT Natural (State FuncDef) ()
-> ReaderT Natural (State FuncDef) (Proxy t)
-> ReaderT Natural (State FuncDef) (Proxy t)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy t -> ReaderT Natural (State FuncDef) (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
instance (ValueTypeable t) => Producer (GenFun (Proxy t)) where
type OutType (GenFun (Proxy t)) = Proxy t
asTypedExpr :: GenFun (Proxy t) -> TypedExpr
asTypedExpr GenFun (Proxy t)
e = case Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType (GenFun (Proxy t) -> Proxy t
t GenFun (Proxy t)
e) of
ValueType
I32 -> GenFun (Proxy 'I32) -> TypedExpr
ExprI32 (GenFun (Proxy t) -> GenFun (OutType (GenFun (Proxy t)))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce GenFun (Proxy t)
e GenFun (Proxy t) -> GenFun (Proxy 'I32) -> GenFun (Proxy 'I32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy)
ValueType
I64 -> GenFun (Proxy 'I64) -> TypedExpr
ExprI64 (GenFun (Proxy t) -> GenFun (OutType (GenFun (Proxy t)))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce GenFun (Proxy t)
e GenFun (Proxy t) -> GenFun (Proxy 'I64) -> GenFun (Proxy 'I64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I64 -> GenFun (Proxy 'I64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I64
forall k (t :: k). Proxy t
Proxy)
ValueType
F32 -> GenFun (Proxy 'F32) -> TypedExpr
ExprF32 (GenFun (Proxy t) -> GenFun (OutType (GenFun (Proxy t)))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce GenFun (Proxy t)
e GenFun (Proxy t) -> GenFun (Proxy 'F32) -> GenFun (Proxy 'F32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'F32 -> GenFun (Proxy 'F32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F32
forall k (t :: k). Proxy t
Proxy)
ValueType
F64 -> GenFun (Proxy 'F64) -> TypedExpr
ExprF64 (GenFun (Proxy t) -> GenFun (OutType (GenFun (Proxy t)))
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce GenFun (Proxy t)
e GenFun (Proxy t) -> GenFun (Proxy 'F64) -> GenFun (Proxy 'F64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'F64 -> GenFun (Proxy 'F64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F64
forall k (t :: k). Proxy t
Proxy)
where
t :: GenFun (Proxy t) -> Proxy t
t :: GenFun (Proxy t) -> Proxy t
t GenFun (Proxy t)
_ = Proxy t
forall k (t :: k). Proxy t
Proxy
asValueType :: GenFun (Proxy t) -> ValueType
asValueType GenFun (Proxy t)
e = Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType (GenFun (Proxy t) -> Proxy t
t GenFun (Proxy t)
e)
where
t :: GenFun (Proxy t) -> Proxy t
t :: GenFun (Proxy t) -> Proxy t
t GenFun (Proxy t)
_ = Proxy t
forall k (t :: k). Proxy t
Proxy
produce :: GenFun (Proxy t) -> GenFun (OutType (GenFun (Proxy t)))
produce = GenFun (Proxy t) -> GenFun (OutType (GenFun (Proxy t)))
forall a. a -> a
id
ret :: (Producer expr) => expr -> GenFun (OutType expr)
ret :: expr -> GenFun (OutType expr)
ret = expr -> GenFun (OutType expr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce
arg :: (Producer expr) => expr -> GenFun ()
arg :: expr -> ReaderT Natural (State FuncDef) ()
arg expr
e = expr -> GenFun (OutType expr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce expr
e GenFun (OutType expr)
-> ReaderT Natural (State FuncDef) ()
-> ReaderT Natural (State FuncDef) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ReaderT Natural (State FuncDef) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
getSize :: ValueType -> BitSize
getSize :: ValueType -> BitSize
getSize ValueType
I32 = BitSize
BS32
getSize ValueType
I64 = BitSize
BS64
getSize ValueType
F32 = BitSize
BS32
getSize ValueType
F64 = BitSize
BS64
type family IsInt i :: Bool where
IsInt (Proxy I32) = True
IsInt (Proxy I64) = True
IsInt any = False
type family IsFloat i :: Bool where
IsFloat (Proxy F32) = True
IsFloat (Proxy F64) = True
IsFloat any = False
nop :: GenFun ()
nop :: ReaderT Natural (State FuncDef) ()
nop = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
Nop]
drop :: (Producer val) => val -> GenFun ()
drop :: val -> ReaderT Natural (State FuncDef) ()
drop val
val = do
val -> GenFun (OutType val)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce val
val
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
Drop]
select :: (Producer a, Producer b, OutType a ~ OutType b, Producer pred, OutType pred ~ Proxy I32) => pred -> a -> b -> GenFun (OutType a)
select :: pred -> a -> b -> GenFun (OutType a)
select pred
pred a
a b
b = GenFun (Proxy 'I32)
-> GenFun (OutType b) -> GenFun (OutType b) -> GenFun (OutType b)
forall pred val.
GenFun pred -> GenFun val -> GenFun val -> GenFun val
select' (pred -> GenFun (OutType pred)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce pred
pred) (a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a) (b -> GenFun (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
where
select' :: GenFun pred -> GenFun val -> GenFun val -> GenFun val
select' :: GenFun pred -> GenFun val -> GenFun val -> GenFun val
select' GenFun pred
pred GenFun val
a GenFun val
b = do
GenFun val
a
val
res <- GenFun val
b
GenFun pred
pred
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
Select]
val -> GenFun val
forall (m :: * -> *) a. Monad m => a -> m a
return val
res
iBinOp :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => IBinOp -> a -> b -> GenFun (OutType a)
iBinOp :: IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
op a
a b
b = a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> IBinOp -> Instruction Natural
forall index. BitSize -> IBinOp -> Instruction index
IBinOp (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a) IBinOp
op] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
iUnOp :: (Producer a, IsInt (OutType a) ~ True) => IUnOp -> a -> GenFun (OutType a)
iUnOp :: IUnOp -> a -> GenFun (OutType a)
iUnOp IUnOp
op a
a = Expression -> GenFun (OutType a) -> GenFun (OutType a)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> IUnOp -> Instruction Natural
forall index. BitSize -> IUnOp -> Instruction index
IUnOp (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a) IUnOp
op] (a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a)
iRelOp :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => IRelOp -> a -> b -> GenFun (Proxy I32)
iRelOp :: IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
op a
a b
b = do
a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a
b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> IRelOp -> Instruction Natural
forall index. BitSize -> IRelOp -> Instruction index
IRelOp (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a) IRelOp
op]
Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy
add :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (OutType a)
add :: a -> b -> GenFun (OutType a)
add a
a b
b = do
a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a
case a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a of
ValueType
I32 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> IBinOp -> Instruction Natural
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IAdd] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
I64 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> IBinOp -> Instruction Natural
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IAdd] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
F32 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> FBinOp -> Instruction Natural
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FAdd] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
F64 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> FBinOp -> Instruction Natural
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FAdd] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
inc :: (Consumer a, Producer a, Integral i) => i -> a -> GenFun ()
inc :: i -> a -> ReaderT Natural (State FuncDef) ()
inc i
i a
a = case a -> TypedExpr
forall expr. Producer expr => expr -> TypedExpr
asTypedExpr a
a of
ExprI32 GenFun (Proxy 'I32)
e -> a
a a -> GenFun (Proxy 'I32) -> ReaderT Natural (State FuncDef) ()
forall loc expr.
(Consumer loc, Producer expr) =>
loc -> expr -> ReaderT Natural (State FuncDef) ()
.= (GenFun (Proxy 'I32)
e GenFun (Proxy 'I32)
-> GenFun (Proxy 'I32) -> GenFun (OutType (GenFun (Proxy 'I32)))
forall a b.
(Producer a, Producer b, OutType a ~ OutType b) =>
a -> b -> GenFun (OutType a)
`add` i -> GenFun (Proxy 'I32)
forall i. Integral i => i -> GenFun (Proxy 'I32)
i32c i
i)
ExprI64 GenFun (Proxy 'I64)
e -> a
a a -> GenFun (Proxy 'I64) -> ReaderT Natural (State FuncDef) ()
forall loc expr.
(Consumer loc, Producer expr) =>
loc -> expr -> ReaderT Natural (State FuncDef) ()
.= (GenFun (Proxy 'I64)
e GenFun (Proxy 'I64)
-> GenFun (Proxy 'I64) -> GenFun (OutType (GenFun (Proxy 'I64)))
forall a b.
(Producer a, Producer b, OutType a ~ OutType b) =>
a -> b -> GenFun (OutType a)
`add` i -> GenFun (Proxy 'I64)
forall i. Integral i => i -> GenFun (Proxy 'I64)
i64c i
i)
ExprF32 GenFun (Proxy 'F32)
e -> a
a a -> GenFun (Proxy 'F32) -> ReaderT Natural (State FuncDef) ()
forall loc expr.
(Consumer loc, Producer expr) =>
loc -> expr -> ReaderT Natural (State FuncDef) ()
.= (GenFun (Proxy 'F32)
e GenFun (Proxy 'F32)
-> GenFun (Proxy 'F32) -> GenFun (OutType (GenFun (Proxy 'F32)))
forall a b.
(Producer a, Producer b, OutType a ~ OutType b) =>
a -> b -> GenFun (OutType a)
`add` Float -> GenFun (Proxy 'F32)
f32c (i -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i))
ExprF64 GenFun (Proxy 'F64)
e -> a
a a -> GenFun (Proxy 'F64) -> ReaderT Natural (State FuncDef) ()
forall loc expr.
(Consumer loc, Producer expr) =>
loc -> expr -> ReaderT Natural (State FuncDef) ()
.= (GenFun (Proxy 'F64)
e GenFun (Proxy 'F64)
-> GenFun (Proxy 'F64) -> GenFun (OutType (GenFun (Proxy 'F64)))
forall a b.
(Producer a, Producer b, OutType a ~ OutType b) =>
a -> b -> GenFun (OutType a)
`add` Double -> GenFun (Proxy 'F64)
f64c (i -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i))
sub :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (OutType a)
sub :: a -> b -> GenFun (OutType a)
sub a
a b
b = do
a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a
case a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a of
ValueType
I32 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> IBinOp -> Instruction Natural
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
ISub] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
I64 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> IBinOp -> Instruction Natural
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
ISub] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
F32 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> FBinOp -> Instruction Natural
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FSub] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
F64 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> FBinOp -> Instruction Natural
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FSub] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
dec :: (Consumer a, Producer a, Integral i) => i -> a -> GenFun ()
dec :: i -> a -> ReaderT Natural (State FuncDef) ()
dec i
i a
a = case a -> TypedExpr
forall expr. Producer expr => expr -> TypedExpr
asTypedExpr a
a of
ExprI32 GenFun (Proxy 'I32)
e -> a
a a -> GenFun (Proxy 'I32) -> ReaderT Natural (State FuncDef) ()
forall loc expr.
(Consumer loc, Producer expr) =>
loc -> expr -> ReaderT Natural (State FuncDef) ()
.= (GenFun (Proxy 'I32)
e GenFun (Proxy 'I32)
-> GenFun (Proxy 'I32) -> GenFun (OutType (GenFun (Proxy 'I32)))
forall a b.
(Producer a, Producer b, OutType a ~ OutType b) =>
a -> b -> GenFun (OutType a)
`sub` i -> GenFun (Proxy 'I32)
forall i. Integral i => i -> GenFun (Proxy 'I32)
i32c i
i)
ExprI64 GenFun (Proxy 'I64)
e -> a
a a -> GenFun (Proxy 'I64) -> ReaderT Natural (State FuncDef) ()
forall loc expr.
(Consumer loc, Producer expr) =>
loc -> expr -> ReaderT Natural (State FuncDef) ()
.= (GenFun (Proxy 'I64)
e GenFun (Proxy 'I64)
-> GenFun (Proxy 'I64) -> GenFun (OutType (GenFun (Proxy 'I64)))
forall a b.
(Producer a, Producer b, OutType a ~ OutType b) =>
a -> b -> GenFun (OutType a)
`sub` i -> GenFun (Proxy 'I64)
forall i. Integral i => i -> GenFun (Proxy 'I64)
i64c i
i)
ExprF32 GenFun (Proxy 'F32)
e -> a
a a -> GenFun (Proxy 'F32) -> ReaderT Natural (State FuncDef) ()
forall loc expr.
(Consumer loc, Producer expr) =>
loc -> expr -> ReaderT Natural (State FuncDef) ()
.= (GenFun (Proxy 'F32)
e GenFun (Proxy 'F32)
-> GenFun (Proxy 'F32) -> GenFun (OutType (GenFun (Proxy 'F32)))
forall a b.
(Producer a, Producer b, OutType a ~ OutType b) =>
a -> b -> GenFun (OutType a)
`sub` Float -> GenFun (Proxy 'F32)
f32c (i -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i))
ExprF64 GenFun (Proxy 'F64)
e -> a
a a -> GenFun (Proxy 'F64) -> ReaderT Natural (State FuncDef) ()
forall loc expr.
(Consumer loc, Producer expr) =>
loc -> expr -> ReaderT Natural (State FuncDef) ()
.= (GenFun (Proxy 'F64)
e GenFun (Proxy 'F64)
-> GenFun (Proxy 'F64) -> GenFun (OutType (GenFun (Proxy 'F64)))
forall a b.
(Producer a, Producer b, OutType a ~ OutType b) =>
a -> b -> GenFun (OutType a)
`sub` Double -> GenFun (Proxy 'F64)
f64c (i -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i))
mul :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (OutType a)
mul :: a -> b -> GenFun (OutType a)
mul a
a b
b = do
a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a
case a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a of
ValueType
I32 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> IBinOp -> Instruction Natural
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IMul] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
I64 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> IBinOp -> Instruction Natural
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IMul] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
F32 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> FBinOp -> Instruction Natural
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FMul] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
ValueType
F64 -> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> FBinOp -> Instruction Natural
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FMul] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
div_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
div_u :: a -> b -> GenFun (OutType a)
div_u = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IDivU
div_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
div_s :: a -> b -> GenFun (OutType a)
div_s = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IDivS
rem_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
rem_u :: a -> b -> GenFun (OutType a)
rem_u = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IRemU
rem_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
rem_s :: a -> b -> GenFun (OutType a)
rem_s = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IRemS
and :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
and :: a -> b -> GenFun (OutType a)
and = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IAnd
or :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
or :: a -> b -> GenFun (OutType a)
or = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IOr
xor :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
xor :: a -> b -> GenFun (OutType a)
xor = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IXor
shl :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
shl :: a -> b -> GenFun (OutType a)
shl = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IShl
shr_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
shr_u :: a -> b -> GenFun (OutType a)
shr_u = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IShrU
shr_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
shr_s :: a -> b -> GenFun (OutType a)
shr_s = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IShrS
rotl :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
rotl :: a -> b -> GenFun (OutType a)
rotl = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IRotl
rotr :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
rotr :: a -> b -> GenFun (OutType a)
rotr = IBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IBinOp -> a -> b -> GenFun (OutType a)
iBinOp IBinOp
IRotr
clz :: (Producer a, IsInt (OutType a) ~ True) => a -> GenFun (OutType a)
clz :: a -> GenFun (OutType a)
clz = IUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsInt (OutType a) ~ 'True) =>
IUnOp -> a -> GenFun (OutType a)
iUnOp IUnOp
IClz
ctz :: (Producer a, IsInt (OutType a) ~ True) => a -> GenFun (OutType a)
ctz :: a -> GenFun (OutType a)
ctz = IUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsInt (OutType a) ~ 'True) =>
IUnOp -> a -> GenFun (OutType a)
iUnOp IUnOp
ICtz
popcnt :: (Producer a, IsInt (OutType a) ~ True) => a -> GenFun (OutType a)
popcnt :: a -> GenFun (OutType a)
popcnt = IUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsInt (OutType a) ~ 'True) =>
IUnOp -> a -> GenFun (OutType a)
iUnOp IUnOp
IPopcnt
eq :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (Proxy I32)
eq :: a -> b -> GenFun (Proxy 'I32)
eq a
a b
b = do
a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a
b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b
case a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> IRelOp -> Instruction Natural
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
IEq]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> IRelOp -> Instruction Natural
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
IEq]
ValueType
F32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> FRelOp -> Instruction Natural
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS32 FRelOp
FEq]
ValueType
F64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> FRelOp -> Instruction Natural
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS64 FRelOp
FEq]
Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy
ne :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (Proxy I32)
ne :: a -> b -> GenFun (Proxy 'I32)
ne a
a b
b = do
a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a
b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b
case a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> IRelOp -> Instruction Natural
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
INe]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> IRelOp -> Instruction Natural
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
INe]
ValueType
F32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> FRelOp -> Instruction Natural
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS32 FRelOp
FNe]
ValueType
F64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> FRelOp -> Instruction Natural
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS64 FRelOp
FNe]
Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy
lt_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
lt_s :: a -> b -> GenFun (Proxy 'I32)
lt_s = IRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
ILtS
lt_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
lt_u :: a -> b -> GenFun (Proxy 'I32)
lt_u = IRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
ILtU
gt_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
gt_s :: a -> b -> GenFun (Proxy 'I32)
gt_s = IRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
IGtS
gt_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
gt_u :: a -> b -> GenFun (Proxy 'I32)
gt_u = IRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
IGtU
le_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
le_s :: a -> b -> GenFun (Proxy 'I32)
le_s = IRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
ILeS
le_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
le_u :: a -> b -> GenFun (Proxy 'I32)
le_u = IRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
ILeU
ge_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
ge_s :: a -> b -> GenFun (Proxy 'I32)
ge_s = IRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
IGeS
ge_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
ge_u :: a -> b -> GenFun (Proxy 'I32)
ge_u = IRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsInt (OutType a) ~ 'True) =>
IRelOp -> a -> b -> GenFun (Proxy 'I32)
iRelOp IRelOp
IGeU
eqz :: (Producer a, IsInt (OutType a) ~ True) => a -> GenFun (Proxy I32)
eqz :: a -> GenFun (Proxy 'I32)
eqz a
a = do
a -> ReaderT Natural (State FuncDef) (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a
case a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
I32Eqz]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
I64Eqz]
ValueType
_ -> String -> ReaderT Natural (State FuncDef) ()
forall a. HasCallStack => String -> a
error String
"Impossible by type constraint"
Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy
fBinOp :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => FBinOp -> a -> b -> GenFun (OutType a)
fBinOp :: FBinOp -> a -> b -> GenFun (OutType a)
fBinOp FBinOp
op a
a b
b = a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expression
-> ReaderT Natural (State FuncDef) (OutType b)
-> ReaderT Natural (State FuncDef) (OutType b)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> FBinOp -> Instruction Natural
forall index. BitSize -> FBinOp -> Instruction index
FBinOp (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a) FBinOp
op] (b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b)
fUnOp :: (Producer a, IsFloat (OutType a) ~ True) => FUnOp -> a -> GenFun (OutType a)
fUnOp :: FUnOp -> a -> GenFun (OutType a)
fUnOp FUnOp
op a
a = Expression -> GenFun (OutType a) -> GenFun (OutType a)
forall a. Expression -> GenFun a -> GenFun a
after [BitSize -> FUnOp -> Instruction Natural
forall index. BitSize -> FUnOp -> Instruction index
FUnOp (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a) FUnOp
op] (a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a)
fRelOp :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => FRelOp -> a -> b -> GenFun (Proxy I32)
fRelOp :: FRelOp -> a -> b -> GenFun (Proxy 'I32)
fRelOp FRelOp
op a
a b
b = do
a -> GenFun (OutType a)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce a
a
b -> ReaderT Natural (State FuncDef) (OutType b)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce b
b
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> FRelOp -> Instruction Natural
forall index. BitSize -> FRelOp -> Instruction index
FRelOp (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ a -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType a
a) FRelOp
op]
Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy
div_f :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => a -> b -> GenFun (OutType a)
div_f :: a -> b -> GenFun (OutType a)
div_f = FBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsFloat (OutType a) ~ 'True) =>
FBinOp -> a -> b -> GenFun (OutType a)
fBinOp FBinOp
FDiv
min_f :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => a -> b -> GenFun (OutType a)
min_f :: a -> b -> GenFun (OutType a)
min_f = FBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsFloat (OutType a) ~ 'True) =>
FBinOp -> a -> b -> GenFun (OutType a)
fBinOp FBinOp
FMin
max_f :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => a -> b -> GenFun (OutType a)
max_f :: a -> b -> GenFun (OutType a)
max_f = FBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsFloat (OutType a) ~ 'True) =>
FBinOp -> a -> b -> GenFun (OutType a)
fBinOp FBinOp
FMax
copySign :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => a -> b -> GenFun (OutType a)
copySign :: a -> b -> GenFun (OutType a)
copySign = FBinOp -> a -> b -> GenFun (OutType a)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsFloat (OutType a) ~ 'True) =>
FBinOp -> a -> b -> GenFun (OutType a)
fBinOp FBinOp
FCopySign
abs_f :: (Producer a, IsFloat (OutType a) ~ True) => a -> GenFun (OutType a)
abs_f :: a -> GenFun (OutType a)
abs_f = FUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsFloat (OutType a) ~ 'True) =>
FUnOp -> a -> GenFun (OutType a)
fUnOp FUnOp
FAbs
neg_f :: (Producer a, IsFloat (OutType a) ~ True) => a -> GenFun (OutType a)
neg_f :: a -> GenFun (OutType a)
neg_f = FUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsFloat (OutType a) ~ 'True) =>
FUnOp -> a -> GenFun (OutType a)
fUnOp FUnOp
FNeg
ceil_f :: (Producer a, IsFloat (OutType a) ~ True) => a -> GenFun (OutType a)
ceil_f :: a -> GenFun (OutType a)
ceil_f = FUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsFloat (OutType a) ~ 'True) =>
FUnOp -> a -> GenFun (OutType a)
fUnOp FUnOp
FCeil
floor_f :: (Producer a, IsFloat (OutType a) ~ True) => a -> GenFun (OutType a)
floor_f :: a -> GenFun (OutType a)
floor_f = FUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsFloat (OutType a) ~ 'True) =>
FUnOp -> a -> GenFun (OutType a)
fUnOp FUnOp
FFloor
trunc_f :: (Producer a, IsFloat (OutType a) ~ True) => a -> GenFun (OutType a)
trunc_f :: a -> GenFun (OutType a)
trunc_f = FUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsFloat (OutType a) ~ 'True) =>
FUnOp -> a -> GenFun (OutType a)
fUnOp FUnOp
FTrunc
nearest_f :: (Producer a, IsFloat (OutType a) ~ True) => a -> GenFun (OutType a)
nearest_f :: a -> GenFun (OutType a)
nearest_f = FUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsFloat (OutType a) ~ 'True) =>
FUnOp -> a -> GenFun (OutType a)
fUnOp FUnOp
FAbs
sqrt_f :: (Producer a, IsFloat (OutType a) ~ True) => a -> GenFun (OutType a)
sqrt_f :: a -> GenFun (OutType a)
sqrt_f = FUnOp -> a -> GenFun (OutType a)
forall a.
(Producer a, IsFloat (OutType a) ~ 'True) =>
FUnOp -> a -> GenFun (OutType a)
fUnOp FUnOp
FAbs
lt_f :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
lt_f :: a -> b -> GenFun (Proxy 'I32)
lt_f = FRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsFloat (OutType a) ~ 'True) =>
FRelOp -> a -> b -> GenFun (Proxy 'I32)
fRelOp FRelOp
FLt
gt_f :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
gt_f :: a -> b -> GenFun (Proxy 'I32)
gt_f = FRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsFloat (OutType a) ~ 'True) =>
FRelOp -> a -> b -> GenFun (Proxy 'I32)
fRelOp FRelOp
FGt
le_f :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
le_f :: a -> b -> GenFun (Proxy 'I32)
le_f = FRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsFloat (OutType a) ~ 'True) =>
FRelOp -> a -> b -> GenFun (Proxy 'I32)
fRelOp FRelOp
FLe
ge_f :: (Producer a, Producer b, OutType a ~ OutType b, IsFloat (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
ge_f :: a -> b -> GenFun (Proxy 'I32)
ge_f = FRelOp -> a -> b -> GenFun (Proxy 'I32)
forall a b.
(Producer a, Producer b, OutType a ~ OutType b,
IsFloat (OutType a) ~ 'True) =>
FRelOp -> a -> b -> GenFun (Proxy 'I32)
fRelOp FRelOp
FGe
i32c :: (Integral i) => i -> GenFun (Proxy I32)
i32c :: i -> GenFun (Proxy 'I32)
i32c i
i = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Word32 -> Instruction Natural
forall index. Word32 -> Instruction index
I32Const (Word32 -> Instruction Natural) -> Word32 -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ i -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i] ReaderT Natural (State FuncDef) ()
-> GenFun (Proxy 'I32) -> GenFun (Proxy 'I32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy
i64c :: (Integral i) => i -> GenFun (Proxy I64)
i64c :: i -> GenFun (Proxy 'I64)
i64c i
i = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Word64 -> Instruction Natural
forall index. Word64 -> Instruction index
I64Const (Word64 -> Instruction Natural) -> Word64 -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ i -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i] ReaderT Natural (State FuncDef) ()
-> GenFun (Proxy 'I64) -> GenFun (Proxy 'I64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I64 -> GenFun (Proxy 'I64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I64
forall k (t :: k). Proxy t
Proxy
f32c :: Float -> GenFun (Proxy F32)
f32c :: Float -> GenFun (Proxy 'F32)
f32c Float
f = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Float -> Instruction Natural
forall index. Float -> Instruction index
F32Const Float
f] ReaderT Natural (State FuncDef) ()
-> GenFun (Proxy 'F32) -> GenFun (Proxy 'F32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'F32 -> GenFun (Proxy 'F32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F32
forall k (t :: k). Proxy t
Proxy
f64c :: Double -> GenFun (Proxy F64)
f64c :: Double -> GenFun (Proxy 'F64)
f64c Double
d = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Double -> Instruction Natural
forall index. Double -> Instruction index
F64Const Double
d] ReaderT Natural (State FuncDef) ()
-> GenFun (Proxy 'F64) -> GenFun (Proxy 'F64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'F64 -> GenFun (Proxy 'F64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F64
forall k (t :: k). Proxy t
Proxy
wrap :: (Producer i, OutType i ~ Proxy I64) => i -> GenFun (Proxy I32)
wrap :: i -> GenFun (Proxy 'I32)
wrap i
big = do
i -> GenFun (OutType i)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce i
big
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
I32WrapI64]
Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy
trunc_u :: (Producer f, IsFloat (OutType f) ~ True, IsInt (Proxy t) ~ True, ValueTypeable t) => Proxy t -> f -> GenFun (Proxy t)
trunc_u :: Proxy t -> f -> GenFun (Proxy t)
trunc_u Proxy t
t f
float = do
f -> ReaderT Natural (State FuncDef) (OutType f)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce f
float
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> BitSize -> Instruction Natural
forall index. BitSize -> BitSize -> Instruction index
ITruncFU (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t) (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ f -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType f
float)]
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
trunc_s :: (Producer f, IsFloat (OutType f) ~ True, IsInt (Proxy t) ~ True, ValueTypeable t) => Proxy t -> f -> GenFun (Proxy t)
trunc_s :: Proxy t -> f -> GenFun (Proxy t)
trunc_s Proxy t
t f
float = do
f -> ReaderT Natural (State FuncDef) (OutType f)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce f
float
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> BitSize -> Instruction Natural
forall index. BitSize -> BitSize -> Instruction index
ITruncFS (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t) (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ f -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType f
float)]
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
extend_u :: (Producer i, OutType i ~ Proxy I32) => i -> GenFun (Proxy I64)
extend_u :: i -> GenFun (Proxy 'I64)
extend_u i
small = do
i -> GenFun (OutType i)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce i
small
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
I64ExtendUI32]
Proxy 'I64 -> GenFun (Proxy 'I64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I64
forall k (t :: k). Proxy t
Proxy
extend_s :: (Producer i, OutType i ~ Proxy I32) => i -> GenFun (Proxy I64)
extend_s :: i -> GenFun (Proxy 'I64)
extend_s i
small = do
i -> GenFun (OutType i)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce i
small
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
I64ExtendSI32]
Proxy 'I64 -> GenFun (Proxy 'I64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I64
forall k (t :: k). Proxy t
Proxy
convert_u :: (Producer i, IsInt (OutType i) ~ True, IsFloat (Proxy t) ~ True, ValueTypeable t) => Proxy t -> i -> GenFun (Proxy t)
convert_u :: Proxy t -> i -> GenFun (Proxy t)
convert_u Proxy t
t i
int = do
i -> ReaderT Natural (State FuncDef) (OutType i)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce i
int
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> BitSize -> Instruction Natural
forall index. BitSize -> BitSize -> Instruction index
FConvertIU (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t) (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ i -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType i
int)]
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
convert_s :: (Producer i, IsInt (OutType i) ~ True, IsFloat (Proxy t) ~ True, ValueTypeable t) => Proxy t -> i -> GenFun (Proxy t)
convert_s :: Proxy t -> i -> GenFun (Proxy t)
convert_s Proxy t
t i
int = do
i -> ReaderT Natural (State FuncDef) (OutType i)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce i
int
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> BitSize -> Instruction Natural
forall index. BitSize -> BitSize -> Instruction index
FConvertIS (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t) (ValueType -> BitSize
getSize (ValueType -> BitSize) -> ValueType -> BitSize
forall a b. (a -> b) -> a -> b
$ i -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType i
int)]
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
demote :: (Producer f, OutType f ~ Proxy F64) => f -> GenFun (Proxy F32)
demote :: f -> GenFun (Proxy 'F32)
demote f
f = do
f -> GenFun (OutType f)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce f
f
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
F32DemoteF64]
Proxy 'F32 -> GenFun (Proxy 'F32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F32
forall k (t :: k). Proxy t
Proxy
promote :: (Producer f, OutType f ~ Proxy F32) => f -> GenFun (Proxy F64)
promote :: f -> GenFun (Proxy 'F64)
promote f
f = do
f -> GenFun (OutType f)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce f
f
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
F64PromoteF32]
Proxy 'F64 -> GenFun (Proxy 'F64)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'F64
forall k (t :: k). Proxy t
Proxy
type family SameSize a b where
SameSize (Proxy I32) (Proxy F32) = True
SameSize (Proxy I64) (Proxy F64) = True
SameSize (Proxy F32) (Proxy I32) = True
SameSize (Proxy F64) (Proxy I64) = True
SameSize a b = False
reinterpret :: (ValueTypeable t, Producer val, SameSize (Proxy t) (OutType val) ~ True) => Proxy t -> val -> GenFun (Proxy t)
reinterpret :: Proxy t -> val -> GenFun (Proxy t)
reinterpret Proxy t
t val
val = do
case (Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t, val -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType val
val) of
(ValueType
I32, ValueType
F32) -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> Instruction Natural
forall index. BitSize -> Instruction index
IReinterpretF BitSize
BS32]
(ValueType
I64, ValueType
F64) -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> Instruction Natural
forall index. BitSize -> Instruction index
IReinterpretF BitSize
BS64]
(ValueType
F32, ValueType
I32) -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> Instruction Natural
forall index. BitSize -> Instruction index
FReinterpretI BitSize
BS32]
(ValueType
F64, ValueType
I64) -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [BitSize -> Instruction Natural
forall index. BitSize -> Instruction index
FReinterpretI BitSize
BS64]
(ValueType, ValueType)
_ -> String -> ReaderT Natural (State FuncDef) ()
forall a. HasCallStack => String -> a
error String
"Impossible by type constraint"
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
load :: (ValueTypeable t, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
=> Proxy t
-> addr
-> offset
-> align
-> GenFun (Proxy t)
load :: Proxy t -> addr -> offset -> align -> GenFun (Proxy t)
load Proxy t
t addr
addr offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
case Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I32Load (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Load (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
F32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
F32Load (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
F64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
F64Load (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
load8_u :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
=> Proxy t
-> addr
-> offset
-> align
-> GenFun (Proxy t)
load8_u :: Proxy t -> addr -> offset -> align -> GenFun (Proxy t)
load8_u Proxy t
t addr
addr offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
case Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I32Load8U (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Load8U (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
_ -> String -> ReaderT Natural (State FuncDef) ()
forall a. HasCallStack => String -> a
error String
"Impossible by type constraint"
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
load8_s :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
=> Proxy t
-> addr
-> offset
-> align
-> GenFun (Proxy t)
load8_s :: Proxy t -> addr -> offset -> align -> GenFun (Proxy t)
load8_s Proxy t
t addr
addr offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
case Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I32Load8S (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Load8S (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
_ -> String -> ReaderT Natural (State FuncDef) ()
forall a. HasCallStack => String -> a
error String
"Impossible by type constraint"
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
load16_u :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
=> Proxy t
-> addr
-> offset
-> align
-> GenFun (Proxy t)
load16_u :: Proxy t -> addr -> offset -> align -> GenFun (Proxy t)
load16_u Proxy t
t addr
addr offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
case Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I32Load16U (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Load16U (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
_ -> String -> ReaderT Natural (State FuncDef) ()
forall a. HasCallStack => String -> a
error String
"Impossible by type constraint"
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
load16_s :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
=> Proxy t
-> addr
-> offset
-> align
-> GenFun (Proxy t)
load16_s :: Proxy t -> addr -> offset -> align -> GenFun (Proxy t)
load16_s Proxy t
t addr
addr offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
case Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I32Load16S (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Load16S (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
_ -> String -> ReaderT Natural (State FuncDef) ()
forall a. HasCallStack => String -> a
error String
"Impossible by type constraint"
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
load32_u :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
=> Proxy t
-> addr
-> offset
-> align
-> GenFun (Proxy t)
load32_u :: Proxy t -> addr -> offset -> align -> GenFun (Proxy t)
load32_u Proxy t
t addr
addr offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Load32U (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
load32_s :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
=> Proxy t
-> addr
-> offset
-> align
-> GenFun (Proxy t)
load32_s :: Proxy t -> addr -> offset -> align -> GenFun (Proxy t)
load32_s Proxy t
t addr
addr offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Load32S (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
forall k (t :: k). Proxy t
Proxy
store :: (Producer addr, OutType addr ~ Proxy I32, Producer val, Integral offset, Integral align)
=> addr
-> val
-> offset
-> align
-> GenFun ()
store :: addr
-> val -> offset -> align -> ReaderT Natural (State FuncDef) ()
store addr
addr val
val offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
val -> GenFun (OutType val)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce val
val
case val -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType val
val of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I32Store (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Store (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
F32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
F32Store (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
F64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
F64Store (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
store8 :: (Producer addr, OutType addr ~ Proxy I32, Producer val, IsInt (OutType val) ~ True, Integral offset, Integral align)
=> addr
-> val
-> offset
-> align
-> GenFun ()
store8 :: addr
-> val -> offset -> align -> ReaderT Natural (State FuncDef) ()
store8 addr
addr val
val offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
val -> ReaderT Natural (State FuncDef) (OutType val)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce val
val
case val -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType val
val of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I32Store8 (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Store8 (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
_ -> String -> ReaderT Natural (State FuncDef) ()
forall a. HasCallStack => String -> a
error String
"Impossible by type constraint"
store16 :: (Producer addr, OutType addr ~ Proxy I32, Producer val, IsInt (OutType val) ~ True, Integral offset, Integral align)
=> addr
-> val
-> offset
-> align
-> GenFun ()
store16 :: addr
-> val -> offset -> align -> ReaderT Natural (State FuncDef) ()
store16 addr
addr val
val offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
val -> ReaderT Natural (State FuncDef) (OutType val)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce val
val
case val -> ValueType
forall expr. Producer expr => expr -> ValueType
asValueType val
val of
ValueType
I32 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I32Store16 (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
I64 -> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Store16 (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
ValueType
_ -> String -> ReaderT Natural (State FuncDef) ()
forall a. HasCallStack => String -> a
error String
"Impossible by type constraint"
store32 :: (Producer addr, OutType addr ~ Proxy I32, Producer val, OutType val ~ Proxy I64, Integral offset, Integral align)
=> addr
-> val
-> offset
-> align
-> GenFun ()
store32 :: addr
-> val -> offset -> align -> ReaderT Natural (State FuncDef) ()
store32 addr
addr val
val offset
offset align
align = do
addr -> GenFun (OutType addr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce addr
addr
val -> GenFun (OutType val)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce val
val
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [MemArg -> Instruction Natural
forall index. MemArg -> Instruction index
I64Store32 (MemArg -> Instruction Natural) -> MemArg -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> MemArg
MemArg (offset -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral offset
offset) (align -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral align
align)]
memorySize :: GenFun (Proxy I32)
memorySize :: GenFun (Proxy 'I32)
memorySize = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
CurrentMemory] ReaderT Natural (State FuncDef) ()
-> GenFun (Proxy 'I32) -> GenFun (Proxy 'I32)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy 'I32 -> GenFun (Proxy 'I32)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy 'I32
forall k (t :: k). Proxy t
Proxy
growMemory :: (Producer size, OutType size ~ Proxy I32) => size -> GenFun ()
growMemory :: size -> ReaderT Natural (State FuncDef) ()
growMemory size
size = size -> GenFun (OutType size)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce size
size GenFun (Proxy 'I32)
-> ReaderT Natural (State FuncDef) ()
-> ReaderT Natural (State FuncDef) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
GrowMemory]
call :: (Returnable res) => Fn res -> [GenFun a] -> GenFun res
call :: Fn res -> [GenFun a] -> GenFun res
call (Fn Natural
idx) [GenFun a]
args = [GenFun a] -> ReaderT Natural (State FuncDef) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GenFun a]
args ReaderT Natural (State FuncDef) ()
-> ReaderT Natural (State FuncDef) ()
-> ReaderT Natural (State FuncDef) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Natural -> Instruction Natural
forall index. index -> Instruction index
Call Natural
idx] ReaderT Natural (State FuncDef) () -> GenFun res -> GenFun res
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> res -> GenFun res
forall (m :: * -> *) a. Monad m => a -> m a
return res
forall a. Returnable a => a
returnableValue
callIndirect :: (Producer index, OutType index ~ Proxy I32, Returnable res) => TypeDef res -> index -> [GenFun a] -> GenFun res
callIndirect :: TypeDef res -> index -> [GenFun a] -> GenFun res
callIndirect (TypeDef Natural
idx) index
index [GenFun a]
args = do
[GenFun a] -> ReaderT Natural (State FuncDef) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [GenFun a]
args
index -> GenFun (OutType index)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce index
index
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Natural -> Instruction Natural
forall index. index -> Instruction index
CallIndirect Natural
idx]
res -> GenFun res
forall (m :: * -> *) a. Monad m => a -> m a
return res
forall a. Returnable a => a
returnableValue
br :: Label t -> GenFun ()
br :: Label t -> ReaderT Natural (State FuncDef) ()
br (Label Natural
labelDeep) = do
Natural
deep <- ReaderT Natural (State FuncDef) Natural
forall r (m :: * -> *). MonadReader r m => m r
ask
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Natural -> Instruction Natural
forall index. index -> Instruction index
Br (Natural -> Instruction Natural) -> Natural -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural
deep Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
labelDeep]
brIf :: (Producer pred, OutType pred ~ Proxy I32) => pred -> Label t -> GenFun ()
brIf :: pred -> Label t -> ReaderT Natural (State FuncDef) ()
brIf pred
pred (Label Natural
labelDeep) = do
pred -> GenFun (OutType pred)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce pred
pred
Natural
deep <- ReaderT Natural (State FuncDef) Natural
forall r (m :: * -> *). MonadReader r m => m r
ask
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Natural -> Instruction Natural
forall index. index -> Instruction index
BrIf (Natural -> Instruction Natural) -> Natural -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural
deep Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
labelDeep]
brTable :: (Producer selector, OutType selector ~ Proxy I32) => selector -> [Label t] -> Label t -> GenFun ()
brTable :: selector
-> [Label t] -> Label t -> ReaderT Natural (State FuncDef) ()
brTable selector
selector [Label t]
labels (Label Natural
labelDeep) = do
selector -> GenFun (OutType selector)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce selector
selector
Natural
deep <- ReaderT Natural (State FuncDef) Natural
forall r (m :: * -> *). MonadReader r m => m r
ask
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [[Natural] -> Natural -> Instruction Natural
forall index. [index] -> index -> Instruction index
BrTable ((Label t -> Natural) -> [Label t] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map (\(Label Natural
d) -> Natural
deep Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
d) [Label t]
labels) (Natural -> Instruction Natural) -> Natural -> Instruction Natural
forall a b. (a -> b) -> a -> b
$ Natural
deep Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
labelDeep]
finish :: (Producer val) => val -> GenFun ()
finish :: val -> ReaderT Natural (State FuncDef) ()
finish val
val = do
val -> GenFun (OutType val)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce val
val
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
Return]
newtype Label i = Label Natural deriving (Int -> Label i -> ShowS
[Label i] -> ShowS
Label i -> String
(Int -> Label i -> ShowS)
-> (Label i -> String) -> ([Label i] -> ShowS) -> Show (Label i)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (i :: k). Int -> Label i -> ShowS
forall k (i :: k). [Label i] -> ShowS
forall k (i :: k). Label i -> String
showList :: [Label i] -> ShowS
$cshowList :: forall k (i :: k). [Label i] -> ShowS
show :: Label i -> String
$cshow :: forall k (i :: k). Label i -> String
showsPrec :: Int -> Label i -> ShowS
$cshowsPrec :: forall k (i :: k). Int -> Label i -> ShowS
Show, Label i -> Label i -> Bool
(Label i -> Label i -> Bool)
-> (Label i -> Label i -> Bool) -> Eq (Label i)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (i :: k). Label i -> Label i -> Bool
/= :: Label i -> Label i -> Bool
$c/= :: forall k (i :: k). Label i -> Label i -> Bool
== :: Label i -> Label i -> Bool
$c== :: forall k (i :: k). Label i -> Label i -> Bool
Eq)
label :: GenFun (Label t)
label :: GenFun (Label t)
label = Natural -> Label t
forall k (i :: k). Natural -> Label i
Label (Natural -> Label t)
-> ReaderT Natural (State FuncDef) Natural -> GenFun (Label t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Natural (State FuncDef) Natural
forall r (m :: * -> *). MonadReader r m => m r
ask
trap :: Proxy t -> GenFun (Proxy t)
trap :: Proxy t -> GenFun (Proxy t)
trap Proxy t
t = do
Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
Unreachable]
Proxy t -> GenFun (Proxy t)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy t
t
unreachable :: GenFun ()
unreachable :: ReaderT Natural (State FuncDef) ()
unreachable = Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Instruction Natural
forall index. Instruction index
Unreachable]
class Consumer loc where
infixr 2 .=
(.=) :: (Producer expr) => loc -> expr -> GenFun ()
instance Consumer (Loc t) where
.= :: Loc t -> expr -> ReaderT Natural (State FuncDef) ()
(.=) (Loc Natural
i) expr
expr = expr -> GenFun (OutType expr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce expr
expr GenFun (OutType expr)
-> ReaderT Natural (State FuncDef) ()
-> ReaderT Natural (State FuncDef) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Natural -> Instruction Natural
forall index. index -> Instruction index
SetLocal Natural
i]
instance Consumer (Glob t) where
.= :: Glob t -> expr -> ReaderT Natural (State FuncDef) ()
(.=) (Glob Natural
i) expr
expr = expr -> GenFun (OutType expr)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce expr
expr GenFun (OutType expr)
-> ReaderT Natural (State FuncDef) ()
-> ReaderT Natural (State FuncDef) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expression -> ReaderT Natural (State FuncDef) ()
appendExpr [Natural -> Instruction Natural
forall index. index -> Instruction index
SetGlobal Natural
i]
newtype TypeDef t = TypeDef Natural deriving (Int -> TypeDef t -> ShowS
[TypeDef t] -> ShowS
TypeDef t -> String
(Int -> TypeDef t -> ShowS)
-> (TypeDef t -> String)
-> ([TypeDef t] -> ShowS)
-> Show (TypeDef t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> TypeDef t -> ShowS
forall k (t :: k). [TypeDef t] -> ShowS
forall k (t :: k). TypeDef t -> String
showList :: [TypeDef t] -> ShowS
$cshowList :: forall k (t :: k). [TypeDef t] -> ShowS
show :: TypeDef t -> String
$cshow :: forall k (t :: k). TypeDef t -> String
showsPrec :: Int -> TypeDef t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> TypeDef t -> ShowS
Show, TypeDef t -> TypeDef t -> Bool
(TypeDef t -> TypeDef t -> Bool)
-> (TypeDef t -> TypeDef t -> Bool) -> Eq (TypeDef t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). TypeDef t -> TypeDef t -> Bool
/= :: TypeDef t -> TypeDef t -> Bool
$c/= :: forall k (t :: k). TypeDef t -> TypeDef t -> Bool
== :: TypeDef t -> TypeDef t -> Bool
$c== :: forall k (t :: k). TypeDef t -> TypeDef t -> Bool
Eq)
typedef :: (Returnable res) => res -> [ValueType] -> GenMod (TypeDef res)
typedef :: res -> [ValueType] -> GenMod (TypeDef res)
typedef res
res [ValueType]
args = do
let t :: FuncType
t = [ValueType] -> [ValueType] -> FuncType
FuncType [ValueType]
args (res -> [ValueType]
forall a. Returnable a => a -> [ValueType]
asResultValue res
res)
st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = m :: Module
m@Module { [FuncType]
$sel:types:Module :: Module -> [FuncType]
types :: [FuncType]
types } } <- StateT GenModState Identity GenModState
forall s (m :: * -> *). MonadState s m => m s
get
let (Int
idx, [FuncType]
inserted) = (Int, [FuncType]) -> Maybe (Int, [FuncType]) -> (Int, [FuncType])
forall a. a -> Maybe a -> a
Maybe.fromMaybe ([FuncType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FuncType]
types, [FuncType]
types [FuncType] -> [FuncType] -> [FuncType]
forall a. [a] -> [a] -> [a]
++ [FuncType
t]) (Maybe (Int, [FuncType]) -> (Int, [FuncType]))
-> Maybe (Int, [FuncType]) -> (Int, [FuncType])
forall a b. (a -> b) -> a -> b
$ (\Int
i -> (Int
i, [FuncType]
types)) (Int -> (Int, [FuncType])) -> Maybe Int -> Maybe (Int, [FuncType])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FuncType -> Bool) -> [FuncType] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (FuncType -> FuncType -> Bool
forall a. Eq a => a -> a -> Bool
== FuncType
t) [FuncType]
types
GenModState -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (GenModState -> StateT GenModState Identity ())
-> GenModState -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ GenModState
st { $sel:target:GenModState :: Module
target = Module
m { $sel:types:Module :: [FuncType]
types = [FuncType]
inserted } }
TypeDef res -> GenMod (TypeDef res)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeDef res -> GenMod (TypeDef res))
-> TypeDef res -> GenMod (TypeDef res)
forall a b. (a -> b) -> a -> b
$ Natural -> TypeDef res
forall k (t :: k). Natural -> TypeDef t
TypeDef (Natural -> TypeDef res) -> Natural -> TypeDef res
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx
newtype Fn a = Fn Natural deriving (Int -> Fn a -> ShowS
[Fn a] -> ShowS
Fn a -> String
(Int -> Fn a -> ShowS)
-> (Fn a -> String) -> ([Fn a] -> ShowS) -> Show (Fn a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> Fn a -> ShowS
forall k (a :: k). [Fn a] -> ShowS
forall k (a :: k). Fn a -> String
showList :: [Fn a] -> ShowS
$cshowList :: forall k (a :: k). [Fn a] -> ShowS
show :: Fn a -> String
$cshow :: forall k (a :: k). Fn a -> String
showsPrec :: Int -> Fn a -> ShowS
$cshowsPrec :: forall k (a :: k). Int -> Fn a -> ShowS
Show, Fn a -> Fn a -> Bool
(Fn a -> Fn a -> Bool) -> (Fn a -> Fn a -> Bool) -> Eq (Fn a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). Fn a -> Fn a -> Bool
/= :: Fn a -> Fn a -> Bool
$c/= :: forall k (a :: k). Fn a -> Fn a -> Bool
== :: Fn a -> Fn a -> Bool
$c== :: forall k (a :: k). Fn a -> Fn a -> Bool
Eq)
class Returnable a where
asResultValue :: a -> [ValueType]
returnableValue :: a
instance (ValueTypeable t) => Returnable (Proxy t) where
asResultValue :: Proxy t -> [ValueType]
asResultValue Proxy t
t = [Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t]
returnableValue :: Proxy t
returnableValue = Proxy t
forall k (t :: k). Proxy t
Proxy
instance Returnable () where
asResultValue :: () -> [ValueType]
asResultValue ()
_ = []
returnableValue :: ()
returnableValue = ()
funRec :: (Returnable res) => res -> (Fn res -> GenFun res) -> GenMod (Fn res)
funRec :: res -> (Fn res -> GenFun res) -> GenMod (Fn res)
funRec res
res Fn res -> GenFun res
generator = do
st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = m :: Module
m@Module { [FuncType]
types :: [FuncType]
$sel:types:Module :: Module -> [FuncType]
types, [Function]
$sel:functions:Module :: Module -> [Function]
functions :: [Function]
functions }, Natural
$sel:funcIdx:GenModState :: GenModState -> Natural
funcIdx :: Natural
funcIdx } <- StateT GenModState Identity GenModState
forall s (m :: * -> *). MonadState s m => m s
get
let FuncDef { [ValueType]
args :: [ValueType]
$sel:args:FuncDef :: FuncDef -> [ValueType]
args, [ValueType]
locals :: [ValueType]
$sel:locals:FuncDef :: FuncDef -> [ValueType]
locals, Expression
instrs :: Expression
$sel:instrs:FuncDef :: FuncDef -> Expression
instrs } = State FuncDef res -> FuncDef -> FuncDef
forall s a. State s a -> s -> s
execState (GenFun res -> Natural -> State FuncDef res
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Fn res -> GenFun res
generator (Natural -> Fn res
forall k (a :: k). Natural -> Fn a
Fn Natural
funcIdx)) Natural
0) (FuncDef -> FuncDef) -> FuncDef -> FuncDef
forall a b. (a -> b) -> a -> b
$ [ValueType] -> [ValueType] -> [ValueType] -> Expression -> FuncDef
FuncDef [] [] [] []
let t :: FuncType
t = [ValueType] -> [ValueType] -> FuncType
FuncType [ValueType]
args (res -> [ValueType]
forall a. Returnable a => a -> [ValueType]
asResultValue res
res)
let (Int
idx, [FuncType]
inserted) = (Int, [FuncType]) -> Maybe (Int, [FuncType]) -> (Int, [FuncType])
forall a. a -> Maybe a -> a
Maybe.fromMaybe ([FuncType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FuncType]
types, [FuncType]
types [FuncType] -> [FuncType] -> [FuncType]
forall a. [a] -> [a] -> [a]
++ [FuncType
t]) (Maybe (Int, [FuncType]) -> (Int, [FuncType]))
-> Maybe (Int, [FuncType]) -> (Int, [FuncType])
forall a b. (a -> b) -> a -> b
$ (\Int
i -> (Int
i, [FuncType]
types)) (Int -> (Int, [FuncType])) -> Maybe Int -> Maybe (Int, [FuncType])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FuncType -> Bool) -> [FuncType] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (FuncType -> FuncType -> Bool
forall a. Eq a => a -> a -> Bool
== FuncType
t) [FuncType]
types
GenModState -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (GenModState -> StateT GenModState Identity ())
-> GenModState -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:functions:Module :: [Function]
functions = [Function]
functions [Function] -> [Function] -> [Function]
forall a. [a] -> [a] -> [a]
++ [Natural -> [ValueType] -> Expression -> Function
Function (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) [ValueType]
locals Expression
instrs], $sel:types:Module :: [FuncType]
types = [FuncType]
inserted },
$sel:funcIdx:GenModState :: Natural
funcIdx = Natural
funcIdx Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
}
Fn res -> GenMod (Fn res)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fn res -> GenMod (Fn res)) -> Fn res -> GenMod (Fn res)
forall a b. (a -> b) -> a -> b
$ Natural -> Fn res
forall k (a :: k). Natural -> Fn a
Fn Natural
funcIdx
fun :: (Returnable res) => res -> GenFun res -> GenMod (Fn res)
fun :: res -> GenFun res -> GenMod (Fn res)
fun res
res = res -> (Fn res -> GenFun res) -> GenMod (Fn res)
forall res.
Returnable res =>
res -> (Fn res -> GenFun res) -> GenMod (Fn res)
funRec res
res ((Fn res -> GenFun res) -> GenMod (Fn res))
-> (GenFun res -> Fn res -> GenFun res)
-> GenFun res
-> GenMod (Fn res)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenFun res -> Fn res -> GenFun res
forall a b. a -> b -> a
const
declare :: (Returnable res) => res -> [ValueType] -> GenMod (Fn res)
declare :: res -> [ValueType] -> GenMod (Fn res)
declare res
res [ValueType]
args = do
st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = m :: Module
m@Module { [FuncType]
types :: [FuncType]
$sel:types:Module :: Module -> [FuncType]
types, [Function]
functions :: [Function]
$sel:functions:Module :: Module -> [Function]
functions }, Natural
funcIdx :: Natural
$sel:funcIdx:GenModState :: GenModState -> Natural
funcIdx } <- StateT GenModState Identity GenModState
forall s (m :: * -> *). MonadState s m => m s
get
let t :: FuncType
t = [ValueType] -> [ValueType] -> FuncType
FuncType [ValueType]
args (res -> [ValueType]
forall a. Returnable a => a -> [ValueType]
asResultValue res
res)
let (Int
idx, [FuncType]
inserted) = (Int, [FuncType]) -> Maybe (Int, [FuncType]) -> (Int, [FuncType])
forall a. a -> Maybe a -> a
Maybe.fromMaybe ([FuncType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FuncType]
types, [FuncType]
types [FuncType] -> [FuncType] -> [FuncType]
forall a. [a] -> [a] -> [a]
++ [FuncType
t]) (Maybe (Int, [FuncType]) -> (Int, [FuncType]))
-> Maybe (Int, [FuncType]) -> (Int, [FuncType])
forall a b. (a -> b) -> a -> b
$ (\Int
i -> (Int
i, [FuncType]
types)) (Int -> (Int, [FuncType])) -> Maybe Int -> Maybe (Int, [FuncType])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FuncType -> Bool) -> [FuncType] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (FuncType -> FuncType -> Bool
forall a. Eq a => a -> a -> Bool
== FuncType
t) [FuncType]
types
let err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"Declared function doesn't have implementation"
GenModState -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (GenModState -> StateT GenModState Identity ())
-> GenModState -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:functions:Module :: [Function]
functions = [Function]
functions [Function] -> [Function] -> [Function]
forall a. [a] -> [a] -> [a]
++ [Natural -> [ValueType] -> Expression -> Function
Function (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) [ValueType]
forall a. a
err Expression
forall a. a
err], $sel:types:Module :: [FuncType]
types = [FuncType]
inserted },
$sel:funcIdx:GenModState :: Natural
funcIdx = Natural
funcIdx Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
}
Fn res -> GenMod (Fn res)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fn res -> GenMod (Fn res)) -> Fn res -> GenMod (Fn res)
forall a b. (a -> b) -> a -> b
$ Natural -> Fn res
forall k (a :: k). Natural -> Fn a
Fn Natural
funcIdx
implement :: (Returnable res) => Fn res -> GenFun res -> GenMod (Fn res)
implement :: Fn res -> GenFun res -> GenMod (Fn res)
implement (Fn Natural
funcIdx) GenFun res
generator = do
st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = m :: Module
m@Module { [FuncType]
types :: [FuncType]
$sel:types:Module :: Module -> [FuncType]
types, [Function]
functions :: [Function]
$sel:functions:Module :: Module -> [Function]
functions, [Import]
$sel:imports:Module :: Module -> [Import]
imports :: [Import]
imports } } <- StateT GenModState Identity GenModState
forall s (m :: * -> *). MonadState s m => m s
get
let FuncDef { [ValueType]
args :: [ValueType]
$sel:args:FuncDef :: FuncDef -> [ValueType]
args, [ValueType]
locals :: [ValueType]
$sel:locals:FuncDef :: FuncDef -> [ValueType]
locals, Expression
instrs :: Expression
$sel:instrs:FuncDef :: FuncDef -> Expression
instrs } = State FuncDef res -> FuncDef -> FuncDef
forall s a. State s a -> s -> s
execState (GenFun res -> Natural -> State FuncDef res
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT GenFun res
generator Natural
0) (FuncDef -> FuncDef) -> FuncDef -> FuncDef
forall a b. (a -> b) -> a -> b
$ [ValueType] -> [ValueType] -> [ValueType] -> Expression -> FuncDef
FuncDef [] [] [] []
let locIdx :: Int
locIdx = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
funcIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
- ([Import] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Import] -> Int) -> [Import] -> Int
forall a b. (a -> b) -> a -> b
$ (Import -> Bool) -> [Import] -> [Import]
forall a. (a -> Bool) -> [a] -> [a]
filter Import -> Bool
isFuncImport [Import]
imports)
let ([Function]
l, Function
inst : [Function]
r) = Int -> [Function] -> ([Function], [Function])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
locIdx [Function]
functions
let typeIdx :: Natural
typeIdx = Function -> Natural
funcType Function
inst
let FuncType [ValueType]
ps [ValueType]
_ = [FuncType]
types [FuncType] -> Int -> FuncType
forall a. [a] -> Int -> a
!! Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
typeIdx
if [ValueType]
args [ValueType] -> [ValueType] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ValueType]
ps then String -> StateT GenModState Identity ()
forall a. HasCallStack => String -> a
error String
"Arguments list in implementation doesn't match with declared type" else () -> StateT GenModState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GenModState -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (GenModState -> StateT GenModState Identity ())
-> GenModState -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ GenModState
st { $sel:target:GenModState :: Module
target = Module
m { $sel:functions:Module :: [Function]
functions = [Function]
l [Function] -> [Function] -> [Function]
forall a. [a] -> [a] -> [a]
++ [Natural -> [ValueType] -> Expression -> Function
Function Natural
typeIdx [ValueType]
locals Expression
instrs] [Function] -> [Function] -> [Function]
forall a. [a] -> [a] -> [a]
++ [Function]
r } }
Fn res -> GenMod (Fn res)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fn res -> GenMod (Fn res)) -> Fn res -> GenMod (Fn res)
forall a b. (a -> b) -> a -> b
$ Natural -> Fn res
forall k (a :: k). Natural -> Fn a
Fn Natural
funcIdx
nextFuncIndex :: GenMod Natural
nextFuncIndex :: GenMod Natural
nextFuncIndex = (GenModState -> Natural) -> GenMod Natural
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GenModState -> Natural
funcIdx
data GenModState = GenModState {
GenModState -> Natural
funcIdx :: Natural,
GenModState -> Natural
globIdx :: Natural,
GenModState -> Module
target :: Module
} deriving (Int -> GenModState -> ShowS
[GenModState] -> ShowS
GenModState -> String
(Int -> GenModState -> ShowS)
-> (GenModState -> String)
-> ([GenModState] -> ShowS)
-> Show GenModState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenModState] -> ShowS
$cshowList :: [GenModState] -> ShowS
show :: GenModState -> String
$cshow :: GenModState -> String
showsPrec :: Int -> GenModState -> ShowS
$cshowsPrec :: Int -> GenModState -> ShowS
Show, GenModState -> GenModState -> Bool
(GenModState -> GenModState -> Bool)
-> (GenModState -> GenModState -> Bool) -> Eq GenModState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenModState -> GenModState -> Bool
$c/= :: GenModState -> GenModState -> Bool
== :: GenModState -> GenModState -> Bool
$c== :: GenModState -> GenModState -> Bool
Eq)
type GenMod = State GenModState
genMod :: GenMod a -> Module
genMod :: GenMod a -> Module
genMod = GenModState -> Module
target (GenModState -> Module)
-> (GenMod a -> GenModState) -> GenMod a -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenMod a -> GenModState -> GenModState)
-> GenModState -> GenMod a -> GenModState
forall a b c. (a -> b -> c) -> b -> a -> c
flip GenMod a -> GenModState -> GenModState
forall s a. State s a -> s -> s
execState (Natural -> Natural -> Module -> GenModState
GenModState Natural
0 Natural
0 Module
emptyModule)
importFunction :: (Returnable res) => TL.Text -> TL.Text -> res -> [ValueType] -> GenMod (Fn res)
importFunction :: Text -> Text -> res -> [ValueType] -> GenMod (Fn res)
importFunction Text
mod Text
name res
res [ValueType]
params = do
st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = m :: Module
m@Module { [FuncType]
types :: [FuncType]
$sel:types:Module :: Module -> [FuncType]
types, [Import]
imports :: [Import]
$sel:imports:Module :: Module -> [Import]
imports }, Natural
funcIdx :: Natural
$sel:funcIdx:GenModState :: GenModState -> Natural
funcIdx } <- StateT GenModState Identity GenModState
forall s (m :: * -> *). MonadState s m => m s
get
let t :: FuncType
t = [ValueType] -> [ValueType] -> FuncType
FuncType [ValueType]
params (res -> [ValueType]
forall a. Returnable a => a -> [ValueType]
asResultValue res
res)
let (Int
idx, [FuncType]
inserted) = (Int, [FuncType]) -> Maybe (Int, [FuncType]) -> (Int, [FuncType])
forall a. a -> Maybe a -> a
Maybe.fromMaybe ([FuncType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FuncType]
types, [FuncType]
types [FuncType] -> [FuncType] -> [FuncType]
forall a. [a] -> [a] -> [a]
++ [FuncType
t]) (Maybe (Int, [FuncType]) -> (Int, [FuncType]))
-> Maybe (Int, [FuncType]) -> (Int, [FuncType])
forall a b. (a -> b) -> a -> b
$ (\Int
i -> (Int
i, [FuncType]
types)) (Int -> (Int, [FuncType])) -> Maybe Int -> Maybe (Int, [FuncType])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FuncType -> Bool) -> [FuncType] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (FuncType -> FuncType -> Bool
forall a. Eq a => a -> a -> Bool
== FuncType
t) [FuncType]
types
GenModState -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (GenModState -> StateT GenModState Identity ())
-> GenModState -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:imports:Module :: [Import]
imports = [Import]
imports [Import] -> [Import] -> [Import]
forall a. [a] -> [a] -> [a]
++ [Text -> Text -> ImportDesc -> Import
Import Text
mod Text
name (ImportDesc -> Import) -> ImportDesc -> Import
forall a b. (a -> b) -> a -> b
$ Natural -> ImportDesc
ImportFunc (Natural -> ImportDesc) -> Natural -> ImportDesc
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx], $sel:types:Module :: [FuncType]
types = [FuncType]
inserted },
$sel:funcIdx:GenModState :: Natural
funcIdx = Natural
funcIdx Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
}
Fn res -> GenMod (Fn res)
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Fn res
forall k (a :: k). Natural -> Fn a
Fn Natural
funcIdx)
importGlobal :: (ValueTypeable t) => TL.Text -> TL.Text -> Proxy t -> GenMod (Glob t)
importGlobal :: Text -> Text -> Proxy t -> GenMod (Glob t)
importGlobal Text
mod Text
name Proxy t
t = do
st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = m :: Module
m@Module { [Import]
imports :: [Import]
$sel:imports:Module :: Module -> [Import]
imports }, Natural
globIdx :: Natural
$sel:globIdx:GenModState :: GenModState -> Natural
globIdx } <- StateT GenModState Identity GenModState
forall s (m :: * -> *). MonadState s m => m s
get
GenModState -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (GenModState -> StateT GenModState Identity ())
-> GenModState -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:imports:Module :: [Import]
imports = [Import]
imports [Import] -> [Import] -> [Import]
forall a. [a] -> [a] -> [a]
++ [Text -> Text -> ImportDesc -> Import
Import Text
mod Text
name (ImportDesc -> Import) -> ImportDesc -> Import
forall a b. (a -> b) -> a -> b
$ GlobalType -> ImportDesc
ImportGlobal (GlobalType -> ImportDesc) -> GlobalType -> ImportDesc
forall a b. (a -> b) -> a -> b
$ ValueType -> GlobalType
Const (ValueType -> GlobalType) -> ValueType -> GlobalType
forall a b. (a -> b) -> a -> b
$ Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t] },
$sel:globIdx:GenModState :: Natural
globIdx = Natural
globIdx Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
}
Glob t -> GenMod (Glob t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Glob t -> GenMod (Glob t)) -> Glob t -> GenMod (Glob t)
forall a b. (a -> b) -> a -> b
$ Natural -> Glob t
forall k (t :: k). Natural -> Glob t
Glob Natural
globIdx
importMemory :: TL.Text -> TL.Text -> Natural -> Maybe Natural -> GenMod Mem
importMemory :: Text -> Text -> Natural -> Maybe Natural -> GenMod Mem
importMemory Text
mod Text
name Natural
min Maybe Natural
max = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:imports:Module :: [Import]
imports = Module -> [Import]
imports Module
m [Import] -> [Import] -> [Import]
forall a. [a] -> [a] -> [a]
++ [Text -> Text -> ImportDesc -> Import
Import Text
mod Text
name (ImportDesc -> Import) -> ImportDesc -> Import
forall a b. (a -> b) -> a -> b
$ Limit -> ImportDesc
ImportMemory (Limit -> ImportDesc) -> Limit -> ImportDesc
forall a b. (a -> b) -> a -> b
$ Natural -> Maybe Natural -> Limit
Limit Natural
min Maybe Natural
max] }
}
Mem -> GenMod Mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Mem -> GenMod Mem) -> Mem -> GenMod Mem
forall a b. (a -> b) -> a -> b
$ Natural -> Mem
Mem Natural
0
importTable :: TL.Text -> TL.Text -> Natural -> Maybe Natural -> GenMod Tbl
importTable :: Text -> Text -> Natural -> Maybe Natural -> GenMod Tbl
importTable Text
mod Text
name Natural
min Maybe Natural
max = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:imports:Module :: [Import]
imports = Module -> [Import]
imports Module
m [Import] -> [Import] -> [Import]
forall a. [a] -> [a] -> [a]
++ [Text -> Text -> ImportDesc -> Import
Import Text
mod Text
name (ImportDesc -> Import) -> ImportDesc -> Import
forall a b. (a -> b) -> a -> b
$ TableType -> ImportDesc
ImportTable (TableType -> ImportDesc) -> TableType -> ImportDesc
forall a b. (a -> b) -> a -> b
$ Limit -> ElemType -> TableType
TableType (Natural -> Maybe Natural -> Limit
Limit Natural
min Maybe Natural
max) ElemType
FuncRef] }
}
Tbl -> GenMod Tbl
forall (m :: * -> *) a. Monad m => a -> m a
return (Tbl -> GenMod Tbl) -> Tbl -> GenMod Tbl
forall a b. (a -> b) -> a -> b
$ Natural -> Tbl
Tbl Natural
0
class Exportable e where
type AfterExport e
export :: TL.Text -> e -> GenMod (AfterExport e)
instance (Exportable e) => Exportable (GenMod e) where
type AfterExport (GenMod e) = AfterExport e
export :: Text -> GenMod e -> GenMod (AfterExport (GenMod e))
export Text
name GenMod e
def = do
e
ent <- GenMod e
def
Text -> e -> GenMod (AfterExport e)
forall e. Exportable e => Text -> e -> GenMod (AfterExport e)
export Text
name e
ent
instance Exportable (Fn t) where
type AfterExport (Fn t) = Fn t
export :: Text -> Fn t -> GenMod (AfterExport (Fn t))
export Text
name (Fn Natural
funIdx) = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:exports:Module :: [Export]
exports = Module -> [Export]
exports Module
m [Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [Text -> ExportDesc -> Export
Export Text
name (ExportDesc -> Export) -> ExportDesc -> Export
forall a b. (a -> b) -> a -> b
$ Natural -> ExportDesc
ExportFunc Natural
funIdx] }
}
Fn t -> StateT GenModState Identity (Fn t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Fn t
forall k (a :: k). Natural -> Fn a
Fn Natural
funIdx)
instance Exportable (Glob t) where
type AfterExport (Glob t) = Glob t
export :: Text -> Glob t -> GenMod (AfterExport (Glob t))
export Text
name g :: Glob t
g@(Glob Natural
idx) = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:exports:Module :: [Export]
exports = Module -> [Export]
exports Module
m [Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [Text -> ExportDesc -> Export
Export Text
name (ExportDesc -> Export) -> ExportDesc -> Export
forall a b. (a -> b) -> a -> b
$ Natural -> ExportDesc
ExportGlobal Natural
idx] }
}
Glob t -> StateT GenModState Identity (Glob t)
forall (m :: * -> *) a. Monad m => a -> m a
return Glob t
g
instance Exportable Mem where
type AfterExport Mem = Mem
export :: Text -> Mem -> GenMod (AfterExport Mem)
export Text
name (Mem Natural
memIdx) = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:exports:Module :: [Export]
exports = Module -> [Export]
exports Module
m [Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [Text -> ExportDesc -> Export
Export Text
name (ExportDesc -> Export) -> ExportDesc -> Export
forall a b. (a -> b) -> a -> b
$ Natural -> ExportDesc
ExportMemory Natural
memIdx] }
}
Mem -> GenMod Mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Mem
Mem Natural
memIdx)
instance Exportable Tbl where
type AfterExport Tbl = Tbl
export :: Text -> Tbl -> GenMod (AfterExport Tbl)
export Text
name (Tbl Natural
tableIdx) = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:exports:Module :: [Export]
exports = Module -> [Export]
exports Module
m [Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [Text -> ExportDesc -> Export
Export Text
name (ExportDesc -> Export) -> ExportDesc -> Export
forall a b. (a -> b) -> a -> b
$ Natural -> ExportDesc
ExportTable Natural
tableIdx] }
}
Tbl -> GenMod Tbl
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Tbl
Tbl Natural
tableIdx)
class ValueTypeable a where
type ValType a
getValueType :: (Proxy a) -> ValueType
initWith :: (Proxy a) -> (ValType a) -> Expression
instance ValueTypeable I32 where
type ValType I32 = Word32
getValueType :: Proxy 'I32 -> ValueType
getValueType Proxy 'I32
_ = ValueType
I32
initWith :: Proxy 'I32 -> ValType 'I32 -> Expression
initWith Proxy 'I32
_ ValType 'I32
w = [Word32 -> Instruction Natural
forall index. Word32 -> Instruction index
I32Const Word32
ValType 'I32
w]
instance ValueTypeable I64 where
type ValType I64 = Word64
getValueType :: Proxy 'I64 -> ValueType
getValueType Proxy 'I64
_ = ValueType
I64
initWith :: Proxy 'I64 -> ValType 'I64 -> Expression
initWith Proxy 'I64
_ ValType 'I64
w = [Word64 -> Instruction Natural
forall index. Word64 -> Instruction index
I64Const Word64
ValType 'I64
w]
instance ValueTypeable F32 where
type ValType F32 = Float
getValueType :: Proxy 'F32 -> ValueType
getValueType Proxy 'F32
_ = ValueType
F32
initWith :: Proxy 'F32 -> ValType 'F32 -> Expression
initWith Proxy 'F32
_ ValType 'F32
f = [Float -> Instruction Natural
forall index. Float -> Instruction index
F32Const Float
ValType 'F32
f]
instance ValueTypeable F64 where
type ValType F64 = Double
getValueType :: Proxy 'F64 -> ValueType
getValueType Proxy 'F64
_ = ValueType
F64
initWith :: Proxy 'F64 -> ValType 'F64 -> Expression
initWith Proxy 'F64
_ ValType 'F64
d = [Double -> Instruction Natural
forall index. Double -> Instruction index
F64Const Double
ValType 'F64
d]
i32 :: Proxy 'I32
i32 = Proxy 'I32
forall k (t :: k). Proxy t
Proxy @I32
i64 :: Proxy 'I64
i64 = Proxy 'I64
forall k (t :: k). Proxy t
Proxy @I64
f32 :: Proxy 'F32
f32 = Proxy 'F32
forall k (t :: k). Proxy t
Proxy @F32
f64 :: Proxy 'F64
f64 = Proxy 'F64
forall k (t :: k). Proxy t
Proxy @F64
newtype Glob t = Glob Natural deriving (Int -> Glob t -> ShowS
[Glob t] -> ShowS
Glob t -> String
(Int -> Glob t -> ShowS)
-> (Glob t -> String) -> ([Glob t] -> ShowS) -> Show (Glob t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> Glob t -> ShowS
forall k (t :: k). [Glob t] -> ShowS
forall k (t :: k). Glob t -> String
showList :: [Glob t] -> ShowS
$cshowList :: forall k (t :: k). [Glob t] -> ShowS
show :: Glob t -> String
$cshow :: forall k (t :: k). Glob t -> String
showsPrec :: Int -> Glob t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> Glob t -> ShowS
Show, Glob t -> Glob t -> Bool
(Glob t -> Glob t -> Bool)
-> (Glob t -> Glob t -> Bool) -> Eq (Glob t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). Glob t -> Glob t -> Bool
/= :: Glob t -> Glob t -> Bool
$c/= :: forall k (t :: k). Glob t -> Glob t -> Bool
== :: Glob t -> Glob t -> Bool
$c== :: forall k (t :: k). Glob t -> Glob t -> Bool
Eq)
global :: (ValueTypeable t) => (ValueType -> GlobalType) -> Proxy t -> (ValType t) -> GenMod (Glob t)
global :: (ValueType -> GlobalType)
-> Proxy t -> ValType t -> GenMod (Glob t)
global ValueType -> GlobalType
mkType Proxy t
t ValType t
val = do
Natural
idx <- (GenModState -> Natural) -> GenMod Natural
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GenModState -> Natural
globIdx
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:globals:Module :: [Global]
globals = Module -> [Global]
globals Module
m [Global] -> [Global] -> [Global]
forall a. [a] -> [a] -> [a]
++ [GlobalType -> Expression -> Global
Global (ValueType -> GlobalType
mkType (ValueType -> GlobalType) -> ValueType -> GlobalType
forall a b. (a -> b) -> a -> b
$ Proxy t -> ValueType
forall k (a :: k). ValueTypeable a => Proxy a -> ValueType
getValueType Proxy t
t) (Proxy t -> ValType t -> Expression
forall k (a :: k).
ValueTypeable a =>
Proxy a -> ValType a -> Expression
initWith Proxy t
t ValType t
val)] },
$sel:globIdx:GenModState :: Natural
globIdx = Natural
idx Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
}
Glob t -> GenMod (Glob t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Glob t -> GenMod (Glob t)) -> Glob t -> GenMod (Glob t)
forall a b. (a -> b) -> a -> b
$ Natural -> Glob t
forall k (t :: k). Natural -> Glob t
Glob Natural
idx
setGlobalInitializer :: forall t . (ValueTypeable t) => Glob t -> (ValType t) -> GenMod ()
setGlobalInitializer :: Glob t -> ValType t -> StateT GenModState Identity ()
setGlobalInitializer (Glob Natural
idx) ValType t
val = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) ->
let globImpsLen :: Int
globImpsLen = [Import] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Import] -> Int) -> [Import] -> Int
forall a b. (a -> b) -> a -> b
$ (Import -> Bool) -> [Import] -> [Import]
forall a. (a -> Bool) -> [a] -> [a]
filter Import -> Bool
isGlobalImport ([Import] -> [Import]) -> [Import] -> [Import]
forall a b. (a -> b) -> a -> b
$ Module -> [Import]
imports Module
m in
let ([Global]
h, Global
glob:[Global]
t) = Int -> [Global] -> ([Global], [Global])
forall a. Int -> [a] -> ([a], [a])
splitAt (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
globImpsLen) ([Global] -> ([Global], [Global]))
-> [Global] -> ([Global], [Global])
forall a b. (a -> b) -> a -> b
$ Module -> [Global]
globals Module
m in
GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:globals:Module :: [Global]
globals = [Global]
h [Global] -> [Global] -> [Global]
forall a. [a] -> [a] -> [a]
++ [Global
glob { $sel:initializer:Global :: Expression
initializer = Proxy t -> ValType t -> Expression
forall k (a :: k).
ValueTypeable a =>
Proxy a -> ValType a -> Expression
initWith (Proxy t
forall k (t :: k). Proxy t
Proxy @t) ValType t
val }] [Global] -> [Global] -> [Global]
forall a. [a] -> [a] -> [a]
++ [Global]
t }
}
newtype Mem = Mem Natural deriving (Int -> Mem -> ShowS
[Mem] -> ShowS
Mem -> String
(Int -> Mem -> ShowS)
-> (Mem -> String) -> ([Mem] -> ShowS) -> Show Mem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mem] -> ShowS
$cshowList :: [Mem] -> ShowS
show :: Mem -> String
$cshow :: Mem -> String
showsPrec :: Int -> Mem -> ShowS
$cshowsPrec :: Int -> Mem -> ShowS
Show, Mem -> Mem -> Bool
(Mem -> Mem -> Bool) -> (Mem -> Mem -> Bool) -> Eq Mem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mem -> Mem -> Bool
$c/= :: Mem -> Mem -> Bool
== :: Mem -> Mem -> Bool
$c== :: Mem -> Mem -> Bool
Eq)
memory :: Natural -> Maybe Natural -> GenMod Mem
memory :: Natural -> Maybe Natural -> GenMod Mem
memory Natural
min Maybe Natural
max = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:mems:Module :: [Memory]
mems = Module -> [Memory]
mems Module
m [Memory] -> [Memory] -> [Memory]
forall a. [a] -> [a] -> [a]
++ [Limit -> Memory
Memory (Limit -> Memory) -> Limit -> Memory
forall a b. (a -> b) -> a -> b
$ Natural -> Maybe Natural -> Limit
Limit Natural
min Maybe Natural
max] }
}
Mem -> GenMod Mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Mem -> GenMod Mem) -> Mem -> GenMod Mem
forall a b. (a -> b) -> a -> b
$ Natural -> Mem
Mem Natural
0
newtype Tbl = Tbl Natural deriving (Int -> Tbl -> ShowS
[Tbl] -> ShowS
Tbl -> String
(Int -> Tbl -> ShowS)
-> (Tbl -> String) -> ([Tbl] -> ShowS) -> Show Tbl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tbl] -> ShowS
$cshowList :: [Tbl] -> ShowS
show :: Tbl -> String
$cshow :: Tbl -> String
showsPrec :: Int -> Tbl -> ShowS
$cshowsPrec :: Int -> Tbl -> ShowS
Show, Tbl -> Tbl -> Bool
(Tbl -> Tbl -> Bool) -> (Tbl -> Tbl -> Bool) -> Eq Tbl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tbl -> Tbl -> Bool
$c/= :: Tbl -> Tbl -> Bool
== :: Tbl -> Tbl -> Bool
$c== :: Tbl -> Tbl -> Bool
Eq)
table :: Natural -> Maybe Natural -> GenMod Tbl
table :: Natural -> Maybe Natural -> GenMod Tbl
table Natural
min Maybe Natural
max = do
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:tables:Module :: [Table]
tables = Module -> [Table]
tables Module
m [Table] -> [Table] -> [Table]
forall a. [a] -> [a] -> [a]
++ [TableType -> Table
Table (TableType -> Table) -> TableType -> Table
forall a b. (a -> b) -> a -> b
$ Limit -> ElemType -> TableType
TableType (Natural -> Maybe Natural -> Limit
Limit Natural
min Maybe Natural
max) ElemType
FuncRef] }
}
Tbl -> GenMod Tbl
forall (m :: * -> *) a. Monad m => a -> m a
return (Tbl -> GenMod Tbl) -> Tbl -> GenMod Tbl
forall a b. (a -> b) -> a -> b
$ Natural -> Tbl
Tbl Natural
0
dataSegment :: (Producer offset, OutType offset ~ Proxy I32) => offset -> LBS.ByteString -> GenMod ()
dataSegment :: offset -> ByteString -> StateT GenModState Identity ()
dataSegment offset
offset ByteString
bytes =
(GenModState -> GenModState) -> StateT GenModState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenModState -> GenModState) -> StateT GenModState Identity ())
-> (GenModState -> GenModState) -> StateT GenModState Identity ()
forall a b. (a -> b) -> a -> b
$ \(st :: GenModState
st@GenModState { $sel:target:GenModState :: GenModState -> Module
target = Module
m }) -> GenModState
st {
$sel:target:GenModState :: Module
target = Module
m { $sel:datas:Module :: [DataSegment]
datas = Module -> [DataSegment]
datas Module
m [DataSegment] -> [DataSegment] -> [DataSegment]
forall a. [a] -> [a] -> [a]
++ [Natural -> Expression -> ByteString -> DataSegment
DataSegment Natural
0 (Natural -> GenFun (Proxy 'I32) -> Expression
forall a. Natural -> GenFun a -> Expression
genExpr Natural
0 (offset -> GenFun (OutType offset)
forall expr. Producer expr => expr -> GenFun (OutType expr)
produce offset
offset)) ByteString
bytes] }
}
asWord32 :: Int32 -> Word32
asWord32 :: Int32 -> Word32
asWord32 Int32
i
| Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0 = Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i
| Bool
otherwise = Word32
0xFFFFFFFF Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
i)) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
asWord64 :: Int64 -> Word64
asWord64 :: Int64 -> Word64
asWord64 Int64
i
| Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
| Bool
otherwise = Word64
0xFFFFFFFFFFFFFFFF Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
i)) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1