{-# 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,
    {-if', loop, block, when, for, while,-}
    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)
{-
when :: (Producer pred, OutType pred ~ Proxy I32)
    => pred
    -> GenFun ()
    -> GenFun ()
when pred body = if' () pred body (return ())

for :: (Producer pred, OutType pred ~ Proxy I32) => GenFun () -> pred -> GenFun () -> GenFun () -> GenFun ()
for initer pred after body = do
    initer
    let loopBody = do
            body
            after
            loopLabel <- label
            if' () pred (br loopLabel) (return ())
    if' () pred (loop () loopBody) (return ())

while :: (Producer pred, OutType pred ~ Proxy I32) => pred -> GenFun () -> GenFun ()
while pred body = do
    let loopBody = do
            body
            loopLabel <- label
            if' () pred (br loopLabel) (return ())
    if' () pred (loop () loopBody) (return ())-}

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

-- if' :: (Producer pred, OutType pred ~ Proxy I32, Returnable res)
--     => res
--     -> pred
--     -> GenFun res
--     -> GenFun res
--     -> GenFun res
-- if' res pred true false = do
--     produce pred
--     deep <- (+1) <$> ask
--     appendExpr [If (asResultValue res) (genExpr deep $ true) (genExpr deep $ false)]
--     return returnableValue

-- loop :: (Returnable res) => res -> GenFun res -> GenFun res
-- loop res body = do
--     deep <- (+1) <$> ask
--     appendExpr [Loop (asResultValue res) (genExpr deep $ body)]
--     return returnableValue

-- block :: (Returnable res) => res -> GenFun res -> GenFun res
-- block res body = do
--     deep <- (+1) <$> ask
--     appendExpr [Block (asResultValue res) (genExpr deep $ body)]
--     return returnableValue

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

-- rts :: Module
-- rts = genMod $ do
--     gc <- importFunction "rts" "gc" () [I32]
--     memory 10 Nothing

--     stackStart <- global Const i32 0
--     stackEnd <- global Const i32 0
--     stackBase <- global Mut i32 0
--     stackTop <- global Mut i32 0

--     retReg <- global Mut i32 0
--     tmpReg <- global Mut i32 0

--     heapStart <- global Mut i32 0
--     heapNext <- global Mut i32 0
--     heapEnd <- global Mut i32 0

--     aligned <- fun i32 $ do
--         size <- param i32
--         (size `add` i32c 3) `and` i32c 0xFFFFFFFC
--     alloc <- funRec i32 $ \self -> do
--         size <- param i32
--         alignedSize <- local i32
--         addr <- local i32
--         alignedSize .= call aligned [arg size]
--         if' i32 ((heapNext `add` alignedSize) `lt_u` heapEnd)
--             (do
--                 addr .= heapNext
--                 heapNext .= heapNext `add` alignedSize
--                 ret addr
--             )
--             (do
--                 call gc []
--                 call self [arg size]
--             )
--     return ()