[Haskell-cafe] Question: template-haskell and profiling

Judah Jacobson judah.jacobson at gmail.com
Fri Apr 27 11:31:51 EDT 2007


Alternately, the "standard" way to use profiling with template haskell
is a 2-stage process:
- First, compile all of the modules normally, *without* -prof
- Then, compile all of the module again, with the following flags:
-prof -osuf p_o

These steps, and the reason this workaround is necessary, are
documented in the GHC user manual (section 7.6.4):
http://www.haskell.org/ghc/docs/latest/html/users_guide/template-haskell.html#id3154592

Best,
-Judah


On 4/27/07, Robin Green <greenrd at greenrd.org> wrote:
> As a workaround, you could try to use zeroTH to preprocess the template
> haskell. (I have a patched version of zeroTH that works better but it
> currently requires a patched version of GHC - ask me if you want it.)
>
> ZeroTH darcs repo: http://darcs.haskell.org/~lemmih/zerothHead/
> Original announcement by Lemmih:
> http://permalink.gmane.org/gmane.comp.lang.haskell.template/219
> --
> Robin
>
> On Fri, 27 Apr 2007 20:26:21 +0700
> "ET" <equipment at ngs.ru> wrote:
>
> > Hi, folks
> >
> > Trying to profile the modules, those contain a template-haskell
> > splices, I have ran into problem - GHC6.4 (win2K) returns an error
> > message and then stops. Without the "-prof" option all works fine.
> >
> > Is there a way to bypass this inconsistency?
> >
> >
> > Example below illustrates the problem:
> >
> > ============================
> >
> > {-# OPTIONS_GHC -fth #-}
> > module Main where
> >
> > import MainTH
> >
> > main :: IO ()
> > main = putStrLn . show . fact $ 100
> >
> > fact :: Integer -> Integer
> > fact n = $(thFact "n")
> >
> > ============================
> >
> > module MainTH where
> >
> > import Language.Haskell.TH
> >
> > thFact :: String -> ExpQ
> > thFact s =  appE (dyn "product")
> >   (arithSeqE (fromToR (litE . integerL $ 1) (dyn s)))
> >
> > preview :: IO ()
> > preview = runQ (thFact "x") >>= putStrLn . pprint
> >
> > ============================
> >
> > >ghc --make -prof Main.hs
> > Chasing modules from: Main.hs
> > Compiling MainTH           ( ./MainTH.hs, ./MainTH.o )
> > Compiling Main             ( Main.hs, Main.o )
> > Loading package base-1.0 ... linking ... done.
> > Loading package haskell98-1.0 ... linking ... done.
> > Loading package template-haskell-1.0 ... linking ... done.
> > ghc:
> > ./MainTH.o: unknown symbol `_era'
> >
> > With function "MainTH.preview" excluded from export list, final
> > phrase were ghc:
> > ./MainTH.o: unknown symbol `_entering_PAP'
> >
> >
> >
> >
> >
> > _______________________________________________
> > Haskell-Cafe mailing list
> > Haskell-Cafe at haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list