aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Interface/Create.hs55
-rw-r--r--src/Haddock/Interface/LexParseRn.hs5
-rw-r--r--src/Haddock/Interface/ParseModuleHeader.hs1
-rw-r--r--src/Haddock/Types.hs58
4 files changed, 68 insertions, 51 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 64995a5f..32f287f5 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 ]
@@ -774,7 +783,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)
@@ -782,6 +792,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 a5eb1143..3ad9719e 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
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index e1e7ce4b..fbd05fae 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -59,10 +59,10 @@ type DocPaths = (FilePath, Maybe FilePath) -- paths to HTML and sources
data Interface = Interface
{
-- | The module behind this interface.
- ifaceMod :: Module
+ ifaceMod :: !Module
-- | Original file name of the module.
- , ifaceOrigFilename :: FilePath
+ , ifaceOrigFilename :: !FilePath
-- | Textual information about the module.
, ifaceInfo :: !(HaddockModInfo Name)
@@ -71,7 +71,7 @@ data Interface = Interface
, ifaceDoc :: !(Documentation Name)
-- | Documentation header with cross-reference information.
- , ifaceRnDoc :: Documentation DocName
+ , ifaceRnDoc :: !(Documentation DocName)
-- | Haddock options for this module (prune, ignore-exports, etc).
, ifaceOptions :: ![DocOption]
@@ -79,22 +79,22 @@ data Interface = Interface
-- | Declarations originating from the module. Excludes declarations without
-- names (instances and stand-alone documentation comments). Includes
-- names of subordinate declarations mapped to their parent declarations.
- , ifaceDeclMap :: Map Name [LHsDecl Name]
+ , ifaceDeclMap :: !(Map Name [LHsDecl Name])
-- | Documentation of declarations originating from the module (including
-- subordinates).
- , ifaceDocMap :: DocMap Name
- , ifaceArgMap :: ArgMap Name
+ , ifaceDocMap :: !(DocMap Name)
+ , ifaceArgMap :: !(ArgMap Name)
-- | Documentation of declarations originating from the module (including
-- subordinates).
- , ifaceRnDocMap :: DocMap DocName
- , ifaceRnArgMap :: ArgMap DocName
+ , ifaceRnDocMap :: !(DocMap DocName)
+ , ifaceRnArgMap :: !(ArgMap DocName)
- , ifaceSubMap :: Map Name [Name]
+ , ifaceSubMap :: !(Map Name [Name])
, ifaceExportItems :: ![ExportItem Name]
- , ifaceRnExportItems :: [ExportItem DocName]
+ , ifaceRnExportItems :: ![ExportItem DocName]
-- | All names exported by the module.
, ifaceExports :: ![Name]
@@ -105,14 +105,14 @@ data Interface = Interface
, ifaceVisibleExports :: ![Name]
-- | Aliases of module imports as in @import A.B.C as C@.
- , ifaceModuleAliases :: AliasMap
+ , ifaceModuleAliases :: !AliasMap
-- | Instances exported by the module.
, ifaceInstances :: ![ClsInst]
-- | The number of haddockable and haddocked items in the module, as a
-- tuple. Haddockable items are the exports and the module itself.
- , ifaceHaddockCoverage :: (Int,Int)
+ , ifaceHaddockCoverage :: !(Int, Int)
}
@@ -172,51 +172,51 @@ data ExportItem name
= ExportDecl
{
-- | A declaration.
- expItemDecl :: LHsDecl name
+ expItemDecl :: !(LHsDecl name)
-- | Maybe a doc comment, and possibly docs for arguments (if this
-- decl is a function or type-synonym).
- , expItemMbDoc :: DocForDecl name
+ , expItemMbDoc :: !(DocForDecl name)
-- | Subordinate names, possibly with documentation.
- , expItemSubDocs :: [(name, DocForDecl name)]
+ , expItemSubDocs :: ![(name, DocForDecl name)]
-- | Instances relevant to this declaration, possibly with
-- documentation.
- , expItemInstances :: [DocInstance name]
+ , expItemInstances :: ![DocInstance name]
}
-- | An exported entity for which we have no documentation (perhaps because it
-- resides in another package).
| ExportNoDecl
- { expItemName :: name
+ { expItemName :: !name
-- | Subordinate names.
- , expItemSubs :: [name]
+ , expItemSubs :: ![name]
}
-- | A section heading.
| ExportGroup
{
-- | Section level (1, 2, 3, ...).
- expItemSectionLevel :: Int
+ expItemSectionLevel :: !Int
-- | Section id (for hyperlinks).
- , expItemSectionId :: String
+ , expItemSectionId :: !String
-- | Section heading text.
- , expItemSectionText :: Doc name
+ , expItemSectionText :: !(Doc name)
}
-- | Some documentation.
- | ExportDoc (Doc name)
+ | ExportDoc !(Doc name)
-- | A cross-reference to another module.
- | ExportModule Module
+ | ExportModule !Module
data Documentation name = Documentation
{ documentationDoc :: Maybe (Doc name)
- , documentationWarning :: Maybe (Doc name)
+ , documentationWarning :: !(Maybe (Doc name))
} deriving Functor
@@ -355,11 +355,11 @@ data DocMarkup id a = Markup
data HaddockModInfo name = HaddockModInfo
- { hmi_description :: Maybe (Doc name)
- , hmi_portability :: Maybe String
- , hmi_stability :: Maybe String
- , hmi_maintainer :: Maybe String
- , hmi_safety :: Maybe String
+ { hmi_description :: (Maybe (Doc name))
+ , hmi_portability :: (Maybe String)
+ , hmi_stability :: (Maybe String)
+ , hmi_maintainer :: (Maybe String)
+ , hmi_safety :: (Maybe String)
}