From 2c23e2e37d6c937a425c53da643aec90bda01ef6 Mon Sep 17 00:00:00 2001
From: mniip <mniip@mniip.com>
Date: Wed, 22 Apr 2020 22:40:58 +0300
Subject: Include docs for non-primop entries in primops.txt as well

---
 compiler/GHC/Builtin/PrimOps.hs |  8 +++++++-
 compiler/GHC/Builtin/Utils.hs   | 13 ++++++++++---
 2 files changed, 17 insertions(+), 4 deletions(-)

(limited to 'compiler/GHC')

diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index b3861c83aa..75622f7399 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -167,9 +167,15 @@ primOpFixity :: PrimOp -> Maybe Fixity
 \subsubsection{Docs}
 *                                                                      *
 ************************************************************************
+
+@primOpDocs@ contains the documentation from @primops.txt@ as a list of
+pairs (name, docs). We use stringy names here because wired-in names are
+not available yet, and not all of them are a @PrimOp@ (they could be
+tycons or pseudoops for example)
+
 -}
 
-primOpDocs :: PrimOp -> Maybe String
+primOpDocs :: [(String, String)]
 #include "primop-docs.hs-incl"
 
 {-
diff --git a/compiler/GHC/Builtin/Utils.hs b/compiler/GHC/Builtin/Utils.hs
index 1c7ede7c64..2b8b0bf698 100644
--- a/compiler/GHC/Builtin/Utils.hs
+++ b/compiler/GHC/Builtin/Utils.hs
@@ -75,7 +75,7 @@ import GHC.Builtin.Types.Literals ( typeNatTyCons )
 import GHC.Hs.Doc
 
 import Control.Applicative ((<|>))
-import Data.List        ( intercalate )
+import Data.List        ( intercalate , find )
 import Data.Array
 import Data.Maybe
 import qualified Data.Map as Map
@@ -260,8 +260,15 @@ ghcPrimExports
    | tc <- funTyCon : exposedPrimTyCons, let n = tyConName tc  ]
 
 ghcPrimDeclDocs :: DeclDocMap
-ghcPrimDeclDocs = DeclDocMap $ Map.fromList $ mapMaybe mkDeclDoc allThePrimOps
-  where mkDeclDoc po = fmap (\doc -> (idName (primOpId po), mkHsDocString doc)) $ primOpDocs po
+ghcPrimDeclDocs = DeclDocMap $ Map.fromList $ mapMaybe findName primOpDocs
+  where
+    names = map idName ghcPrimIds ++
+            map (idName . primOpId) allThePrimOps ++
+            map tyConName (funTyCon : exposedPrimTyCons)
+    findName (nameStr, doc)
+      | Just name <- find ((nameStr ==) . getOccString) names
+      = Just (name, mkHsDocString doc)
+      | otherwise = Nothing
 
 {-
 ************************************************************************
-- 
cgit v1.2.1