diff options
| -rw-r--r-- | compiler/GHC/Builtin/PrimOps.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/Builtin/Utils.hs | 13 | ||||
| -rw-r--r-- | utils/genprimopcode/Main.hs | 13 |
3 files changed, 22 insertions, 12 deletions
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 {- ************************************************************************ diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 93291698b3..63b51b9f5d 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -388,6 +388,7 @@ getName PrimOpSpec{ name = n } = Just n getName PrimVecOpSpec{ name = n } = Just n getName PseudoOpSpec{ name = n } = Just n getName PrimTypeSpec{ ty = TyApp tc _ } = Just (show tc) +getName PrimVecTypeSpec{ ty = TyApp tc _ } = Just (show tc) getName _ = Nothing {- Note [Placeholder declarations] @@ -790,15 +791,11 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries) gen_wired_in_docs :: Info -> String gen_wired_in_docs (Info _ entries) - = unlines $ catMaybes (map mkAlt (filter is_primop entries)) ++ [funName ++ " _ = Nothing"] + = "primOpDocs =\n [ " ++ intercalate "\n , " (catMaybes $ map mkDoc $ concatMap desugarVectorSpec entries) ++ "\n ]\n" where - mkAlt po | null (desc po) = Nothing - | otherwise = Just (funName ++ " " ++ mkLHS po ++ " = Just " ++ show (unlatex (desc po))) - mkLHS po = case vecOptions po of - [] -> cons po - _ -> "(" ++ cons po ++ " _ _ _)" - - funName = "primOpDocs" + mkDoc po | Just poName <- getName po + , not $ null $ desc po = Just $ show (poName, unlatex $ desc po) + | otherwise = Nothing ------------------------------------------------------------------ -- Create PrimOpInfo text from PrimOpSpecs ----------------------- |