add fundeps to infer monad instance from producer

src/Language/Wasm/Builder.hs

@@ -12,7 +12,12 @@
 {-# LANGUAGE TypeInType #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FunctionalDependencies #-}
 
 module Language.Wasm.Builder (
     GenMod,
@@ -28,7 +33,7 @@ module Language.Wasm.Builder (
     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,
+    add, {-inc,-} sub, {-dec,-} mul, div_u, div_s, rem_u, rem_s, and, or, xor, shl, shr_u, shr_s, rotl, rotr,
     eq, ne, lt_s, lt_u, gt_s, gt_u, le_s, le_u, ge_s, ge_u,
     eqz,
     extend_s, extend_u, wrap,
@@ -46,7 +51,7 @@ 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 Control.Monad.Reader (ReaderT, ask, runReaderT, withReaderT)
 import Numeric.Natural
 import Data.Word (Word32, Word64)
 import Data.Int (Int32, Int64)
@@ -64,100 +69,99 @@ data FuncDef = FuncDef {
     instrs :: Expression
 } deriving (Show, Eq)
 
-type GenFun = ReaderT Natural (State FuncDef)
+newtype GenFun a = GenFun { unGenFun :: ReaderT Natural (State FuncDef) a } deriving (Functor, Applicative, Monad)
 
-genExpr :: Natural -> GenFun a -> Expression
+newtype Loc m (t :: ValueType) = Loc Natural deriving (Show, Eq)
-genExpr deep gen = instrs $ flip execState (FuncDef [] [] [] []) $ runReaderT gen deep
 
-newtype Loc t = Loc Natural deriving (Show, Eq)
+class (Monad m) => GenFunMonad m where
+    appendExpr :: Expression -> m ()
+    inner :: m a -> m Expression
+    param :: (ValueTypeable t) => Proxy t -> m (Loc m t)
+    local :: (ValueTypeable t) => Proxy t -> m (Loc m t)
+    deep :: m Natural
 
-param :: (ValueTypeable t) => Proxy t -> GenFun (Loc t)
+instance GenFunMonad GenFun where
-param t = do
+    appendExpr expr = do
+        GenFun $ modify $ \def -> def { instrs = instrs def ++ expr }
+        return ()
+
+    inner (GenFun subExpr) = GenFun $ do
+        stateBefore <- get
+        res <- withReaderT (+1) $ do
+            subExpr
+            gets instrs
+        put stateBefore
+        return res
+
+    param t = GenFun $ do
         f@FuncDef { args } <- get
         put $ f { args = args ++ [getValueType t] }
         return $ Loc $ fromIntegral $ length args
 
-local :: (ValueTypeable t) => Proxy t -> GenFun (Loc t)
+    local t = GenFun $ do
-local t = do
         f@FuncDef { args, locals } <- get
         put $ f { locals = locals ++ [getValueType t]}
         return $ Loc $ fromIntegral $ length args + length locals
     
-appendExpr :: Expression -> GenFun ()
+    deep = GenFun ask
-appendExpr expr = do
-    modify $ \def -> def { instrs = instrs def ++ expr }
-    return ()
 
-after :: Expression -> GenFun a -> GenFun a
+after :: (GenFunMonad m) => Expression -> m a -> m a
 after instr expr = do
     res <- expr
-    modify $ \def -> def { instrs = instrs def ++ instr }
+    appendExpr instr
     return res
 
-data TypedExpr
+data TypedExpr m
-    = ExprI32 (GenFun (Proxy I32))
+    = ExprI32 (m (Proxy I32))
-    | ExprI64 (GenFun (Proxy I64))
+    | ExprI64 (m (Proxy I64))
-    | ExprF32 (GenFun (Proxy F32))
+    | ExprF32 (m (Proxy F32))
-    | ExprF64 (GenFun (Proxy F64))
+    | ExprF64 (m (Proxy F64))
 
-class Producer expr where
+class (GenFunMonad m) => Producer m expr | expr -> m where
     type OutType expr
-    asTypedExpr :: expr -> TypedExpr
+    asTypedExpr :: expr -> TypedExpr m
-    asValueType :: expr -> ValueType
+    produce :: expr -> m (OutType expr)
-    produce :: expr -> GenFun (OutType expr)
 
-instance (ValueTypeable t) => Producer (Loc t) where
+instance (GenFunMonad m, ValueTypeable t) => Producer m (Loc m t) where
-    type OutType (Loc t) = Proxy t
+    type OutType (Loc m t) = Proxy t
     asTypedExpr e = case getValueType (t e) of
         I32 -> ExprI32 (produce e >> return Proxy)
         I64 -> ExprI64 (produce e >> return Proxy)
         F32 -> ExprF32 (produce e >> return Proxy)
         F64 -> ExprF64 (produce e >> return Proxy)
         where
-            t :: Loc t -> Proxy t
+            t :: Loc m t -> Proxy t
-            t _ = Proxy
-    asValueType e = getValueType (t e)
-        where
-            t :: Loc t -> Proxy t
             t _ = Proxy
     produce (Loc i) = appendExpr [GetLocal i] >> return Proxy
 
-instance (ValueTypeable t) => Producer (Glob t) where
+instance (GenFunMonad m, ValueTypeable t) => Producer m (Glob m mut t) where
-    type OutType (Glob t) = Proxy t
+    type OutType (Glob m mut t) = Proxy t
     asTypedExpr e = case getValueType (t e) of
         I32 -> ExprI32 (produce e >> return Proxy)
         I64 -> ExprI64 (produce e >> return Proxy)
         F32 -> ExprF32 (produce e >> return Proxy)
         F64 -> ExprF64 (produce e >> return Proxy)
         where
-            t :: Glob t -> Proxy t
+            t :: Glob m mut t -> Proxy t
-            t _ = Proxy
-    asValueType e = getValueType (t e)
-        where
-            t :: Glob t -> Proxy t
             t _ = Proxy
     produce (Glob i) = appendExpr [GetGlobal i] >> return Proxy
 
-instance (ValueTypeable t) => Producer (GenFun (Proxy t)) where
+instance (GenFunMonad m, ValueTypeable t) => Producer m (m (Proxy t)) where
-    type OutType (GenFun (Proxy t)) = Proxy t
+    type OutType (m (Proxy t)) = Proxy t
     asTypedExpr e = case getValueType (t e) of
         I32 -> ExprI32 (produce e >> return Proxy)
         I64 -> ExprI64 (produce e >> return Proxy)
         F32 -> ExprF32 (produce e >> return Proxy)
         F64 -> ExprF64 (produce e >> return Proxy)
         where
-            t :: GenFun (Proxy t) -> Proxy t
+            t :: (GenFunMonad m) => m (Proxy t) -> Proxy t
-            t _ = Proxy
-    asValueType e = getValueType (t e)
-        where
-            t :: GenFun (Proxy t) -> Proxy t
             t _ = Proxy
     produce = id
 
-ret :: (Producer expr) => expr -> GenFun (OutType expr)
+ret :: (Producer m expr) => expr -> m (OutType expr)
 ret = produce
 
-arg :: (Producer expr) => expr -> GenFun ()
+arg :: (Producer m expr) => expr -> m ()
 arg e = produce e >> return ()
 
 getSize :: ValueType -> BitSize
@@ -171,187 +175,195 @@ type family IsInt i :: Bool where
     IsInt (Proxy I64) = True
     IsInt any         = False
 
-nop :: GenFun ()
+nop :: (GenFunMonad m) => m ()
 nop = appendExpr [Nop]
 
-iBinOp :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => IBinOp -> a -> b -> GenFun (OutType a)
+asValueType :: forall m a . (GenFunMonad m, Producer m a) => a -> ValueType
-iBinOp op a b = produce a >> after [IBinOp (getSize $ asValueType a) op] (produce b)
+asValueType a = case asTypedExpr @m a of
+    ExprI32 e -> I32
+    ExprI64 e -> I64
+    ExprF32 e -> F32
+    ExprF64 e -> F64
 
-add :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (OutType a)
+iBinOp :: forall m a b . (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => IBinOp -> a -> b -> m (OutType a)
+iBinOp op a b = produce a >> after [IBinOp (getSize $ asValueType @m a) op] (produce b)
+
+add :: forall m a b . (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b) => a -> b -> m (OutType a)
 add a b = do
     produce a
-    case asValueType a of
+    case asValueType @m a of
         I32 -> after [IBinOp BS32 IAdd] (produce b)
         I64 -> after [IBinOp BS64 IAdd] (produce b)
         F32 -> after [FBinOp BS32 FAdd] (produce b)
         F64 -> after [FBinOp BS64 FAdd] (produce b)
 
-inc :: (Consumer a, Producer a, Integral i) => i -> a -> GenFun ()
+-- inc :: (GenFunMonad m, Consumer m a, Producer m a, Integral i) => i -> a -> m ()
-inc i a = case asTypedExpr a of
+-- inc i a = case asTypedExpr a of
-    ExprI32 e -> a .= (e `add` i32c i)
+--     ExprI32 e -> a .= (e `add` i32c i)
-    ExprI64 e -> a .= (e `add` i64c i)
+--     ExprI64 e -> a .= (e `add` i64c i)
-    ExprF32 e -> a .= (e `add` f32c (fromIntegral i))
+--     ExprF32 e -> a .= (e `add` f32c (fromIntegral i))
-    ExprF64 e -> a .= (e `add` f64c (fromIntegral i))
+--     ExprF64 e -> a .= (e `add` f64c (fromIntegral i))
 
-sub :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (OutType a)
+sub :: forall m a b . (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b) => a -> b -> m (OutType a)
 sub a b = do
     produce a
-    case asValueType a of
+    case asValueType @m a of
         I32 -> after [IBinOp BS32 ISub] (produce b)
         I64 -> after [IBinOp BS64 ISub] (produce b)
         F32 -> after [FBinOp BS32 FSub] (produce b)
         F64 -> after [FBinOp BS64 FSub] (produce b)
 
-dec :: (Consumer a, Producer a, Integral i) => i -> a -> GenFun ()
-dec i a = case asTypedExpr a of
-    ExprI32 e -> a .= (e `sub` i32c i)
-    ExprI64 e -> a .= (e `sub` i64c i)
-    ExprF32 e -> a .= (e `sub` f32c (fromIntegral i))
-    ExprF64 e -> a .= (e `sub` f64c (fromIntegral i))
 
-mul :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (OutType a)
+-- dec :: (GenFunMonad m, Consumer m a, Producer m a, Integral i) => i -> a -> m ()
+-- dec i a = case asTypedExpr a of
+--     ExprI32 e -> a .= (e `sub` i32c i)
+--     ExprI64 e -> a .= (e `sub` i64c i)
+--     ExprF32 e -> a .= (e `sub` f32c (fromIntegral i))
+--     ExprF64 e -> a .= (e `sub` f64c (fromIntegral i))
+
+mul :: forall m a b . (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b) => a -> b -> m (OutType a)
 mul a b = do
     produce a
-    case asValueType a of
+    case asValueType @m a of
         I32 -> after [IBinOp BS32 IMul] (produce b)
         I64 -> after [IBinOp BS64 IMul] (produce b)
         F32 -> after [FBinOp BS32 FMul] (produce b)
         F64 -> after [FBinOp BS64 FMul] (produce b)
 
-div_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+div_u :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 div_u = iBinOp IDivU
 
-div_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+div_s :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 div_s = iBinOp IDivS
 
-rem_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+rem_u :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 rem_u = iBinOp IRemU
 
-rem_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+rem_s :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 rem_s = iBinOp IRemS
 
-and :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+and :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 and = iBinOp IAnd
 
-or :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+or :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 or = iBinOp IOr
 
-xor :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+xor :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 xor = iBinOp IXor
 
-shl :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+shl :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 shl = iBinOp IShl
 
-shr_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+shr_u :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 shr_u = iBinOp IShrU
 
-shr_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+shr_s :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 shr_s = iBinOp IShrS
 
-rotl :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+rotl :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 rotl = iBinOp IRotl
 
-rotr :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (OutType a)
+rotr :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (OutType a)
 rotr = iBinOp IRotr 
 
-relOp :: (Producer a, Producer b, OutType a ~ OutType b) => IRelOp -> a -> b -> GenFun (Proxy I32)
+relOp :: forall m a b . (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b) => IRelOp -> a -> b -> m (Proxy I32)
 relOp op a b = do
     produce a
     produce b
-    appendExpr [IRelOp (getSize $ asValueType a) op]
+    appendExpr [IRelOp (getSize $ asValueType @m a) op]
     return Proxy
 
-eq :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (Proxy I32)
+eq :: forall m a b . (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b) => a -> b -> m (Proxy I32)
 eq a b = do
     produce a
     produce b
-    case asValueType a of
+    case asValueType @m a of
         I32 -> appendExpr [IRelOp BS32 IEq]
         I64 -> appendExpr [IRelOp BS64 IEq]
         F32 -> appendExpr [FRelOp BS32 FEq]
         F64 -> appendExpr [FRelOp BS64 FEq]
     return Proxy
 
-ne :: (Producer a, Producer b, OutType a ~ OutType b) => a -> b -> GenFun (Proxy I32)
+ne :: forall m a b . (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b) => a -> b -> m (Proxy I32)
 ne a b = do
     produce a
     produce b
-    case asValueType a of
+    case asValueType @m a of
         I32 -> appendExpr [IRelOp BS32 INe]
         I64 -> appendExpr [IRelOp BS64 INe]
         F32 -> appendExpr [FRelOp BS32 FNe]
         F64 -> appendExpr [FRelOp BS64 FNe]
     return Proxy
 
-lt_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
+lt_s :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (Proxy I32)
 lt_s = relOp ILtS
 
-lt_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
+lt_u :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (Proxy I32)
 lt_u = relOp ILtS
 
-gt_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
+gt_s :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (Proxy I32)
 gt_s = relOp IGtS
 
-gt_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
+gt_u :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (Proxy I32)
 gt_u = relOp IGtU
 
-le_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
+le_s :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (Proxy I32)
 le_s = relOp ILeS
 
-le_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
+le_u :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (Proxy I32)
 le_u = relOp ILeS
 
-ge_s :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
+ge_s :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (Proxy I32)
 ge_s = relOp IGeS
 
-ge_u :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> GenFun (Proxy I32)
+ge_u :: (GenFunMonad m, Producer m a, Producer m b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => a -> b -> m (Proxy I32)
 ge_u = relOp IGeU
 
-eqz :: (Producer a, IsInt (OutType a) ~ True) => a -> GenFun (Proxy I32)
+eqz :: forall m a . (GenFunMonad m, Producer m a, IsInt (OutType a) ~ True) => a -> m (Proxy I32)
 eqz a = do
     produce a
-    case asValueType a of
+    case asValueType @m a of
         I32 -> appendExpr [I32Eqz]
         I64 -> appendExpr [I64Eqz]
         _ -> error "Impossible by type constraint"
     return Proxy
 
-i32c :: (Integral i) => i -> GenFun (Proxy I32)
+i32c :: (GenFunMonad m, Integral i) => i -> m (Proxy I32)
 i32c i = appendExpr [I32Const $ asWord32 $ fromIntegral i] >> return Proxy
 
-i64c :: (Integral i) => i -> GenFun (Proxy I64)
+i64c :: (GenFunMonad m, Integral i) => i -> m (Proxy I64)
 i64c i = appendExpr [I64Const $ asWord64 $ fromIntegral i] >> return Proxy
 
-f32c :: Float -> GenFun (Proxy F32)
+f32c :: (GenFunMonad m) => Float -> m (Proxy F32)
 f32c f = appendExpr [F32Const f] >> return Proxy
 
-f64c :: Double -> GenFun (Proxy F64)
+f64c :: (GenFunMonad m) => Double -> m (Proxy F64)
 f64c d = appendExpr [F64Const d] >> return Proxy
 
-extend_u :: (Producer i, OutType i ~ Proxy I32) => i -> GenFun (Proxy I64)
+extend_u :: (GenFunMonad m, Producer m i, OutType i ~ Proxy I32) => i -> m (Proxy I64)
 extend_u small = do
     produce small
     appendExpr [I64ExtendUI32]
     return Proxy
 
-extend_s :: (Producer i, OutType i ~ Proxy I32) => i -> GenFun (Proxy I64)
+extend_s :: (GenFunMonad m, Producer m i, OutType i ~ Proxy I32) => i -> m (Proxy I64)
 extend_s small = do
     produce small
     appendExpr [I64ExtendUI32]
     return Proxy
 
-wrap :: (Producer i, OutType i ~ Proxy I64) => i -> GenFun (Proxy I32)
+wrap :: (GenFunMonad m, Producer m i, OutType i ~ Proxy I64) => i -> m (Proxy I32)
 wrap big = do
     produce big
     appendExpr [I32WrapI64]
     return Proxy
 
-load :: (ValueTypeable t, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
+load :: (GenFunMonad m, ValueTypeable t, Producer m addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
     => Proxy t
     -> addr
     -> offset
     -> align
-    -> GenFun (Proxy t)
+    -> m (Proxy t)
 load t addr offset align = do
     produce addr
     case getValueType t of
@@ -361,12 +373,12 @@ load t addr offset align = do
         F64 -> appendExpr [F64Load $ MemArg (fromIntegral offset) (fromIntegral align)]
     return Proxy
 
-load8_u :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
+load8_u :: (GenFunMonad m, ValueTypeable t, IsInt (Proxy t) ~ True, Producer m addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
     => Proxy t
     -> addr
     -> offset
     -> align
-    -> GenFun (Proxy t)
+    -> m (Proxy t)
 load8_u t addr offset align = do
     produce addr
     case getValueType t of
@@ -375,12 +387,12 @@ load8_u t addr offset align = do
         _ -> error "Impossible by type constraint"
     return Proxy
 
-load8_s :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
+load8_s :: (GenFunMonad m, ValueTypeable t, IsInt (Proxy t) ~ True, Producer m addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
     => Proxy t
     -> addr
     -> offset
     -> align
-    -> GenFun (Proxy t)
+    -> m (Proxy t)
 load8_s t addr offset align = do
     produce addr
     case getValueType t of
@@ -389,12 +401,12 @@ load8_s t addr offset align = do
         _ -> error "Impossible by type constraint"
     return Proxy
 
-load16_u :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
+load16_u :: (GenFunMonad m, ValueTypeable t, IsInt (Proxy t) ~ True, Producer m addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
     => Proxy t
     -> addr
     -> offset
     -> align
-    -> GenFun (Proxy t)
+    -> m (Proxy t)
 load16_u t addr offset align = do
     produce addr
     case getValueType t of
@@ -403,12 +415,12 @@ load16_u t addr offset align = do
         _ -> error "Impossible by type constraint"
     return Proxy
 
-load16_s :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
+load16_s :: (GenFunMonad m, ValueTypeable t, IsInt (Proxy t) ~ True, Producer m addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
     => Proxy t
     -> addr
     -> offset
     -> align
-    -> GenFun (Proxy t)
+    -> m (Proxy t)
 load16_s t addr offset align = do
     produce addr
     case getValueType t of
@@ -417,104 +429,104 @@ load16_s t addr offset align = do
         _ -> error "Impossible by type constraint"
     return Proxy
 
-load32_u :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
+load32_u :: (GenFunMonad m, ValueTypeable t, IsInt (Proxy t) ~ True, Producer m addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
     => Proxy t
     -> addr
     -> offset
     -> align
-    -> GenFun (Proxy t)
+    -> m (Proxy t)
 load32_u t addr offset align = do
     produce addr
     appendExpr [I64Load32U $ MemArg (fromIntegral offset) (fromIntegral align)]
     return Proxy
 
-load32_s :: (ValueTypeable t, IsInt (Proxy t) ~ True, Producer addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
+load32_s :: (GenFunMonad m, ValueTypeable t, IsInt (Proxy t) ~ True, Producer m addr, OutType addr ~ Proxy I32, Integral offset, Integral align)
     => Proxy t
     -> addr
     -> offset
     -> align
-    -> GenFun (Proxy t)
+    -> m (Proxy t)
 load32_s t addr offset align = do
     produce addr
     appendExpr [I64Load32S $ MemArg (fromIntegral offset) (fromIntegral align)]
     return Proxy
 
-store :: (Producer addr, OutType addr ~ Proxy I32, Producer val, Integral offset, Integral align)
+store :: forall m addr val offset align . (GenFunMonad m, Producer m addr, OutType addr ~ Proxy I32, Producer m val, Integral offset, Integral align)
     => addr
     -> val
     -> offset
     -> align
-    -> GenFun ()
+    -> m ()
 store addr val offset align = do
     produce addr
     produce val
-    case asValueType val of
+    case asValueType @m val of
         I32 -> appendExpr [I32Store $ MemArg (fromIntegral offset) (fromIntegral align)]
         I64 -> appendExpr [I64Store $ MemArg (fromIntegral offset) (fromIntegral align)]
         F32 -> appendExpr [F32Store $ MemArg (fromIntegral offset) (fromIntegral align)]
         F64 -> appendExpr [F64Store $ MemArg (fromIntegral offset) (fromIntegral align)]
 
-store8 :: (Producer addr, OutType addr ~ Proxy I32, Producer val, IsInt (OutType val) ~ True, Integral offset, Integral align)
+store8 :: forall m addr val offset align . (GenFunMonad m, Producer m addr, OutType addr ~ Proxy I32, Producer m val, IsInt (OutType val) ~ True, Integral offset, Integral align)
     => addr
     -> val
     -> offset
     -> align
-    -> GenFun ()
+    -> m ()
 store8 addr val offset align = do
     produce addr
     produce val
-    case asValueType val of
+    case asValueType @m val of
         I32 -> appendExpr [I32Store8 $ MemArg (fromIntegral offset) (fromIntegral align)]
         I64 -> appendExpr [I64Store8 $ MemArg (fromIntegral offset) (fromIntegral align)]
         _ -> error "Impossible by type constraint"
 
-store16 :: (Producer addr, OutType addr ~ Proxy I32, Producer val, IsInt (OutType val) ~ True, Integral offset, Integral align)
+store16 :: forall m addr val offset align . (GenFunMonad m, Producer m addr, OutType addr ~ Proxy I32, Producer m val, IsInt (OutType val) ~ True, Integral offset, Integral align)
     => addr
     -> val
     -> offset
     -> align
-    -> GenFun ()
+    -> m ()
 store16 addr val offset align = do
     produce addr
     produce val
-    case asValueType val of
+    case asValueType @m val of
         I32 -> appendExpr [I32Store16 $ MemArg (fromIntegral offset) (fromIntegral align)]
         I64 -> appendExpr [I64Store16 $ MemArg (fromIntegral offset) (fromIntegral align)]
         _ -> error "Impossible by type constraint"
 
-store32 :: (Producer addr, OutType addr ~ Proxy I32, Producer val, OutType val ~ Proxy I64, Integral offset, Integral align)
+store32 :: (GenFunMonad m, Producer m addr, OutType addr ~ Proxy I32, Producer m val, OutType val ~ Proxy I64, Integral offset, Integral align)
     => addr
     -> val
     -> offset
     -> align
-    -> GenFun ()
+    -> m ()
 store32 addr val offset align = do
     produce addr
     produce val
     appendExpr [I64Store32 $ MemArg (fromIntegral offset) (fromIntegral align)]
 
-call :: (Returnable res) => Fn res -> [GenFun a] -> GenFun res
+call :: (GenFunMonad m, Returnable res) => Fn res -> [m a] -> m res
 call (Fn idx) args = sequence_ args >> appendExpr [Call idx] >> return returnableValue
 
-br :: Label t -> GenFun ()
+br :: (GenFunMonad m) => Label t -> m ()
 br (Label labelDeep) = do
-    deep <- ask
+    d <- deep
-    appendExpr [Br $ deep - labelDeep]
+    appendExpr [Br $ d - labelDeep]
 
-finish :: (Producer val) => val -> GenFun ()
+finish :: (GenFunMonad m, Producer m val) => val -> m ()
 finish val = do
     produce val
     appendExpr [Return]
 
 newtype Label i = Label Natural deriving (Show, Eq)
 
-when :: (Producer pred, OutType pred ~ Proxy I32)
+when :: (GenFunMonad m, Producer m pred, OutType pred ~ Proxy I32)
     => pred
-    -> GenFun ()
+    -> m ()
-    -> GenFun ()
+    -> m ()
 when pred body = if' () pred body (return ())
 
-for :: (Producer pred, OutType pred ~ Proxy I32) => GenFun () -> pred -> GenFun () -> GenFun () -> GenFun ()
+for :: (GenFunMonad m, Producer m pred, OutType pred ~ Proxy I32) => m () -> pred -> m () -> m () -> m ()
 for initer pred after body = do
     initer
     let loopBody = do
@@ -524,7 +536,7 @@ for initer pred after body = do
             if' () pred (br loopLabel) (return ())
     if' () pred (loop () loopBody) (return ())
 
-while :: (Producer pred, OutType pred ~ Proxy I32) => pred -> GenFun () -> GenFun ()
+while :: (GenFunMonad m, Producer m pred, OutType pred ~ Proxy I32) => pred -> m () -> m ()
 while pred body = do
     let loopBody = do
             body
@@ -532,49 +544,53 @@ while pred body = do
             if' () pred (br loopLabel) (return ())
     if' () pred (loop () loopBody) (return ())
 
-label :: GenFun (Label t)
+label :: (GenFunMonad m) => m (Label t)
-label = Label <$> ask
+label = Label <$> deep
 
-if' :: (Producer pred, OutType pred ~ Proxy I32, Returnable res)
+if' :: (GenFunMonad m, Producer m pred, OutType pred ~ Proxy I32, Returnable res)
     => res
     -> pred
-    -> GenFun res
+    -> m res
-    -> GenFun res
+    -> m res
-    -> GenFun res
+    -> m res
 if' res pred true false = do
     produce pred
-    deep <- (+1) <$> ask
+    t <- inner true
-    appendExpr [If (asResultValue res) (genExpr deep $ true) (genExpr deep $ false)]
+    f <- inner false
+    appendExpr [If (asResultValue res) t f]
     return returnableValue
 
-loop :: (Returnable res) => res -> GenFun res -> GenFun res
+loop :: (GenFunMonad m, Returnable res) => res -> m res -> m res
 loop res body = do
-    deep <- (+1) <$> ask
+    b <- inner body
-    appendExpr [Loop (asResultValue res) (genExpr deep $ body)]
+    appendExpr [Loop (asResultValue res) b]
     return returnableValue
 
-block :: (Returnable res) => res -> GenFun res -> GenFun res
+block :: (GenFunMonad m, Returnable res) => res -> m res -> m res
 block res body = do
-    deep <- (+1) <$> ask
+    b <- inner body
-    appendExpr [Block (asResultValue res) (genExpr deep $ body)]
+    appendExpr [Block (asResultValue res) b]
     return returnableValue
 
-trap :: Proxy t -> GenFun (Proxy t)
+trap :: (GenFunMonad m) => Proxy t -> m (Proxy t)
 trap t = do
     appendExpr [Unreachable]
     return t
 
-unreachable :: GenFun ()
+unreachable :: (GenFunMonad m) => m ()
 unreachable = appendExpr [Unreachable]
 
 class Consumer loc where
+    type InputType loc
     infixr 2 .=
-    (.=) :: (Producer expr) => loc -> expr -> GenFun ()
+    (.=) :: (GenFunMonad m, Producer m expr, InputType loc ~ OutType expr) => loc -> expr -> m ()
 
-instance Consumer (Loc t) where
+instance (GenFunMonad m) => Consumer (Loc m t) where
+    type InputType (Loc m t) = Proxy t
     (.=) (Loc i) expr = produce expr >> appendExpr [SetLocal i]
 
-instance Consumer (Glob t) where
+instance (GenFunMonad m) => Consumer (Glob m M t) where
+    type InputType (Glob m M t) = Proxy t
     (.=) (Glob i) expr = produce expr >> appendExpr [SetGlobal i]
 
 typedef :: FuncType -> GenMod Natural
@@ -601,7 +617,8 @@ instance Returnable () where
 funRec :: (Returnable res) => res -> (Fn res -> GenFun res) -> GenMod (Fn res)
 funRec res generator = do
     st@GenModState { target = m@Module { types, functions }, funcIdx } <- get
-    let FuncDef { args, locals, instrs } = execState (runReaderT (generator (Fn funcIdx)) 0) $ FuncDef [] [] [] []
+    let GenFun gen = generator (Fn funcIdx)
+    let FuncDef { args, locals, instrs } = execState (runReaderT gen 0) $ FuncDef [] [] [] []
     let t = FuncType args (asResultValue res)
     let (idx, inserted) = Maybe.fromMaybe (length types, types ++ [t]) $ (\i -> (i, types)) <$> List.findIndex (== t) types
     put $ st {
@@ -638,7 +655,7 @@ importFunction mod name res params = do
     }
     return (Fn funcIdx)
 
-importGlobal :: (ValueTypeable t) => TL.Text -> TL.Text -> Proxy t -> GenMod (Glob t)
+importGlobal :: (ValueTypeable t) => TL.Text -> TL.Text -> Proxy t -> (forall m . GenFunMonad m => GenMod (Glob m C t))
 importGlobal mod name t = do
     st@GenModState { target = m@Module { imports }, globIdx } <- get
     put $ st {
@@ -679,8 +696,8 @@ instance Exportable (Fn t) where
         }
         return (Fn funIdx)
 
-instance Exportable (Glob t) where
+instance Exportable (Glob m C t) where
-    type AfterExport (Glob t) = Glob t
+    type AfterExport (Glob m C t) = Glob m C t
     export name g@(Glob idx) = do
         modify $ \(st@GenModState { target = m }) -> st {
             target = m { exports = exports m ++ [Export name $ ExportGlobal idx] }
@@ -733,18 +750,35 @@ i64 = Proxy @I64
 f32 = Proxy @F32
 f64 = Proxy @F64
 
-newtype Glob t = Glob Natural deriving (Show, Eq)
+data GlobMut = M | C
 
-global :: (ValueTypeable t) => (ValueType -> GlobalType) -> Proxy t -> (ValType t) -> GenMod (Glob t)
+globMut :: Proxy M
-global mkType t val = do
+globMut = Proxy
+
+globConst :: Proxy C
+globConst = Proxy
+
+class GlobalMutability mut where
+    globalTypeCtor :: Proxy mut -> ValueType -> GlobalType
+
+instance GlobalMutability M where
+    globalTypeCtor _ = Mut
+
+instance GlobalMutability C where
+    globalTypeCtor _ = Const
+
+newtype Glob m (mut :: GlobMut) (t :: ValueType) = Glob Natural deriving (Show, Eq)
+
+global :: (ValueTypeable t, GlobalMutability mut) => Proxy mut -> Proxy t -> (ValType t) -> (forall m . GenFunMonad m => GenMod (Glob m mut t))
+global globMut t val = do
     idx <- gets globIdx
     modify $ \(st@GenModState { target = m }) -> st {
-        target = m { globals = globals m ++ [Global (mkType $ getValueType t) (initWith t val)] },
+        target = m { globals = globals m ++ [Global (globalTypeCtor globMut $ getValueType t) (initWith t val)] },
         globIdx = idx + 1
     }
     return $ Glob idx
 
-setGlobalInitializer :: forall t . (ValueTypeable t) => Glob t -> (ValType t) -> GenMod ()
+setGlobalInitializer :: forall m t mut . (ValueTypeable t) => Glob m mut t -> (ValType t) -> GenMod ()
 setGlobalInitializer (Glob idx) val = do
     modify $ \(st@GenModState { target = m }) ->
         let globImpsLen = length $ filter isGlobalImport $ imports m in
@@ -771,10 +805,10 @@ table min max = do
     }
     return $ Tbl 0
 
-dataSegment :: (Producer offset, OutType offset ~ Proxy I32) => offset -> LBS.ByteString -> GenMod ()
+dataSegment :: (Integral offset) => offset -> LBS.ByteString -> GenMod ()
 dataSegment offset bytes =
     modify $ \(st@GenModState { target = m }) -> st {
-        target = m { datas = datas m ++ [DataSegment 0 (genExpr 0 (produce offset)) bytes] }
+        target = m { datas = datas m ++ [DataSegment 0 [I32Const $ fromIntegral offset] bytes] }
     }
 
 asWord32 :: Int32 -> Word32
@@ -792,21 +826,21 @@ rts = genMod $ do
     gc <- importFunction "rts" "gc" () [I32]
     memory 10 Nothing
 
-    stackStart <- global Const i32 0
+    stackStart <- global globConst i32 0 @GenFun
-    stackEnd <- global Const i32 0
+    stackEnd <- global globConst i32 0 @GenFun
-    stackBase <- global Mut i32 0
+    stackBase <- global globMut i32 0 @GenFun
-    stackTop <- global Mut i32 0
+    stackTop <- global globMut i32 0 @GenFun
 
-    retReg <- global Mut i32 0
+    retReg <- global globMut i32 0 @GenFun
-    tmpReg <- global Mut i32 0
+    tmpReg <- global globMut i32 0 @GenFun
 
-    heapStart <- global Mut i32 0
+    heapStart <- global globMut i32 0 @GenFun
-    heapNext <- global Mut i32 0
+    heapNext <- global globMut i32 0 @GenFun
-    heapEnd <- global Mut i32 0
+    heapEnd <- global globMut i32 0 @GenFun
 
     aligned <- fun i32 $ do
         size <- param i32
-        (size `add` i32c 3) `and` i32c 0xFFFFFFFC
+        (size `add` i32c 3) `and` i32c @GenFun 0xFFFFFFFC
     alloc <- funRec i32 $ \self -> do
         size <- param i32
         alignedSize <- local i32