summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Builtin/PrimOps.hs13
-rw-r--r--compiler/GHC/Builtin/Utils.hs7
-rw-r--r--compiler/GHC/Iface/Load.hs3
-rw-r--r--compiler/ghc.mk5
-rw-r--r--hadrian/src/Rules/Generate.hs3
-rw-r--r--hadrian/src/Settings/Builders/GenPrimopCode.hs1
-rw-r--r--utils/genprimopcode/Main.hs46
7 files changed, 60 insertions, 18 deletions
diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index e85c12a55d..b3861c83aa 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -16,7 +16,7 @@ module GHC.Builtin.PrimOps (
primOpOutOfLine, primOpCodeSize,
primOpOkForSpeculation, primOpOkForSideEffects,
- primOpIsCheap, primOpFixity,
+ primOpIsCheap, primOpFixity, primOpDocs,
getPrimOpResultInfo, isComparisonPrimOp, PrimOpResultInfo(..),
@@ -164,6 +164,17 @@ primOpFixity :: PrimOp -> Maybe Fixity
{-
************************************************************************
* *
+\subsubsection{Docs}
+* *
+************************************************************************
+-}
+
+primOpDocs :: PrimOp -> Maybe String
+#include "primop-docs.hs-incl"
+
+{-
+************************************************************************
+* *
\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
* *
************************************************************************
diff --git a/compiler/GHC/Builtin/Utils.hs b/compiler/GHC/Builtin/Utils.hs
index 0725ee85fa..1c7ede7c64 100644
--- a/compiler/GHC/Builtin/Utils.hs
+++ b/compiler/GHC/Builtin/Utils.hs
@@ -34,6 +34,7 @@ module GHC.Builtin.Utils (
primOpRules, builtinRules,
ghcPrimExports,
+ ghcPrimDeclDocs,
primOpId,
-- * Random other things
@@ -71,11 +72,13 @@ import GHC.Core.TyCon
import GHC.Types.Unique.FM
import Util
import GHC.Builtin.Types.Literals ( typeNatTyCons )
+import GHC.Hs.Doc
import Control.Applicative ((<|>))
import Data.List ( intercalate )
import Data.Array
import Data.Maybe
+import qualified Data.Map as Map
{-
************************************************************************
@@ -256,6 +259,10 @@ ghcPrimExports
[ AvailTC n [n] []
| 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
+
{-
************************************************************************
* *
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 8fc46734c2..4a0ed966d1 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -1049,7 +1049,8 @@ ghcPrimIface
mi_exports = ghcPrimExports,
mi_decls = [],
mi_fixities = fixities,
- mi_final_exts = (mi_final_exts empty_iface){ mi_fix_fn = mkIfaceFixCache fixities }
+ mi_final_exts = (mi_final_exts empty_iface){ mi_fix_fn = mkIfaceFixCache fixities },
+ mi_decl_docs = ghcPrimDeclDocs
}
where
empty_iface = emptyFullModIface gHC_PRIM
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 561926af44..d86aae9771 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -119,7 +119,8 @@ PRIMOP_BITS_NAMES = primop-data-decl.hs-incl \
primop-vector-uniques.hs-incl \
primop-vector-tys.hs-incl \
primop-vector-tys-exports.hs-incl \
- primop-vector-tycons.hs-incl
+ primop-vector-tycons.hs-incl \
+ primop-docs.hs-incl
PRIMOP_BITS_STAGE1 = $(addprefix compiler/stage1/build/,$(PRIMOP_BITS_NAMES))
PRIMOP_BITS_STAGE2 = $(addprefix compiler/stage2/build/,$(PRIMOP_BITS_NAMES))
@@ -166,6 +167,8 @@ compiler/stage$1/build/primop-vector-tys-exports.hs-incl: compiler/stage$1/build
"$$(genprimopcode_INPLACE)" --primop-vector-tys-exports < $$< > $$@
compiler/stage$1/build/primop-vector-tycons.hs-incl: compiler/stage$1/build/primops.txt $$$$(genprimopcode_INPLACE)
"$$(genprimopcode_INPLACE)" --primop-vector-tycons < $$< > $$@
+compiler/stage$1/build/primop-docs.hs-incl: compiler/stage$1/build/primops.txt $$$$(genprimopcode_INPLACE)
+ "$$(genprimopcode_INPLACE)" --wired-in-docs < $$< > $$@
# Usages aren't used any more; but the generator
# can still generate them if we want them back
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index c943d97129..51afdf8724 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -73,7 +73,8 @@ compilerDependencies = do
, "primop-vector-tycons.hs-incl"
, "primop-vector-tys-exports.hs-incl"
, "primop-vector-tys.hs-incl"
- , "primop-vector-uniques.hs-incl" ] ]
+ , "primop-vector-uniques.hs-incl"
+ , "primop-docs.hs-incl" ] ]
generatedDependencies :: Expr [FilePath]
generatedDependencies = do
diff --git a/hadrian/src/Settings/Builders/GenPrimopCode.hs b/hadrian/src/Settings/Builders/GenPrimopCode.hs
index e616ed3b43..2640ee14c7 100644
--- a/hadrian/src/Settings/Builders/GenPrimopCode.hs
+++ b/hadrian/src/Settings/Builders/GenPrimopCode.hs
@@ -21,4 +21,5 @@ genPrimopCodeBuilderArgs = builder GenPrimopCode ? mconcat
, output "//primop-vector-tys.hs-incl" ? arg "--primop-vector-tys"
, output "//primop-vector-tys-exports.hs-incl" ? arg "--primop-vector-tys-exports"
, output "//primop-vector-tycons.hs-incl" ? arg "--primop-vector-tycons"
+ , output "//primop-docs.hs-incl" ? arg "--wired-in-docs"
, output "//primop-usage.hs-incl" ? arg "--usage" ]
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index 5e34ee97c1..93291698b3 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -189,6 +189,9 @@ main = getArgs >>= \args ->
"--make-latex-doc"
-> putStr (gen_latex_doc p_o_specs)
+ "--wired-in-docs"
+ -> putStr (gen_wired_in_docs p_o_specs)
+
_ -> error "Should not happen, known_args out of sync?"
)
@@ -211,7 +214,8 @@ known_args
"--primop-vector-tycons",
"--make-haskell-wrappers",
"--make-haskell-source",
- "--make-latex-doc"
+ "--make-latex-doc",
+ "--wired-in-docs"
]
------------------------------------------------------------------
@@ -360,22 +364,24 @@ gen_hs_source (Info defaults entries) =
prim_data t = [ "data " ++ pprTy t ]
- unlatex s = case s of
- '\\':'t':'e':'x':'t':'t':'t':'{':cs -> markup "@" "@" cs
- '{':'\\':'t':'e':'x':'t':'t':'t':' ':cs -> markup "@" "@" cs
- '{':'\\':'t':'t':cs -> markup "@" "@" cs
- '{':'\\':'i':'t':cs -> markup "/" "/" cs
- '{':'\\':'e':'m':cs -> markup "/" "/" cs
- c : cs -> c : unlatex cs
- "" -> ""
- markup s t xs = s ++ mk (dropWhile isSpace xs)
- where mk "" = t
- mk ('\n':cs) = ' ' : mk cs
- mk ('}':cs) = t ++ unlatex cs
- mk (c:cs) = c : mk cs
escape = concatMap (\c -> if c `elem` special then '\\':c:[] else c:[])
where special = "/'`\"@<"
+unlatex :: String -> String
+unlatex s = case s of
+ '\\':'t':'e':'x':'t':'t':'t':'{':cs -> markup "@" "@" cs
+ '{':'\\':'t':'e':'x':'t':'t':'t':' ':cs -> markup "@" "@" cs
+ '{':'\\':'t':'t':cs -> markup "@" "@" cs
+ '{':'\\':'i':'t':cs -> markup "/" "/" cs
+ '{':'\\':'e':'m':cs -> markup "/" "/" cs
+ c : cs -> c : unlatex cs
+ "" -> ""
+ where markup b e xs = b ++ mk (dropWhile isSpace xs)
+ where mk "" = e
+ mk ('\n':cs) = ' ' : mk cs
+ mk ('}':cs) = e ++ unlatex cs
+ mk (c:cs) = c : mk cs
+
-- | Extract a string representation of the name
getName :: Entry -> Maybe String
getName PrimOpSpec{ name = n } = Just n
@@ -782,6 +788,18 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries)
-> unlines alternatives
++ fn_name ++ " _ = " ++ getAltRhs xx ++ "\n"
+gen_wired_in_docs :: Info -> String
+gen_wired_in_docs (Info _ entries)
+ = unlines $ catMaybes (map mkAlt (filter is_primop entries)) ++ [funName ++ " _ = Nothing"]
+ 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"
+
------------------------------------------------------------------
-- Create PrimOpInfo text from PrimOpSpecs -----------------------
------------------------------------------------------------------
View Lorry Controller Status