Question: template-haskell and profiling

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'

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"
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@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

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.htm...
Best,
-Judah
On 4/27/07, Robin Green
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"
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@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (3)
-
ET
-
Judah Jacobson
-
Robin Green