diff options
| author | Matthew Hall <hallmatthew314@gmail.com> | 2023-02-18 16:22:54 +1300 |
|---|---|---|
| committer | Matthew Hall <hallmatthew314@gmail.com> | 2023-02-18 16:22:54 +1300 |
| commit | f8a928d18371e0b67741f5d75b8154d1c105327b (patch) | |
| tree | 78853084e99e2a0cc7fbc0112ef9c7010ec53e1e /DSL/Interpretation.hs | |
| parent | 69276220df02d2c226021d79ee4a4fd173ae85ee (diff) | |
Introduce procs
Diffstat (limited to 'DSL/Interpretation.hs')
| -rw-r--r-- | DSL/Interpretation.hs | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/DSL/Interpretation.hs b/DSL/Interpretation.hs index a53be8b..e02bc74 100644 --- a/DSL/Interpretation.hs +++ b/DSL/Interpretation.hs @@ -7,7 +7,7 @@ import DSL.Util import DSL.Intrinsics newMachine :: Machine -newMachine = Machine { ok=True, stack=[] } +newMachine = Machine { ok=True, stack=[], pTable=[] } pushData :: Machine -> StackData -> Machine pushData m@Machine{ stack=xs } x = m{ stack=x:xs } @@ -43,11 +43,18 @@ applyIntrinsic i m = do I_LESSTHAN -> lessThan I_GREATERTHAN -> greaterThan +applyCall :: ProcName -> Machine -> IO Machine +applyCall _ m@Machine{ ok=False } = return m +applyCall name m@Machine{ pTable=t } = case lookup name t of + Nothing -> hcf m $ "PROCCALL: undefined proc: " ++ name + Just bs -> evalBlocks bs m + applyOperation :: Machine -> Operation -> IO Machine -- take no action if a previous step failed applyOperation m@Machine{ ok=False } _ = return m applyOperation m (OpPushData x) = return $ pushData m x applyOperation m (OpIntrinsic i) = applyIntrinsic i m +applyOperation m (OpCall name) = applyCall name m applyLinear :: Machine -> [Operation] -> IO Machine applyLinear = foldlM applyOperation @@ -95,6 +102,6 @@ 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 (BWhile c b:bs) m = applyWhile c b m >>= evalBlocks bs -interpret :: Program -> IO () -interpret p = evalBlocks p newMachine >> return () +interpret :: ([ProcSpec], Program) -> IO () +interpret (t, p) = evalBlocks p newMachine{ pTable=t } >> return () |