panic parsing a stmt in ghc 7 (possible regression?)
Daniel Gorín
dgorin at dc.uba.ar
Mon Jan 31 22:55:38 CET 2011
Hi
I'm trying to make the hint library work also with ghc 7 and I'm having problems with some test-cases that are now raising exceptions. I've been able to reduce the problem to a small example. The program below runs ghc in interpreter-mode and attempts to parse an statement using ghc's parseStmt function; the particular statement is a let-expression with a \n in the middle. The observed behaviour is:
> $ ghc-6.12.1 -fforce-recomp --make -package ghc -cpp -Wall d.hs && ./d
> [1 of 1] Compiling Main ( d.hs, d.o )
> Linking d ...
> let {e = let x = ()
> in x ;} in e
> Ok
> $ ghc-7.0.1 -fforce-recomp --make -package ghc -cpp -Wall d.hs && ./d
> [1 of 1] Compiling Main ( d.hs, d.o )
> Linking d ...
> let {e = let x = ()
> in x ;} in e
> d: d: panic! (the 'impossible' happened)
> (GHC version 7.0.1 for i386-apple-darwin):
> srcLocCol <no location info>
>
> Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
Is it a regression or should I be doing this some other way?
Thanks,
Daniel
-- d.hs
import qualified GHC
import qualified MonadUtils as GHC ( liftIO )
import qualified StringBuffer as GHC
import qualified Lexer as GHC
import qualified Parser as GHC
import qualified GHC.Paths
main :: IO ()
main = GHC.runGhcT (Just GHC.Paths.libdir) $ do
-- initialize
df0 <- GHC.getSessionDynFlags
_ <- GHC.setSessionDynFlags df0{GHC.ghcMode = GHC.CompManager,
GHC.hscTarget = GHC.HscInterpreted,
GHC.ghcLink = GHC.LinkInMemory,
GHC.verbosity = 0}
df1 <- GHC.getSessionDynFlags
-- runParser
let expr = "let {e = let x = ()\nin x ;} in e"
GHC.liftIO $ putStrLn expr
buf <- GHC.liftIO $ GHC.stringToStringBuffer expr
let p_res = GHC.unP GHC.parseStmt (mkPState df1 buf GHC.noSrcLoc)
case p_res of
GHC.POk{} -> GHC.liftIO $ putStrLn "Ok"
GHC.PFailed{} -> GHC.liftIO $ putStrLn "Failed"
where
#if __GLASGOW_HASKELL__ >= 700
mkPState = GHC.mkPState
#else
mkPState = \a b c -> GHC.mkPState b c a
#endif
More information about the Glasgow-haskell-users
mailing list