msyds/haskell-wasm
1
0
Fork 0
forked from GitHub/haskell-wasm
Code Pull Requests Activity

make inc and dec polymorphic

Browse Source
This commit is contained in:
Ilya Rezvov
2018-05-27 14:49:49 -07:00
parent 3926e5b9f1
commit ddf89644ce
1 changed files with 49 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Builder.hs
+49 -6
View File
@@ -94,13 +94,28 @@ after instr expr = do
modify $ \def -> def { instrs = instrs def ++ instr }
return 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 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 _ = Proxy
asValueType e = getValueType (t e)
where
t :: Loc t -> Proxy t
@@ -109,6 +124,14 @@ instance (ValueTypeable t) => Producer (Loc t) where
instance (ValueTypeable t) => Producer (Glob t) where
type OutType (Glob 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 _ = Proxy
asValueType e = getValueType (t e)
where
t :: Glob t -> Proxy t
@@ -117,6 +140,14 @@ instance (ValueTypeable t) => Producer (Glob t) where
instance (ValueTypeable t) => Producer (GenFun (Proxy t)) where
type OutType (GenFun (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 _ = Proxy
asValueType e = getValueType (t e)
where
t :: GenFun (Proxy t) -> Proxy t
@@ -155,8 +186,12 @@ add a b = do
F32 -> after [FBinOp BS32 FAdd] (produce b)
F64 -> after [FBinOp BS64 FAdd] (produce b)
inc :: (Consumer a, Producer a, OutType a ~ Proxy I32, Integral i) => i -> a -> GenFun ()
inc i a = a .= (a `add` i32c i)
inc :: (Consumer a, Producer a, Integral i) => i -> a -> GenFun ()
inc i a = case asTypedExpr a of
ExprI32 e -> a .= (e `add` i32c i)
ExprI64 e -> a .= (e `add` i64c i)
ExprF32 e -> a .= (e `add` f32c (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 a b = do
@@ -167,8 +202,12 @@ sub a b = do
F32 -> after [FBinOp BS32 FSub] (produce b)
F64 -> after [FBinOp BS64 FSub] (produce b)
dec :: (Consumer a, Producer a, OutType a ~ Proxy I32, Integral i) => i -> a -> GenFun ()
dec i a = a .= (a `sub` i32c i)
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)
mul a b = do
@@ -481,12 +520,16 @@ for initer pred after body = do
let loopBody = do
body
after
if' () pred (label >>= br) (return ())
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 = body >> if' () pred (label >>= br) (return ())
let loopBody = do
body
loopLabel <- label
if' () pred (br loopLabel) (return ())
if' () pred (loop () loopBody) (return ())
label :: GenFun (Label t)