Commit 72da0c29 authored by mniip's avatar mniip Committed by Marge Bot
Browse files

Add :doc to GHC.Prim

parent c42754d5
......@@ -16,7 +16,7 @@ module GHC.Builtin.PrimOps (
primOpOutOfLine, primOpCodeSize,
primOpOkForSpeculation, primOpOkForSideEffects,
primOpIsCheap, primOpFixity,
primOpIsCheap, primOpFixity, primOpDocs,
getPrimOpResultInfo, isComparisonPrimOp, PrimOpResultInfo(..),
......@@ -161,6 +161,17 @@ primOpStrictness :: PrimOp -> Arity -> StrictSig
primOpFixity :: PrimOp -> Maybe Fixity
#include "primop-fixity.hs-incl"
{-
************************************************************************
* *
\subsubsection{Docs}
* *
************************************************************************
-}
primOpDocs :: PrimOp -> Maybe String
#include "primop-docs.hs-incl"
{-
************************************************************************
* *
......
......@@ -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
{-
************************************************************************
* *
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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" ]
......@@ -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 -----------------------
------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment