blob: ee4685ebf9ab50c8992090cd53fa932f5ec7f954 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
module LTypes where
import Control.Monad.Except
import Data.Map (Map)
import qualified Data.Map as M
import Utils
data LWord
= LSymbol String
| LInteger Integer
| LFloat Double
| LBool Bool
| LChar Char
| LLabel String
| LStringLitRef String
| LPhrase [LWord]
deriving (Show, Eq)
reprWord :: LWord -> String
reprWord (LSymbol a) = a
reprWord (LInteger a) = show a
reprWord (LFloat a) = show a
reprWord (LBool a) = show a
reprWord (LChar a) = show a
reprWord (LLabel a) = a
reprWord (LStringLitRef a) = "StrLit(" ++ a ++ ")"
reprWord (LPhrase a) = "P[ " ++ map reprWord a $> unwords ++ " ]"
data LState = LState
{ lDict :: Map String LWord,
lStack :: [LWord],
lPhraseDepth :: Int,
lDefs :: Map String [LWord],
lSource :: [LWord],
lStrLitRefMap :: Map String [LWord]
}
deriving (Show)
data Config = Config
{ configFileNameM :: Maybe String,
configDebugMode :: Bool
}
data ExecStep = ExecContinue | ExecExit
debugState Config {configDebugMode = mode} state =
if mode
then do
putStrLn $ "stack: " ++ unwords (map reprWord (lStack state))
putStrLn $ "source: " ++ unwords (map reprWord (lSource state))
putStrLn $ "defs: " ++ unwords (M.keys (lDefs state))
putStrLn $ "dict: " ++ unwords (M.keys (lDict state))
putStrLn $ "lPhraseDepth: " ++ show (lPhraseDepth state)
putStrLn ""
else pure ()
newtype LException = LException String
|
