Preprocessor bug in 7.4.1

["Philip K. F. Hölzenspies"]

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

There you go ;)

Ph.


On 4 Jun 2012, at 17:21, Simon Peyton-Jones wrote:

> Could you perhaps file a ticket with a small reproducible test case?  Thanks!
> 
> Simon
> 
> | -----Original Message-----
> | From: cvs-ghc-bounces at haskell.org [mailto:cvs-ghc-bounces at haskell.org]
> | On Behalf Of "Philip K. F. Hölzenspies"
> | Sent: 01 June 2012 00:19
> | To: cvs-ghc at haskell.org
> | Subject: Preprocessor bug in 7.4.1
> | 
> | Dear GHCers,
> | 
> | I believe I have found a preprocessor bug in GHC 7.4.1. This bug may
> | persist in HEAD; I have not yet been able to try it. I'm using the
> | purely functional parser from the GHC-API and was parsing
> | ./compiler/prelude/PrimOp.lhs. My sources are included below. I found
> | that some of the SrcSpan annotations in the AST were wrong. More
> | specifically, there was an unexplained jump in the line numbers. A
> | fragment from (showSDocDebug . ppr) was as follows:
> | 
> | 
> | START_SNIPPET
> |         where
> |             tc{v}
> |             tc{v}
> |               = {../clonedghc/compiler/prelude/PrimOp.lhs:532:33-48}
> |                 tyConAppTyCon{v} ty{v}
> |             <> }
> | <>
> | {../clonedghc/compiler/prelude/PrimOp.lhs:577:1-61}
> | dyadic_fun_ty{v}, compare_fun_ty{v}, monadic_fun_ty{v} ::
> |   {../clonedghc/compiler/prelude/PrimOp.lhs:577:50-61}
> |   Type{tc} -> Type{tc}
> | END_SNIPPET
> | 
> | 
> | Note the jump from line 532 to 577. The corresponding fragment from
> | PrimOp.lhs (lines 532-552) was as follows:
> | 
> | 
> | START_SNIPPET
> |                            tc = tyConAppTyCon ty
> |                         -- All primops return a tycon-app result
> |                         -- The tycon can be an unboxed tuple, though,
> | which
> |                         -- gives rise to a ReturnAlg \end{code}
> | 
> | We do not currently make use of whether primops are commutable.
> | 
> | We used to try to move constants to the right hand side for strength
> | reduction.
> | 
> | \begin{code}
> | {-
> | commutableOp :: PrimOp -> Bool
> | #include "primop-commutable.hs-incl"
> | -}
> | \end{code}
> | 
> | Utils:
> | \begin{code}
> | dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type
> | END_SNIPPET
> | 
> | 
> | Both CPP and Unlit are required on this source file. It seems CPP
> | expands the #include and then Unlit ignores the line with the line
> | number restoration at the end of that include ('# 547
> | "path/to/PrimOp.lhs" 2'), because the entire block sits within {- -}.
> | When either removing the #, or the {- and -}, the line numbers in the
> | SrcSpan annotations are correct.
> | 
> | I hope this is a useful bug report.
> | 
> | Regards,
> | Philip
> | 
> | 
> | PS. You may note in the code that I did not include Opt_RankNTypes,
> | which is required by many sources in the GHC source tree. For some
> | reason, setting this flag using xopt_set did not work. Setting
> | Opt_BangPatterns does work (i.e. parsing fails without and succeeds
> | with). Adding LANGUAGE pragmas to the files did solve the problem. Oddly
> | enough, the error message did include 67 (== fromEnum Opt_RankNTypes) in
> | the list after the ***> (see below). Not sure I completely understand
> | the flag mechanisms (OnOff et al).
> | 
> | 
> | 
> | Functions used:
> | 
> | 
> | getDefaultEnv :: FilePath -> IO HscEnv
> | getDefaultEnv root = defaultErrorHandler defaultLogAction $ runGhc (Just
> | libdir) $ do
> | 	f <- getSessionDynFlags
> | 	setSessionDynFlags $ L.foldl xopt_set
> | 		f { includePaths = includePaths f ++ L.map (root ++)
> | ["/compiler","/compiler/stage2"] }
> | 		[Opt_Cpp,Opt_UnboxedTuples,Opt_MagicHash,Opt_BangPatterns]
> | 	getSession
> | 
> | classifyFile :: FilePath -> Maybe (HscSource -> Phase, HscSource)
> | classifyFile f = case reverse . takeWhile (/= '.') . reverse $ f of
> | 	"lhs-boot" -> Just (Unlit, HsBootFile)
> | 	"hs-boot"  -> Just (Cpp,   HsBootFile)
> | 	"lhs"      -> Just (Unlit, HsSrcFile )
> | 	"hs"       -> Just (Cpp,   HsSrcFile )
> | 	_ -> Nothing
> | 
> | parseFile :: FilePath -> FilePath -> IO (Maybe (String, Located
> | (HsModule RdrName))) parseFile root fn = do
> | 	putStrLn "getDefaultEnv"
> | 	env      <- getDefaultEnv root
> | 	defaultErrorHandler defaultLogAction $ runGhc (Just libdir) $
> | setSessionDynFlags (hsc_dflags env)
> | 	putStrLn "preprocess"
> | 	(df,fn') <- preprocess env (fn, uncurry ($) <$> classifyFile fn)
> | 	putStrLn "readFile"
> | 	cnt      <- readFile fn'
> | 	putStrLn "removeFile"
> | 	removeFile fn'
> | 	putStrLn "parseFile'"
> | 	fmap ((,) cnt) <$> parseFile' df fn cnt
> | 
> | parseFile' :: DynFlags -> FilePath -> String -> IO (Maybe (Located
> | (HsModule RdrName))) parseFile' df fn cnt = either displayErrors
> | displayWarnings $ parser cnt df fn
> | 	where
> | 	displayErrors es = do
> | 		printBagOfErrors df es
> | 		putStrLn (fn ++ "  ***>  " ++ show (extensionFlags df))
> | 		return Nothing
> | 	displayWarnings (ws,r) = do
> | 		mapBagM_ (\w -> putStrLn (" -- Warning: " ++ show w)) ws
> | 		return . Just . everywhere mkSafe $ r
> | 
> | 
> | _______________________________________________
> | Cvs-ghc mailing list
> | Cvs-ghc at haskell.org
> | http://www.haskell.org/mailman/listinfo/cvs-ghc
> 
> 

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/cvs-ghc/attachments/20120605/9409886b/attachment.htm>