Commit 22fc028f authored by Katharina Brandl's avatar Katharina Brandl
Browse files

FIX: iBinOp accepts error continuation

parent b067baf1
Pipeline #125978 passed with stages
in 75 minutes and 29 seconds
......@@ -64,14 +64,14 @@ instance (ArrowChoice c) => IsVal Value (ValueT Value c) where
i32const = proc w32 -> returnA -< Value $ Wasm.VI32 w32
i64const = proc w64 -> returnA -< Value $ Wasm.VI64 w64
iBinOp = proc (bs,op,Value v1,Value v2) ->
iBinOp eCont = proc (bs,op,Value v1,Value v2) ->
case (bs,op,v1,v2) of
(BS32, IAdd, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< Just $ toVal32 $ val1 + val2
(BS32, IMul, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< Just $ toVal32 $ val1 * val2
(BS32, ISub, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< Just $ toVal32 $ val1 - val2
(BS64, IAdd, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< Just $ toVal64 $ val1 + val2
(BS64, IMul, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< Just $ toVal64 $ val1 * val2
(BS64, ISub, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< Just $ toVal64 $ val1 - val2
(BS32, IAdd, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< toVal32 $ val1 + val2
(BS32, IMul, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< toVal32 $ val1 * val2
(BS32, ISub, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< toVal32 $ val1 - val2
(BS64, IAdd, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< toVal64 $ val1 + val2
(BS64, IMul, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< toVal64 $ val1 * val2
(BS64, ISub, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< toVal64 $ val1 - val2
iRelOp = proc (bs,op,Value v1, Value v2) ->
case (bs,op,v1,v2) of
(BS32, IEq, Wasm.VI32 val1, Wasm.VI32 val2) ->
......
......@@ -130,7 +130,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 (BitSize, IBinOp, v, v) (Maybe v)
iBinOp :: 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
......@@ -575,10 +575,12 @@ evalNumericInst = proc i -> case i of
iUnOp -< (bs, op, v)
IBinOp bs op _ -> do
(v1,v2) <- pop2 -< ()
res <- iBinOp -< (bs, op, v1, v2)
case res of
Just v' -> returnA -< v'
Nothing -> throw <<< exception -< Trap $ printf "Binary operator %s failed on %s" (show op) (show (v1,v2))
iBinOp
(proc (op,v1,v2) -> throw <<< exception -< Trap $ printf "Binary operator %s failed on %s" (show op) (show (v1,v2)))
-< (bs, op, v1, v2)
-- case res of
-- Just v' -> returnA -< v'
-- Nothing -> throw <<< exception -< Trap $ printf "Binary operator %s failed on %s" (show op) (show (v1,v2))
I32Eqz _ -> do
v <- pop -< ()
i32eqz -< v
......
......@@ -38,14 +38,14 @@ instance (ArrowChoice c) => IsVal Value (ValueT Value c) where
i64const = proc _ -> returnA -< valueI64
f32const = proc _ -> returnA -< valueF32
f64const = proc _ -> returnA -< valueF64
iBinOp = proc (bs, op, Value v1, Value v2) ->
iBinOp eCont = proc (bs, op, Value v1, Value v2) ->
case (bs,op,v1,v2) of
(BS32, IAdd, VI32 _, VI32 _) -> returnA -< Just valueI32
(BS32, IMul, VI32 _, VI32 _) -> returnA -< Just valueI32
(BS32, ISub, VI32 _, VI32 _) -> returnA -< Just valueI32
(BS64, IAdd, VI64 _, VI64 _) -> returnA -< Just valueI64
(BS64, IMul, VI64 _, VI64 _) -> returnA -< Just valueI64
(BS64, ISub, VI64 _, VI64 _) -> returnA -< Just valueI64
(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
iRelOp = proc (bs,op,Value v1, Value v2) ->
case (bs,op,v1,v2) of
(BS32, IEq, VI32 _, VI32 _) -> returnA -< valueI32
......
......@@ -5,6 +5,7 @@ module UnitSpec where
import Abstract (BaseValue(..))
import qualified Concrete as Concrete
import qualified ConcreteInterpreter as Concrete
import qualified Data as D
import UnitAnalysis as U
import UnitAnalysisValue
import Soundness
......@@ -35,6 +36,8 @@ import qualified Language.Wasm.Interpreter as Wasm
import Language.Wasm.Structure
import Language.Wasm.Validate
import Numeric.Natural
import Test.Hspec
main :: IO ()
......@@ -118,8 +121,19 @@ spec = do
result <- runFunc "fact" "fac-rec" [Value $ VI64 ()]
let cfg = fst result
putStrLn (show cfg)
putStrLn $ graphToDot show cfg
putStrLn $ graphToDot showForGraph cfg
pending
showForGraph :: D.Instruction Natural -> String
showForGraph (D.I32Const i _) = "I32Const " ++ (show i)
showForGraph (D.I64Const i _) = "I64Const " ++ (show i)
showForGraph (D.GetLocal n _) = "GetLocal " ++ (show n)
showForGraph (D.IRelOp bs op _) = "IRelOp " ++ (show bs) ++ " " ++ (show op)
showForGraph (D.IBinOp bs op _) = "IBinOp " ++ (show bs) ++ " " ++ (show op)
showForGraph (D.Call i _) = "Call " ++ (show i)
showForGraph (D.If t _ _ _) = "If " ++ (show t)
-- it "run non-terminating" $ do
-- validMod <- readModule "test/samples/simple.wast"
-- Right (modInst, store) <- instantiate validMod
......
......@@ -9,7 +9,6 @@
(type $out-i32 (func (result i32)))
;; Recursive factorial
(func (export "const") (param i32) (result i32)
(get_local 0)
)
......@@ -30,6 +29,21 @@
(i32.add)
)
(func $fac-rec (export "fac-rec") (param i64) (result i64)
get_local 0
i64.const 0
i64.eq
(if (result i64)
(then
i64.const 1)
(else
get_local 0
get_local 0
i64.const 1
i64.sub
call $fac-rec
i64.mul)))
(func (export "half-fac") (param i32) (result i32)
(if (result i32) (i32.eq (get_local 0) (i32.const 0))
(then (i32.const 1))
......
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