how can I get a listing of everything that's done in a program

Peter Hercek phercek at gmail.com
Thu Oct 22 06:52:25 EDT 2009


Simon Marlow wrote:
> On 20/10/2009 14:54, Ralph Crawford wrote:
>> So far so good.  This is what I want to see - a listing like this for
>> every (interpreted of course) line of haskell code that runs, all the
>> way to the end.  Since this is a very large program, at this point I
>> started pasting this to the terminal - 4 steps at a time...
>>
>> :step
>> :step
>> :step
>> :step
>>
>> This gave me the listing I wanted.  But after a certain point, it
>> inevitably fails with a core dump, and what I capture from the screen is
>> garbled up to that point anyway.  I'm hoping there's a simpler way to do
>> this.  Thanks for taking the time to read this.
>
> If you get a core dump, that's obviously a bug.  If you can supply us 
> with a small program that illustrates the bug, please submit a bug 
> report at
>
> http://hackage.haskell.org/trac/ghc/wiki/ReportABug
>
> As for getting a list of the evaluation steps, we don't have anything 
> that does exactly what you want at the moment, but it probably 
> wouldn't be hard to implement on top of the existing debugging 
> functionality. 

If you want to execute one command more times you can do it by scripting 
ghci. Add something like this to your ~/.ghci file:

:{
let
{ cmdHlp _ msg longMsg "--help" =
    let fullMsg = if null longMsg then msg++"\n" else msg ++ 
('\n':longMsg) in
    return $ "putStr "++show fullMsg
; cmdHlp _ msg _ "-h" = return $ "putStrLn "++show msg
; cmdHlp action _ _ args = action args }
:}
:{
:def * cmdHlp
  ( \cntCmd ->
    case break Data.Char.isSpace cntCmd of {
      ( cnt, _:cmd ) -> return $unlines $replicate (read cnt) cmd ;
      _ -> return "putStrLn \"usage: :* <count> <cmd>...\"" } )
  ":* <count> <cmd>...       -- run <cmd> <count> times" ""
:}


Then you can use it like this:

% ghci
GHCi, version 6.10.4: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.
Prelude> :* -h
:* <count> <cmd>...       -- run <cmd> <count> times
Prelude> :* --help
:* <count> <cmd>...       -- run <cmd> <count> times
Prelude> :* 3 :type sqrt 2
sqrt 2 :: (Floating t) => t
sqrt 2 :: (Floating t) => t
sqrt 2 :: (Floating t) => t
Prelude> :quit
Leaving GHCi.
%

More information about ghci scripting:
http://www.haskell.org/pipermail/haskell-cafe/2007-September/032260.html

More examples of how can you script ghci:
http://permalink.gmane.org/gmane.comp.lang.haskell.glasgow.user/16912

Peter.



More information about the Glasgow-haskell-users mailing list