Commit b9ef2262 authored by Katharina Brandl's avatar Katharina Brandl
Browse files

finished unit analysis

parent 6f237fb6
Pipeline #128458 passed with stages
in 74 minutes and 11 seconds
......@@ -127,7 +127,7 @@ class Show v => IsVal v c | c -> v where
f32const :: c Float v
f64const :: c Double v
iUnOp :: c (BitSize, IUnOp, v) v
iBinOp :: c (IBinOp, v, v) v -> c (BitSize, IBinOp, v, v) v
iBinOp :: (JoinVal v c) => c (IBinOp, v, v) v -> c (BitSize, IBinOp, v, v) v
i32eqz :: c v v
i64eqz :: c v v
iRelOp :: c (BitSize, IRelOp, v, v) v
......@@ -135,8 +135,8 @@ class Show v => IsVal v c | c -> v where
fBinOp :: c (BitSize, FBinOp, v, v) v
fRelOp :: c (BitSize, FRelOp, v, v) v
i32WrapI64 :: c v v
iTruncFU :: c (BitSize, BitSize, v) v -> c (BitSize, BitSize, v) v
iTruncFS :: c (BitSize, BitSize, v) v -> c (BitSize, BitSize, v) v
iTruncFU :: (JoinVal v c) => c (BitSize, BitSize, v) v -> c (BitSize, BitSize, v) v
iTruncFS :: (JoinVal v c) => c (BitSize, BitSize, v) v -> c (BitSize, BitSize, v) v
i64ExtendSI32 :: c v v
i64ExtendUI32 :: c v v
fConvertIU :: c (BitSize, BitSize, v) v
......@@ -149,7 +149,7 @@ class Show v => IsVal v c | c -> v where
-- | `listLookup f g (v, xs, x)`
-- | Looks up the `v`-th element in `xs` and passes it to `f`, or
-- | passes `x` to `g` if `v` is out of range of `xs`.
listLookup :: c x y -> c x y -> c (v, [x], x) y
listLookup :: (JoinVal y c) => c x y -> c x y -> c (v, [x], x) y
ifHasType :: c x y -> c x y -> c (v, ValueType, x) y
......@@ -163,7 +163,7 @@ invokeExported ::
ArrowStaticComponents v c, ArrowDynamicComponents v addr bytes sz exc e c,
JoinExc () c, Exc.Join () c,
Mem.Join () c,
JoinVal () c, Show v,
JoinVal () c, JoinVal v c, Show v,
Fail.Join [v] c,
Fail.Join () c,
JoinTable () c)
......@@ -181,7 +181,7 @@ invokeExternal ::
ArrowStaticComponents v c, ArrowDynamicComponents v addr bytes sz exc e c,
JoinExc () c,
Mem.Join () c,
JoinVal () c, Show v,
JoinVal () c, JoinVal v c, Show v,
Exc.Join () c,
Fail.Join () c,
JoinTable () c)
......@@ -226,7 +226,7 @@ eval ::
ArrowStaticComponents v c, ArrowDynamicComponents v addr bytes sz exc e c,
JoinExc () c,
Mem.Join () c,
JoinVal () c, Show v,
JoinVal () c, JoinVal v c, Show v,
Exc.Join () c,
JoinTable () c)
=> c [Instruction Natural] ()
......@@ -562,7 +562,7 @@ evalVariableInst = proc i -> case i of
evalNumericInst ::
( ArrowChoice c, ArrowStack v c, ArrowExcept exc c, IsException exc v c, IsVal v c, Show v)
( ArrowChoice c, ArrowStack v c, ArrowExcept exc c, IsException exc v c, IsVal v c, Show v, JoinVal v c)
=> c (Instruction Natural) v
evalNumericInst = proc i -> case i of
I32Const lit _ -> i32const -< lit
......
......@@ -110,63 +110,6 @@ instance (ArrowExcept (Exc Value) c, ArrowChoice c) => IsException (Exc Value) V
--ys <- mapList f -< (HashSet.toList excs,x)
--joinList _j -< (_init,ys)
joinList1'' f -< (HashSet.toList excs,x)
-- y1 <- f -< first
-- y2 <- f -< second
-- ...
-- yn <- f -< nth
-- returnA -< y1 ⊔ y2 ⊔ ... ⊔ yn
--newtype GlobalStateT v c x y = GlobalStateT (StateT (FreeCompletion (GlobalState v)) c x y)
-- deriving (Profunctor, Category, Arrow, ArrowChoice, ArrowLift, ArrowReader r,
-- ArrowFail e, ArrowExcept e, ArrowConst r, ArrowRun, ArrowFrame fd val,
-- ArrowStack st, ArrowLogger l, ArrowJoin)
--
--instance (ArrowState s c) => ArrowState s (GlobalStateT v c) where
-- -- TODO
--
--instance ArrowTrans (GlobalStateT v) where
-- lift' a = GlobalStateT (lift' a)
--
--instance (ArrowChoice c, Profunctor c) => ArrowGlobalState v Int (GlobalStateT v c) where
-- readFunction (GlobalStateT funcCont) =
-- GlobalStateT $ proc (i,x) -> do
-- Lower(GlobalState{funcInstances = fs}) <- get -< ()
-- case fs Vec.! i of
-- FuncInst fTy modInst code -> funcCont -< ((fTy,modInst,code),x)
-- _ -> returnA -< error "not yet implemented" --hostCont -< ((fTy,code),x)
-- fetchMemory = arr Prelude.id
-- storeMemory = arr $ const ()
--
--instance (Profunctor c, ArrowChoice c) => ArrowMemory Int () () (GlobalStateT Value c) where
-- type Join y (GlobalStateT Value c) = ArrowComplete y (GlobalStateT Value c)
-- memread sCont eCont = proc (i, (_, _, x)) -> do
-- y <- (sCont -< ((),x)) <⊔> (eCont -< x)
-- returnA -< (i, y)
-- memstore sCont eCont = proc (i, (_, _, x)) -> do
-- y <- (sCont -< x) <⊔> (eCont -< x)
-- returnA -< (i, y)
--
--instance (Arrow c, Profunctor c) => ArrowMemAddress Value Natural () (GlobalStateT Value c) where
-- memaddr = arr $ const ()
--
--toTopVal :: ValueType -> Value
--toTopVal I32 = Value $ Lower $ VI32 top
--toTopVal I64 = Value $ Lower $ VI64 top
--toTopVal F32 = Value $ Lower $ VF32 top
--toTopVal F64 = Value $ Lower $ VF64 top
--
--instance (Profunctor c, Arrow c) => ArrowSerialize Value () ValueType LoadType StoreType (GlobalStateT Value c) where
-- decode sCont = proc ((), _, valTy, x) -> sCont -< (toTopVal valTy, x)
-- encode sCont = proc (_,_,_,x) -> sCont -< ((),x)
--
--instance ArrowMemSizable sz (GlobalStateT Value c) where
-- -- TODO
--
--instance ArrowFix (Underlying (GlobalStateT v c) x y) => ArrowFix (GlobalStateT v c x y) where
-- type Fix (GlobalStateT v c x y) = Fix (Underlying (GlobalStateT v c) x y)
--deriving instance (ArrowComplete (FreeCompletion (GlobalState v), y) c) => ArrowComplete y (GlobalStateT v c)
type In = (JoinVector Value,
((Natural, ModuleInstance),
......@@ -239,28 +182,3 @@ invokeExported initialStore tab modInst funcName args =
instantiateAbstract :: ValidModule -> IO (Either String (ModuleInstance, StaticGlobalState Value, Tables))
instantiateAbstract valMod = do res <- instantiate valMod alpha (\_ _ -> ()) TableInst
return $ fmap (\(m,s,_,tab) -> (m,s,JoinVector tab)) res
--instantiate :: ValidModule -> IO (Either String (ModuleInstance, GlobalState Value))
--instantiate valMod = do
-- res <- Wasm.instantiate emptyStore emptyImports valMod
-- case res of
-- Right (modInst, store) -> do
-- wasmStore <- storeToGlobalState store
-- return $ Right $ (modInst, wasmStore)
-- Left e -> return $ Left e
--
-- where
-- storeToGlobalState (Wasm.Store funcI tableI memI globalI) = do
-- let funcs = generate $ Vec.mapM convertFuncInst funcI
-- globs <- Vec.mapM convertGlobals globalI
-- return $ GlobalState funcs
-- (Vec.map TableInst tableI)
-- globs
--
---- convertFuncs (Wasm.FunctionInstance t m c) = error "todo" --FuncInst t m c
---- convertFuncs (Wasm.HostInstance t _) = HostInst t
--
-- convertGlobals (Wasm.GIConst _ v) = return $ Lower $ GlobInst Const (alpha v)
-- convertGlobals (Wasm.GIMut _ v) = do
-- val <- readIORef v
-- return $ Lower $ GlobInst Mutable (alpha val)
......@@ -9,7 +9,7 @@
module UnitAnalysisValue where
import Abstract
import Data()
import Data(joinList1'')
import GenericInterpreter
import Control.Arrow
......@@ -17,7 +17,8 @@ import Control.Arrow.Order
import Control.Arrow.Transformer.Value
import Language.Wasm.Structure (BitSize(..), IBinOp(..), IRelOp(..), ValueType(..))
import Language.Wasm.Structure (BitSize(..), IBinOp(..), IRelOp(..), ValueType(..), IUnOp(..),
FUnOp(..), FBinOp(..), FRelOp(..))
import Data.Hashable
import Data.Order
......@@ -38,24 +39,83 @@ instance ArrowChoice c => IsVal Value (ValueT Value c) where
i64const = proc _ -> returnA -< valueI64
f32const = proc _ -> returnA -< valueF32
f64const = proc _ -> returnA -< valueF64
iBinOp _eCont = proc (bs, op, Value v1, Value v2) ->
case (bs,op,v1,v2) of
(BS32, IAdd, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IMul, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, ISub, VI32 _, VI32 _) -> returnA -< valueI32
(BS64, IAdd, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IMul, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, ISub, VI64 _, VI64 _) -> returnA -< valueI64
iUnOp = proc (bs,op,Value v0) -> case (bs,op,v0) of
(BS32, IClz, VI32 _) -> returnA -< valueI32
(BS32, ICtz, VI32 _) -> returnA -< valueI32
(BS32, IPopcnt, VI32 _) -> returnA -< valueI32
(BS64, IClz, VI64 _) -> returnA -< valueI64
(BS64, ICtz, VI64 _) -> returnA -< valueI64
(BS64, IPopcnt, VI64 _) -> returnA -< valueI64
_ -> returnA -< error "iUnOp: cannot apply operator to arguments"
iBinOp eCont = proc (bs,op,x@(Value v1),y@(Value v2)) -> case (bs,op,v1,v2) of
(BS32, IAdd, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, ISub, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IMul, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IDivU, VI32 _, VI32 _) -> (returnA -< valueI32) <> (eCont -< (op,x,y))
(BS32, IDivS, VI32 _, VI32 _) -> (returnA -< valueI32) <> (eCont -< (op,x,y))
(BS32, IRemU, VI32 _, VI32 _) -> (returnA -< valueI32) <> (eCont -< (op,x,y))
(BS32, IRemS, VI32 _, VI32 _) -> (returnA -< valueI32) <> (eCont -< (op,x,y))
(BS32, IAnd, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IOr, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IXor, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IShl, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IShrU, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IShrS, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IRotl, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IRotr, VI32 _, VI32 _) -> returnA -< valueI32
(BS64, IAdd, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, ISub, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IMul, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IDivU, VI64 _, VI64 _) -> (returnA -< valueI64) <> (eCont -< (op,x,y))
(BS64, IDivS, VI64 _, VI64 _) -> (returnA -< valueI64) <> (eCont -< (op,x,y))
(BS64, IRemU, VI64 _, VI64 _) -> (returnA -< valueI64) <> (eCont -< (op,x,y))
(BS64, IRemS, VI64 _, VI64 _) -> (returnA -< valueI64) <> (eCont -< (op,x,y))
(BS64, IAnd, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IOr, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IXor, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IShl, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IShrU, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IShrS, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IRotl, VI64 _, VI64 _) -> returnA -< valueI64
(BS64, IRotr, VI64 _, VI64 _) -> returnA -< valueI64
_ -> returnA -< error "iBinOp: cannot apply binary operator to given arguments."
iRelOp = proc (bs,op,Value v1, Value v2) ->
case (bs,op,v1,v2) of
(BS32, IEq, VI32 _, VI32 _) -> returnA -< valueI32
(BS64, IEq, VI64 _, VI64 _) -> returnA -< valueI32
iRelOp = proc (bs,op,Value v1, Value v2) -> case (bs,op,v1,v2) of
(BS32, IEq, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, INe, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, ILtU, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, ILtS, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IGtU, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IGtS, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, ILeU, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, ILeS, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IGeU, VI32 _, VI32 _) -> returnA -< valueI32
(BS32, IGeS, VI32 _, VI32 _) -> returnA -< valueI32
(BS64, IEq, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, INe, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, ILtU, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, ILtS, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, IGtU, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, IGtS, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, ILeU, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, ILeS, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, IGeU, VI64 _, VI64 _) -> returnA -< valueI32
(BS64, IGeS, VI64 _, VI64 _) -> returnA -< valueI32
_ -> returnA -< error "iRelOp: cannot apply binary operator to given arguments."
i32ifNeqz f g = proc (Value v, x) -> do
case v of
(VI32 _) -> (f -< x) <> (g -< x)
_ -> returnA -< error "i32ifNeqz: condition of unexpected type"
i32eqz = proc (Value v) -> case v of
(VI32 _) -> returnA -< valueI32
_ -> returnA -< error "i32eqz: cannot apply operator to given argument."
i64eqz = proc (Value v) -> case v of
(VI64 _) -> returnA -< valueI32
_ -> returnA -< error "i64eqz: cannot apply operator to given argument."
i32ifNeqz f g = proc (v, x) -> case v of
Value (VI32 _) -> (g -< x) <> (f -< x)
_ -> returnA -< error "i32ifNeqz: condition of unexpected type"
ifHasType f g = proc (Value v,t,x) -> do
case (v,t) of
(VI32 _, I32) -> f -< x
......@@ -64,24 +124,103 @@ instance ArrowChoice c => IsVal Value (ValueT Value c) where
(VF64 _, F64) -> f -< x
_ -> g -< x
iUnOp = error "TODO: implement iUnOp"
i32eqz = error "TODO: implement i32eqz"
i64eqz = error "TODO: implement i64eqz"
fUnOp = error "TODO: implement fUnOp"
fBinOp = error "TODO: implement fBinOp"
fRelOp = error "TODO: implement fRelOp"
i32WrapI64 = error "TODO: implement i32WrapI64"
iTruncFU = error "TODO: implement iTruncFU"
iTruncFS = error "TODO: implement iTruncFS"
i64ExtendSI32 = error "TODO: implement i64ExtendSI32"
i64ExtendUI32 = error "TODO: implement i64ExtendUI32"
fConvertIU = error "TODO: implement fConvertIU"
fConvertIS = error "TODO: implement fConvertIS"
f32DemoteF64 = error "TODO: implement f32DemoteF64"
f64PromoteF32 = error "TODO: implement f64PromoteF32"
iReinterpretF = error "TODO: implement iReinterpretF"
fReinterpretI = error "TODO: implement IReinterpretI"
listLookup = error "TODO: implement listLookup"
fUnOp = proc (bs,op,Value v) -> case (bs,op,v) of
(BS32, FAbs, VF32 _) -> returnA -< valueF32
(BS32, FNeg, VF32 _) -> returnA -< valueF32
(BS32, FCeil, VF32 _) -> returnA -< valueF32
(BS32, FFloor, VF32 _) -> returnA -< valueF32
(BS32, FTrunc, VF32 _) -> returnA -< valueF32
(BS32, FNearest, VF32 _) -> returnA -< valueF32
(BS32, FSqrt, VF32 _) -> returnA -< valueF32
(BS64, FAbs, VF64 _) -> returnA -< valueF64
(BS64, FNeg, VF64 _) -> returnA -< valueF64
(BS64, FCeil, VF64 _) -> returnA -< valueF64
(BS64, FFloor, VF64 _) -> returnA -< valueF64
(BS64, FTrunc, VF64 _) -> returnA -< valueF64
(BS64, FNearest, VF64 _) -> returnA -< valueF64
(BS64, FSqrt, VF64 _) -> returnA -< valueF64
_ -> returnA -< error "fUnOp: cannot apply operator to arguements"
fBinOp = proc (bs,op,Value v1,Value v2) -> case (bs,op,v1,v2) of
(BS32, FAdd, VF32 _, VF32 _) -> returnA -< valueF32
(BS32, FSub, VF32 _, VF32 _) -> returnA -< valueF32
(BS32, FMul, VF32 _, VF32 _) -> returnA -< valueF32
(BS32, FDiv, VF32 _, VF32 _) -> returnA -< valueF32
(BS32, FMin, VF32 _, VF32 _) -> returnA -< valueF32
(BS32, FMax, VF32 _, VF32 _) -> returnA -< valueF32
(BS32, FCopySign, VF32 _, VF32 _) -> returnA -< valueF32
(BS64, FAdd, VF64 _, VF64 _) -> returnA -< valueF64
(BS64, FSub, VF64 _, VF64 _) -> returnA -< valueF64
(BS64, FMul, VF64 _, VF64 _) -> returnA -< valueF64
(BS64, FDiv, VF64 _, VF64 _) -> returnA -< valueF64
(BS64, FMin, VF64 _, VF64 _) -> returnA -< valueF64
(BS64, FMax, VF64 _, VF64 _) -> returnA -< valueF64
(BS64, FCopySign, VF64 _, VF64 _) -> returnA -< valueF64
_ -> returnA -< error "fBinOp: cannot apply binary operator to given arguments."
fRelOp = proc (bs,op,Value v1,Value v2) -> case (bs,op,v1,v2) of
(BS32, FEq, VF32 _, VF32 _) -> returnA -< valueI32
(BS32, FNe, VF32 _, VF32 _) -> returnA -< valueI32
(BS32, FLt, VF32 _, VF32 _) -> returnA -< valueI32
(BS32, FGt, VF32 _, VF32 _) -> returnA -< valueI32
(BS32, FLe, VF32 _, VF32 _) -> returnA -< valueI32
(BS32, FGe, VF32 _, VF32 _) -> returnA -< valueI32
(BS64, FEq, VF64 _, VF64 _) -> returnA -< valueI32
(BS64, FNe, VF64 _, VF64 _) -> returnA -< valueI32
(BS64, FLt, VF64 _, VF64 _) -> returnA -< valueI32
(BS64, FGt, VF64 _, VF64 _) -> returnA -< valueI32
(BS64, FLe, VF64 _, VF64 _) -> returnA -< valueI32
(BS64, FGe, VF64 _, VF64 _) -> returnA -< valueI32
_ -> returnA -< error "fRelOp: cannot apply binary operator to given arguments."
i32WrapI64 = proc (Value v) -> case v of
(VI64 _) -> returnA -< valueI32
_ -> returnA -< error "i32WrapI64: cannot apply operator to given argument."
iTruncFU eCont = proc (bs1,bs2,x@(Value v)) -> case (bs1,bs2,v) of
(BS32, BS32, VF32 _) -> (returnA -< valueI32) <> (eCont -< (bs1,bs2,x))
(BS32, BS64, VF64 _) -> (returnA -< valueI32) <> (eCont -< (bs1,bs2,x))
(BS64, BS32, VF32 _) -> (returnA -< valueI64) <> (eCont -< (bs1,bs2,x))
(BS64, BS64, VF64 _) -> (returnA -< valueI64) <> (eCont -< (bs1,bs2,x))
_ -> returnA -< error "iTruncFU: cannot apply operator to given argument."
iTruncFS eCont = proc (bs1,bs2,x@(Value v)) -> case (bs1,bs2,v) of
(BS32, BS32, VF32 _) -> (returnA -< valueI32) <> (eCont -< (bs1,bs2,x))
(BS32, BS64, VF64 _) -> (returnA -< valueI32) <> (eCont -< (bs1,bs2,x))
(BS64, BS32, VF32 _) -> (returnA -< valueI64) <> (eCont -< (bs1,bs2,x))
(BS64, BS64, VF64 _) -> (returnA -< valueI64) <> (eCont -< (bs1,bs2,x))
_ -> returnA -< error "iTruncFS: cannot apply operator to given argument."
i64ExtendSI32 = proc (Value v) -> case v of
(VI32 _) -> returnA -< valueI64
_ -> returnA -< error "i64ExtendSI32: cannot apply operator to given argument."
i64ExtendUI32 = proc (Value v) -> case v of
(VI32 _) -> returnA -< valueI64
_ -> returnA -< error "i64ExtendUI32: cannot apply operator to given argument."
fConvertIU = proc (bs1,bs2,Value v) -> case (bs1,bs2,v) of
(BS32, BS32, VI32 _) -> returnA -< valueF32
(BS32, BS64, VI64 _) -> returnA -< valueF32
(BS64, BS32, VI32 _) -> returnA -< valueF64
(BS64, BS64, VI64 _) -> returnA -< valueF64
_ -> returnA -< error "fConvertIU: cannot apply operator to given argument."
fConvertIS = proc (bs1,bs2,Value v) -> case (bs1,bs2,v) of
(BS32, BS32, VI32 _) -> returnA -< valueF32
(BS32, BS64, VI64 _) -> returnA -< valueF32
(BS64, BS32, VI32 _) -> returnA -< valueF64
(BS64, BS64, VI64 _) -> returnA -< valueF64
_ -> returnA -< error "fConvertIS: cannot apply operator to given argument."
f32DemoteF64 = proc (Value v) -> case v of
(VF64 _) -> returnA -< valueF32
_ -> returnA -< error "f32DemoteF64: cannot apply operator to given argument."
f64PromoteF32 = proc (Value v) -> case v of
(VF32 _) -> returnA -< valueF64
_ -> returnA -< error "f64PromoteF32: cannot apply operator to given argument."
iReinterpretF = proc (bs,Value v) -> case (bs,v) of
(BS32, VF32 _) -> returnA -< valueI32
(BS64, VF64 _) -> returnA -< valueI64
_ -> returnA -< error "iReinterpretF: cannot apply operator to given argument."
fReinterpretI = proc (bs,Value v) -> case (bs,v) of
(BS32, VI32 _) -> returnA -< valueF32
(BS64, VI64 _) -> returnA -< valueF64
_ -> returnA -< error "fReinterpretI: cannot apply operator to given argument."
listLookup sCont eCont = proc (Value v,xs,x) -> case v of
(VI32 _) -> do
(joinList1'' (proc (x,()) -> sCont -< x) -< (xs,())) <> (eCont -< x)
_ -> returnA -< error "listLookup: cannot apply operator to given arguments."
deriving instance ArrowComplete () c => ArrowComplete () (ValueT v c)
deriving instance ArrowComplete v c => ArrowComplete v (ValueT v c)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment