Commit a8064fca11951ed6396f129b116a36ff2e7a9984 - Burro

Improve debugger visualization, again. Chris Pressey a month ago

1 changed file(s) with 31 addition(s) and 30 deletion(s). Raw diff Collapse all Expand all

+31

-30

src/Language/Burro/Debugger.hs less more

6	6	import Control.Monad.Trans.State (StateT, evalStateT, get, put, modify)
7	7	import Control.Monad.IO.Class
8	8	import System.Environment
	9
9	10	import Language.Burro.Definition hiding (get, exec, run, interpret)
10	11	import qualified Language.Burro.Definition as Burro
11	12
	13
12	14	-- Debugger state containing indentation level, tape position and Burro state
13	15	data DebugState = DebugState {
14		indentLevel :: Int,
	16	indents :: [String],
15	17	tapePos :: Integer,
16	18	burroState :: State
17	19	}

23	25	x \| x >= 0 -> str ++ (replicate x ' ')
24	26	_ -> str
25	27
26		indentation :: Int -> String
27		indentation n = replicate (n * 4) ' '
	28	-- \| Visualize the current execution state of the Burro program in a readable way.
	29	dump :: Burro -> DebuggerM ()
	30	dump p = do
	31	ds <- get
	32	liftIO $ putStrLn $ showState (burroState ds) (tapePos ds) (indents ds) p
28	33
29		-- \| Visualize the current execution state of the Burro program in a readable way.
30		dump :: Burro -> String -> DebuggerM ()
31		dump p msg = do
32		ds <- get
33		liftIO $ putStrLn $ showState (burroState ds) (tapePos ds) (indentLevel ds) p msg
34
35		showState (State tape stack halt) pos indent p msg =
	34	showState (State tape stack halt) pos indents p =
36	35	let
37	36	tapes = ljust 40 $ "(" ++ show tape ++ ")@" ++ show pos
38	37	stacks = ljust 20 $ "(" ++ show stack ++ ")"
39	38	halts = if halt then "[H]" else "[_]"
40		desc = indentation indent ++ show p ++ " " ++ msg
	39	desc = concat (map (\i -> i ++ " ") indents) ++ show p
41	40	in
42	41	tapes ++ stacks ++ " " ++ halts ++ " " ++ desc
43	42
44		withIndent :: DebuggerM a -> DebuggerM a
45		withIndent action = do
46		modify (\s -> s { indentLevel = indentLevel s + 1 })
	43	withIndent :: String -> DebuggerM a -> DebuggerM a
	44	withIndent x action = do
	45	modify (\s -> s { indents = (x:indents s) })
47	46	result <- action
48		modify (\s -> s { indentLevel = indentLevel s - 1 })
	47	modify (\s -> s { indents = tail $ indents s })
49	48	return result
50	49
51	50	exec :: Burro -> DebuggerM ()

55	54
56	55	exec Null = do
57	56	ds <- get
58		dump Null ""
	57	dump Null
59	58
60	59	exec ToggleHalt = do
61	60	ds <- get
62		dump ToggleHalt ""
	61	dump ToggleHalt
63	62	let State dat stack halt = burroState ds
64	63	let newState = State dat stack (not halt)
65	64	put ds { burroState = newState }
66	65
67	66	exec Inc = do
68	67	ds <- get
69		dump Inc ""
	68	dump Inc
70	69	let State dat stack halt = burroState ds
71	70	let newState = State (inc dat) stack halt
72	71	put ds { burroState = newState }
73	72
74	73	exec Dec = do
75	74	ds <- get
76		dump Dec ""
	75	dump Dec
77	76	let State dat stack halt = burroState ds
78	77	let newState = State (dec dat) stack halt
79	78	put ds { burroState = newState }
80	79
81	80	exec GoLeft = do
82	81	ds <- get
83		dump GoLeft ""
	82	dump GoLeft
84	83	let State dat stack halt = burroState ds
85	84	let newState = State (left dat) stack halt
86	85	modify (\s -> s { tapePos = tapePos s - 1, burroState = newState })
87	86
88	87	exec GoRight = do
89	88	ds <- get
90		dump GoRight ""
	89	dump GoRight
91	90	let State dat stack halt = burroState ds
92	91	let newState = State (right dat) stack halt
93	92	modify (\s -> s { tapePos = tapePos s + 1, burroState = newState })
94	93
95	94	exec p@(Test thn els) = do
96	95	ds <- get
97		dump p "[test]"
	96	dump p
98	97	let State dat stack halt = burroState ds
99	98	let x = Burro.get dat
100	99	let (dat', stack') = swap dat stack

102	101	let s' = State dat' stack'' halt
103	102	put ds { burroState = s' }
104	103
105		withIndent $
106		if x > 0 then do
107		dump thn "[then]"
	104	if x > 0 then
	105	withIndent "[then]" $ do
	106	dump thn
108	107	exec thn
109		else if x < 0 then do
110		dump els "[else]"
	108	else if x < 0 then
	109	withIndent "[else]" $ do
	110	dump els
111	111	exec els
112		else do
113		dump Null "[non]"
	112	else do
	113	withIndent "[non-]" $ do
	114	dump Null
114	115
115	116	ds' <- get
116	117	let State dat'' stack''' halt' = burroState ds'

135	136	interpret :: Burro -> IO ()
136	137	interpret program = do
137	138	let initialState = DebugState {
138		indentLevel = 0,
	139	indents = [],
139	140	tapePos = 0,
140	141	burroState = newstate
141	142	}