[Haskell-cafe] Code snippet, a `trace' with line and column numbers

Donald Bruce Stewart dons at cse.unsw.edu.au
Tue Feb 28 23:02:17 EST 2006


Suggested by a question from sethk on #haskell irc channel. 
Solves an FAQ where people have often resorted to cpp or m4:
a `trace' that prints line numbers.    

> module Location (trace, assert) where
> 
> import qualified Control.Exception as C (catch)
> import System.IO.Unsafe  (unsafePerformIO)
> import GHC.Base          (assert)
> import System.IO
> 
> -- An identity function that also prints the current line and column number
> trace :: (Bool -> IO () -> IO ()) -> a -> a
> trace assrt f = (unsafePerformIO $ C.catch (assrt False $ return ()) printIt) `seq` f
>     where 
>       printIt e = let (x,_) = break (== ' ') $ show e 
>                   in hPutStrLn stderr (x ++ " trace")

for example:

> import Location
> 
> main = do
>     let x = trace assert (1+2) 
> 
>     putStrLn . show $ x

Generates:

$ ./a.out 
M.hs:4:18-23: trace
3

This continues a theme I've noticed: catching internal exceptions can yield
some interesting results, i.e. with undefined, missing class methods, and here,
assertion failures.

Hope this little thing is useful.

Cheers,
   Don


More information about the Haskell-Cafe mailing list