aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Interface')
-rw-r--r--src/Haddock/Interface/Create.hs55
-rw-r--r--src/Haddock/Interface/LexParseRn.hs5
-rw-r--r--src/Haddock/Interface/ParseModuleHeader.hs1
3 files changed, 39 insertions, 22 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 4bb46cba..eef1e112 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections, BangPatterns #-}
+{-# OPTIONS_GHC -Wwarn #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Interface.Create
@@ -27,6 +28,7 @@ import Data.Maybe
import Data.Monoid
import Data.Ord
import Control.Applicative
+import Control.DeepSeq
import Control.Monad
import qualified Data.Traversable as T
@@ -48,13 +50,13 @@ import FastString (unpackFS)
createInterface :: TypecheckedModule -> [Flag] -> IfaceMap -> InstIfaceMap -> ErrMsgGhc Interface
createInterface tm flags modMap instIfaceMap = do
- let ms = pm_mod_summary . tm_parsed_module $ tm
- mi = moduleInfo tm
- safety = modInfoSafe mi
- mdl = ms_mod ms
- dflags = ms_hspp_opts ms
- instances = modInfoInstances mi
- exportedNames = modInfoExports mi
+ let ms = pm_mod_summary . tm_parsed_module $ tm
+ mi = moduleInfo tm
+ !safety = modInfoSafe mi
+ mdl = ms_mod ms
+ dflags = ms_hspp_opts ms
+ !instances = modInfoInstances mi
+ !exportedNames = modInfoExports mi
(TcGblEnv {tcg_rdr_env = gre, tcg_warns = warnings}, _) = tm_internals_ tm
@@ -72,13 +74,13 @@ createInterface tm flags modMap instIfaceMap = do
| Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0
| otherwise = opts0
- (info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader
+ (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader
let declsWithDocs = topDecls group_
(decls, _) = unzip declsWithDocs
localInsts = filter (nameIsLocalOrFrom mdl . getName) instances
- maps@(docMap, argMap, subMap, declMap) <-
+ maps@(!docMap, !argMap, !subMap, !declMap) <-
liftErrMsg $ mkMaps dflags gre localInsts declsWithDocs
let exports0 = fmap (reverse . map unLoc) mayExports
@@ -92,24 +94,25 @@ createInterface tm flags modMap instIfaceMap = do
exportItems <- mkExportItems modMap mdl warningMap gre exportedNames decls maps exports
instances instIfaceMap dflags
- let visibleNames = mkVisibleNames exportItems opts
+ let !visibleNames = mkVisibleNames exportItems opts
-- Measure haddock documentation coverage.
let prunedExportItems0 = pruneExportItems exportItems
- haddockable = 1 + length exportItems -- module + exports
- haddocked = (if isJust mbDoc then 1 else 0) + length prunedExportItems0
- coverage = (haddockable, haddocked)
+ !haddockable = 1 + length exportItems -- module + exports
+ !haddocked = (if isJust mbDoc then 1 else 0) + length prunedExportItems0
+ !coverage = (haddockable, haddocked)
-- Prune the export list to just those declarations that have
-- documentation, if the 'prune' option is on.
- let prunedExportItems
+ let prunedExportItems'
| OptPrune `elem` opts = prunedExportItems0
| otherwise = exportItems
+ !prunedExportItems = seqList prunedExportItems' `seq` prunedExportItems'
- let aliases =
+ let !aliases =
mkAliasMap dflags $ tm_renamed_source tm
- return Interface {
+ return $! Interface {
ifaceMod = mdl,
ifaceOrigFilename = msHsFilePath ms,
ifaceInfo = info,
@@ -179,7 +182,7 @@ moduleWarning ws =
case ws of
NoWarnings -> Nothing
WarnSome _ -> Nothing
- WarnAll w -> Just (warnToDoc w)
+ WarnAll w -> Just $! warnToDoc w
warnToDoc :: WarningTxt -> Doc id
@@ -187,7 +190,8 @@ warnToDoc w = case w of
(DeprecatedTxt msg) -> format "Deprecated: " msg
(WarningTxt msg) -> format "Warning: " msg
where
- format x xs = DocWarning . DocParagraph . DocString . concat $ x : map unpackFS xs
+ format x xs = let !str = force $ concat (x : map unpackFS xs)
+ in DocWarning $ DocParagraph $ DocString str
-------------------------------------------------------------------------------
@@ -254,7 +258,12 @@ mkMaps dflags gre instances decls = do
am = [ (n, args) | n <- ns ] ++ zip subNs subArgs
sm = [ (n, subNs) | n <- ns ]
cm = [ (n, [ldecl]) | n <- ns ++ subNs ]
- return (dm, am, sm, cm)
+ seqList ns `seq`
+ seqList subNs `seq`
+ doc `seq`
+ seqList subDocs `seq`
+ seqList subArgs `seq`
+ return (dm, am, sm, cm)
instanceMap :: Map SrcSpan Name
instanceMap = M.fromList [ (getSrcSpan n, n) | i <- instances, let n = getName i ]
@@ -773,7 +782,8 @@ pruneExportItems = filter hasDoc
mkVisibleNames :: [ExportItem Name] -> [DocOption] -> [Name]
mkVisibleNames exports opts
| OptHide `elem` opts = []
- | otherwise = concatMap exportName exports
+ | otherwise = let ns = concatMap exportName exports
+ in seqList ns `seq` ns
where
exportName e@ExportDecl {} = getMainDeclBinder (unL $ expItemDecl e) ++ subs
where subs = map fst (expItemSubDocs e)
@@ -781,6 +791,9 @@ mkVisibleNames exports opts
-- we don't want links to go to them.
exportName _ = []
+seqList :: [a] -> ()
+seqList [] = ()
+seqList (x : xs) = x `seq` seqList xs
-- | Find a stand-alone documentation comment by its name.
findNamedDoc :: String -> [HsDecl Name] -> ErrMsgM (Maybe HsDocString)
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index d68f78f8..09f2855c 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wwarn #-}
+{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Interface.LexParseRn
@@ -78,7 +80,8 @@ processModuleHeader dflags gre safety mayStr = do
tell ["haddock module header parse failed: " ++ msg]
return failure
Right (hmi, doc) -> do
- let hmi' = hmi { hmi_description = rename dflags gre <$> hmi_description hmi }
+ let !descr = rename dflags gre <$> hmi_description hmi
+ hmi' = hmi { hmi_description = descr }
doc' = rename dflags gre doc
return (hmi', Just doc')
return (hmi { hmi_safety = Just $ showPpr dflags safety }, doc)
diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs
index 411b6661..18f4c768 100644
--- a/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/src/Haddock/Interface/ParseModuleHeader.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wwarn #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Interface.ParseModuleHeader
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 19:36:20 +0000