diff options
Diffstat (limited to 'DSL/Interpretation.hs')
| -rw-r--r-- | DSL/Interpretation.hs | 24 |
1 files changed, 6 insertions, 18 deletions
diff --git a/DSL/Interpretation.hs b/DSL/Interpretation.hs index 02f741d..e68b64f 100644 --- a/DSL/Interpretation.hs +++ b/DSL/Interpretation.hs @@ -61,26 +61,15 @@ applyOperation m (OpCall name) = applyCall name m applyLinear :: Machine -> [Operation] -> IO Machine applyLinear = foldlM applyOperation -applyIf :: [Block] -> [Block] -> Machine -> IO Machine -applyIf _ _ m@Machine{ ok=False } = return m -applyIf c b m = do +applyIf :: [Block] -> [Block] -> [Block] -> Machine -> IO Machine +applyIf _ _ _ m@Machine{ ok=False } = return m +applyIf c t f m = do m' <- evalBlocks c m case m' of Machine{ ok=False } -> return m' Machine{ stack=[] } -> hcf m' "IF: stack underflow" - Machine{ stack=StackBool False:xs } -> return m'{ stack=xs } - Machine{ stack=StackBool True:xs } -> evalBlocks b m'{ stack=xs } - Machine{ stack=_:_ } -> hcf m' "IF: type mis-match" - -applyIfElse :: [Block] -> [Block] -> [Block] -> Machine -> IO Machine -applyIfElse _ _ _ m@Machine{ ok=False } = return m -applyIfElse c b1 b2 m = do - m' <- evalBlocks c m - case m' of - Machine{ ok=False } -> return m' - Machine{ stack=[] } -> hcf m' "IFELSE: stack underflow" - Machine{ stack=StackBool True:xs } -> evalBlocks b1 m'{ stack=xs } - Machine{ stack=StackBool False:xs } -> evalBlocks b2 m'{ stack=xs } + Machine{ stack=StackBool True:xs } -> evalBlocks t m'{ stack=xs } + Machine{ stack=StackBool False:xs } -> evalBlocks f m'{ stack=xs } Machine{ stack=_:_ } -> hcf m' "IF: type mis-match" applyWhile :: [Block] -> [Block] -> Machine -> IO Machine @@ -100,8 +89,7 @@ evalBlocks :: [Block] -> Machine -> IO Machine evalBlocks _ m@Machine{ ok=False } = return m evalBlocks [] m = return m evalBlocks (BLinear b:bs) m = applyLinear m b >>= evalBlocks bs -evalBlocks (BIf c b:bs) m = applyIf c b m >>= evalBlocks bs -evalBlocks (BIfElse c b1 b2:bs) m = applyIfElse c b1 b2 m >>= evalBlocks bs +evalBlocks (BIf c t f:bs) m = applyIf c t f m >>= evalBlocks bs evalBlocks (BWhile c b:bs) m = applyWhile c b m >>= evalBlocks bs interpret :: ([ProcSpec], Program) -> IO () |