aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-02-11 12:27:41 -0500
committerGitHub <noreply@github.com>2019-02-11 12:27:41 -0500
commit9790200cb854b75e00afaf2eea49a22b7223b200 (patch)
tree0652623398095f3eaaeb30845c877785a342452a /haddock-api/src
parent4e8321de13225f1f5bdec8f39993e9b1aa0831a8 (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')
-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)