module WinDll.Debug.Stack
( Stack()
, Stackable(..)
, FunctionName
, emptyStack
, pushStack
, topStack
, popStack
, newStack
, sizeStack
, shrinkStack
, printStack
) where
import System.FilePath
import Data.Data
import Data.Typeable
type FunctionName = String
data Stack = Empty
| Then FunctionName Stack
| Combined Stack Stack
| Recursed Stack Stack
deriving (Typeable, Data, Eq, Show, Read, Ord)
class Show a => Stackable a where
toStack :: a -> Stack
instance Stackable Stack where
toStack = id
instance Stackable String where
toStack = newStack
printStack :: Stack -> String
printStack Empty = []
printStack (Then fn s) = printStack s </> ";" </> fn </> ";"
printStack (Combined s1 s2) = printStack s2 </> printStack s1
printStack (Recursed s1 s2) = printStack s2 </> printStack s1 </> "..."
emptyStack :: Stack
emptyStack = Empty
newStack :: FunctionName -> Stack
newStack fn = pushStack Empty fn
pushStack :: Stackable st => st -> FunctionName -> Stack
pushStack = flip Then . toStack
popStack :: Stack -> Stack
popStack Empty = error "An empty stack cannot be popped"
popStack (Then _ s) = s
popStack (Combined s1 s2) = Combined (popStack s1) s2
popStack (Recursed s1 s2) = Recursed (popStack s1) s2
topStack :: Stack -> Maybe FunctionName
topStack Empty = Nothing
topStack (Then fn s) = Just fn
topStack (Combined s1 s2) = topStack s1
topStack (Recursed s1 s2) = topStack s1
sizeStack :: Stack -> Int
sizeStack Empty = 0
sizeStack (Then _ s) = 1 + sizeStack s
sizeStack (Combined s1 s2) = sizeStack s1 + sizeStack s2
sizeStack (Recursed s1 s2) = sizeStack s1 + sizeStack s2
shrinkStack :: Stack -> Stack
shrinkStack = id