Monad.lhs

> {-# LANGUAGE FlexibleInstances #-}

> module Curry.Debugger.Tools.Debug.Monad where

> import Curry.Debugger.DebugMonad
> import Curry.Debugger.ShowTerm
> import Control.Monad.State


> instance MonadIO m => DM (DMT Int m) where

>   hook hookType di call = do
>     let args = currentValues (dynamicInfo di)
>     level <- getToolState
>     oracle <- getOracle
>     let oracleInfo = format 4 (show oracle)
>     liftIO $ putStrLn (oracleInfo ++ (replicate level ' ') ++ showHook hookType args)
>     putToolState (level + 1)
>     result <- call
>     putToolState level
>     return result

> format :: Int -> String -> String
> format n [] | n < 0     = []
>             | otherwise = format (n-1) [] ++ " "
> format n (c:cs)         = c : format (n-1) cs

> showHook :: Hook -> [Term] -> String
> showHook (FuncCallHook name) args = "FuncCallHook " ++ showHookSignature name args
> showHook (FuncDeclHook name) args = "FuncDeclHook " ++ showHookSignature name args
> showHook hook                args = showHookSignature (show hook) args

> showHookSignature :: String -> [Term] -> String
> showHookSignature name args =
>   name ++ " " ++ showedArgs
>     where
>       showedArgs = concatMap (\ t -> showTerm t ++ " ") args

> run :: GenTerm a => DMT Int IO a -> String -> IO a
> run exp steps = do
>            putStrLn $ "starting strict evaluation"
>            result <- debugDMT exp steps 0
>            printTerm result
>            putStrLn "\nstrict evaluation finished"
>            return result