aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-02-11 12:27:41 -0500
committerAlec Theriault <alec.theriault@gmail.com>2019-03-29 12:11:56 -0700
commit3efdc3a8da642d5d76b2c3f10a22f0503f65456a (patch)
tree31346880aef210cae45005037c40af8ce15257ed /haddock-api/src/Haddock/Backends
parentae23b4f25a972620686617b5aab5375d5046b1c9 (diff)
Remove workaround for now-fixed Clang CPP bug (#1028)
Before LLVM 6.0.1 (or 10.0 on Apple LLVM), there was a bug where lines that started with an octothorpe but turned out not to lex like pragmas would have an extra line added after them. Since this bug has been fixed upstream and that it doesn't have dire consequences anyways, the workaround is not really worth it anymore - we can just tell people to update their clang version (or re-structure their pragma code).
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs47
2 files changed, 3 insertions, 48 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 5ef7d9bb..251c886b 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -25,7 +25,6 @@ import FastString ( mkFastString )
import Module ( Module, moduleName )
import NameCache ( initNameCache )
import UniqSupply ( mkSplitUniqSupply )
-import SysTools.Info ( getCompilerInfo' )
-- | Generate hyperlinked source for given interfaces.
@@ -62,12 +61,11 @@ ppHyperlinkedModuleSource srcdir pretty srcs iface = case ifaceHieFile iface of
, hie_types = types
, hie_hs_src = rawSrc
} <- fmap fst (readHieFile (initNameCache u []) hfp)
- comp <- getCompilerInfo' df
-- Get the AST and tokens corresponding to the source file we want
let mast | M.size asts == 1 = snd <$> M.lookupMin asts
| otherwise = M.lookup (mkFastString file) asts
- tokens = parse comp df file rawSrc
+ tokens = parse df file rawSrc
-- Produce and write out the hyperlinked sources
case mast of
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 1d5576cc..0bd467e1 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -6,13 +6,9 @@ import Control.Applicative ( Alternative(..) )
import Data.List ( isPrefixOf, isSuffixOf )
import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BSC
-
-import GHC.LanguageExtensions.Type
import BasicTypes ( IntegralLit(..) )
import DynFlags
-import qualified EnumSet as E
import ErrUtils ( emptyMessages )
import FastString ( mkFastString )
import Lexer ( P(..), ParseResult(..), PState(..), Token(..)
@@ -29,12 +25,11 @@ import Haddock.GhcUtils
-- Result should retain original file layout (including comments,
-- whitespace, and CPP).
parse
- :: CompilerInfo -- ^ Underlying CC compiler (whatever expanded CPP)
- -> DynFlags -- ^ Flags for this module
+ :: DynFlags -- ^ Flags for this module
-> FilePath -- ^ Path to the source of this module
-> BS.ByteString -- ^ Raw UTF-8 encoded source of this module
-> [T.Token]
-parse comp dflags fpath bs = case unP (go False []) initState of
+parse dflags fpath bs = case unP (go False []) initState of
POk _ toks -> reverse toks
PFailed _ ss errMsg -> panic $ "Hyperlinker parse error at " ++ show ss ++
": " ++ showSDoc dflags errMsg
@@ -43,7 +38,6 @@ parse comp dflags fpath bs = case unP (go False []) initState of
initState = mkPStatePure pflags buf start
buf = stringBufferFromByteString bs
start = mkRealSrcLoc (mkFastString fpath) 1 1
- needPragHack' = needPragHack comp dflags
pflags = mkParserFlags' (warningFlags dflags)
(extensionFlags dflags)
(thisPackage dflags)
@@ -125,12 +119,6 @@ parse comp dflags fpath bs = case unP (go False []) initState of
pure (bEnd'', False)
- -- See 'needPragHack'
- ITclose_prag{}
- | needPragHack'
- , '\n' `BSC.elem` spaceBStr
- -> getInput >>= \(b,p) -> setInput (b,advanceSrcLoc p '\n') >> pure (bEnd, False)
-
_ -> pure (bEnd, inPragDef)
let tokBStr = splitStringBuffer bStart bEnd'
@@ -155,37 +143,6 @@ parse comp dflags fpath bs = case unP (go False []) initState of
pure ([unkTok], False)
--- | This is really, really, /really/ gross. Problem: consider a Haskell
--- file that looks like:
---
--- @
--- {-# LANGUAGE CPP #-}
--- module SomeMod where
---
--- #define SIX 6
---
--- {-# INLINE foo
--- #-}
--- foo = 1
--- @
---
--- Clang's CPP replaces the @#define SIX 6@ line with an empty line (as it
--- should), but get confused about @#-}@. I'm guessing it /starts/ by
--- parsing that as a pre-processor directive and, when it fails to, it just
--- leaves the line alone. HOWEVER, it still adds an extra newline. =.=
---
--- This function makes sure that the Hyperlinker backend also adds that
--- extra newline (or else our spans won't line up with GHC's anymore).
-needPragHack :: CompilerInfo -> DynFlags -> Bool
-needPragHack comp dflags = isCcClang && E.member Cpp (extensionFlags dflags)
- where
- isCcClang = case comp of
- GCC -> False
- Clang -> True
- AppleClang -> True
- AppleClang51 -> True
- UnknownCC -> False
-
-- | Get the input
getInput :: P (StringBuffer, RealSrcLoc)
getInput = P $ \p @ PState { buffer = buf, loc = srcLoc } -> POk p (buf, srcLoc)