On 14/03/12 22:32, Ranjit Jhala wrote:
Dear Simon,

I am indeed using the GHC API -- to crunch .hs source to CoreExpr,
which I then walk over to generate refinement type constraints and
so on.

In the past (with GHC 7.04) I *was* able to do some profiling -- to
hunt down a space leak. However, perhaps at that time I was not using
hscCompileCoreExpr but something else? However, it could also be
something silly like me not having built 7.4.1 with profiling support?

Specifically, here's I think, the key bits of GHC API code I'm using
(from the link you sent, I suspect 2 is the problem) but any clues
will be welcome!

1. To extract the mod_guts from the file "fn"

getGhcModGuts1 :: (GhcMonad m) =>  FilePath ->  m ModGuts
getGhcModGuts1 fn = do
    liftIO $ deleteBinFiles fn
    target<- guessTarget fn Nothing
    addTarget target
    load LoadAllTargets
    modGraph<- depanal [] True
    case find ((== fn) . msHsFilePath) modGraph of
      Just modSummary ->  do
        mod_guts<- coreModule `fmap` (desugarModule =<<  typecheckModule =<<  
parseModule modSummary)
        return mod_guts

2. To convert a raw string (e.g. "map" or "zipWith" to the corresponding Name 
inside GHC)
    I suspect this is the bit that touches the Ghci code -- because thats where 
I extracted
    it from -- Is this what is causing the problem?

stringToNameEnv :: HscEnv ->  String ->  IO Name
stringToNameEnv env s
     = do L _ rn<- hscParseIdentifier env s
          (_, lookupres)<- tcRnLookupRdrName env rn
          case lookupres of
            Just (n:_) ->  return n
            _          ->  errorstar $ "Bare.lookupName cannot find name for: " 
++ s

The code in (2) doesn't reach hscCompileCoreExpr. In (1), the only way to get to hscCompileCoreExpr is by compiling a module that contains some Template Haskell or quasiquotes. Could that be the case? (the reason is that TH and QQ both need to compile some code and run it on the fly, which requires the interpreter, which is the bit that doesn't work with profiling).

Cheers,
        Simon






On Mar 14, 2012, at 3:59 AM, Simon Marlow wrote:

On 13/03/2012 21:25, Ranjit Jhala wrote:
Hi all,

I'm trying to use the nifty backtracing mechanism in GHC 74.
AFAICT, this requires everything be built with profiling on),
but as a consequence, I hit this:

        "You can't call hscCompileCoreExpr in a profiled compiler"

Any hints on whether there are work-arounds?

Can you give more details about what you're trying to do?  Are you using the 
GHC API in some way?

I'm afraid there's something of a deep limitation in that the interpreter that 
is used by GHCi and Template Haskell doesn't work with profiling:

  http://hackage.haskell.org/trac/ghc/ticket/3360

We think it is quite a lot of work to fix this.

Cheers,
        Simon



_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

Reply via email to