Primops: Make documentation generation more efficient

Previously we would do a linear search through all primop names, doing a
String comparison on the name of each when preparing the HsDocStringMap.
Fix this.

3 files changed, 28 insertions, 12 deletions

diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index 58d0c9e76b..99a4f1ba43 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -157,7 +157,7 @@ primOpFixity :: PrimOp -> Maybe Fixity
 See Note [GHC.Prim Docs]
 -}
 
-primOpDocs :: [(String, String)]
+primOpDocs :: [(FastString, String)]
 #include "primop-docs.hs-incl"
 
 {-
diff --git a/compiler/GHC/Builtin/Utils.hs b/compiler/GHC/Builtin/Utils.hs
index 948752d55d..bd744ddcbc 100644
--- a/compiler/GHC/Builtin/Utils.hs
+++ b/compiler/GHC/Builtin/Utils.hs
@@ -63,6 +63,8 @@ import GHC.Core.DataCon
 import GHC.Core.Class
 import GHC.Core.TyCon
 
+import GHC.Data.FastString
+
 import GHC.Types.Avail
 import GHC.Types.Basic
 import GHC.Types.Id
@@ -80,7 +82,7 @@ import GHC.Hs.Doc
 import GHC.Unit.Module.ModIface (IfaceExport)
 
 import Control.Applicative ((<|>))
-import Data.List        ( intercalate , find )
+import Data.List        ( intercalate )
 import Data.Array
 import Data.Maybe
 import qualified Data.Map as Map
@@ -268,14 +270,24 @@ ghcPrimExports
    [ availTC n [n] []
    | tc <- exposedPrimTyCons, let n = tyConName tc  ]
 
+ghcPrimNames :: FastStringEnv Name
+ghcPrimNames
+  = mkFsEnv
+    [ (occNameFS $ nameOccName name, name)
+    | name <-
+        map idName ghcPrimIds ++
+        map (idName . primOpId) allThePrimOps ++
+        map tyConName exposedPrimTyCons
+    ]
+
 ghcPrimDeclDocs :: DeclDocMap
-ghcPrimDeclDocs = DeclDocMap $ Map.fromList $ mapMaybe findName primOpDocs
+ghcPrimDeclDocs
+  = DeclDocMap $ Map.fromList
+  $ mapMaybe findName primOpDocs
   where
-    names = map idName ghcPrimIds ++
-            map (idName . primOpId) allThePrimOps ++
-            map tyConName exposedPrimTyCons
+    findName :: (FastString, String) -> Maybe (Name, HsDocString)
     findName (nameStr, doc)
-      | Just name <- find ((nameStr ==) . getOccString) names
+      | Just name <- lookupFsEnv ghcPrimNames nameStr
       = Just (name, mkHsDocString doc)
       | otherwise = Nothing
 
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index a0ea019923..f5b47125c7 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -806,11 +806,15 @@ pseudoops.
 -}
 gen_wired_in_docs :: Info -> String
 gen_wired_in_docs (Info _ entries)
-  = "primOpDocs =\n  [ " ++ intercalate "\n  , " (catMaybes $ map mkDoc $ concatMap desugarVectorSpec entries) ++ "\n  ]\n"
-    where
-      mkDoc po | Just poName <- getName po
-               , not $ null $ desc po = Just $ show (poName, unlatex $ desc po)
-               | otherwise = Nothing
+  = "primOpDocs =\n  [ "
+    ++ intercalate "\n  , " (catMaybes $ map mkDoc $ concatMap desugarVectorSpec entries)
+    ++ "\n  ]\n"
+  where
+    mkDoc po
+      | Just poName <- getName po
+      , not $ null $ desc po = Just $ "(fsLit " ++ show poName ++ "," ++ show (unlatex $ desc po) ++ ")"
+      | otherwise = Nothing
+
 
 ------------------------------------------------------------------
 -- Create PrimOpInfo text from PrimOpSpecs -----------------------