[Git][ghc/ghc][master] 3 commits: Add :doc to GHC.Prim
Marge Bot
gitlab at gitlab.haskell.org
Thu Apr 23 22:33:32 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
72da0c29 by mniip at 2020-04-23T18:33:21-04:00
Add :doc to GHC.Prim
- - - - -
2c23e2e3 by mniip at 2020-04-23T18:33:21-04:00
Include docs for non-primop entries in primops.txt as well
- - - - -
0ac29c88 by mniip at 2020-04-23T18:33:21-04:00
GHC.Prim docs: note and test
- - - - -
10 changed files:
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/Iface/Load.hs
- compiler/ghc.mk
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Builders/GenPrimopCode.hs
- testsuite/tests/ghci/scripts/all.T
- + testsuite/tests/ghci/scripts/ghci066.script
- + testsuite/tests/ghci/scripts/ghci066.stdout
- utils/genprimopcode/Main.hs
Changes:
=====================================
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(..),
@@ -161,6 +161,19 @@ primOpStrictness :: PrimOp -> Arity -> StrictSig
primOpFixity :: PrimOp -> Maybe Fixity
#include "primop-fixity.hs-incl"
+{-
+************************************************************************
+* *
+\subsubsection{Docs}
+* *
+************************************************************************
+
+See Note [GHC.Prim Docs]
+-}
+
+primOpDocs :: [(String, String)]
+#include "primop-docs.hs-incl"
+
{-
************************************************************************
* *
=====================================
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.List ( intercalate , find )
import Data.Array
import Data.Maybe
+import qualified Data.Map as Map
{-
************************************************************************
@@ -256,6 +259,17 @@ ghcPrimExports
[ AvailTC n [n] []
| tc <- funTyCon : exposedPrimTyCons, let n = tyConName tc ]
+ghcPrimDeclDocs :: DeclDocMap
+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
+
{-
************************************************************************
* *
=====================================
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 -- See Note [GHC.Prim Docs]
}
where
empty_iface = emptyFullModIface gHC_PRIM
=====================================
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
=====================================
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
=====================================
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" ]
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -105,6 +105,7 @@ test('ghci062', [extra_files(['ghci062/', 'ghci062/Test.hs']),
test('ghci063', normal, ghci_script, ['ghci063.script'])
test('ghci064', normal, ghci_script, ['ghci064.script'])
test('ghci065', [extra_hc_opts("-haddock")], ghci_script, ['ghci065.script'])
+test('ghci066', normal, ghci_script, ['ghci066.script'])
test('T2452', [extra_hc_opts("-fno-implicit-import-qualified")],
ghci_script, ['T2452.script'])
test('T2766', normal, ghci_script, ['T2766.script'])
=====================================
testsuite/tests/ghci/scripts/ghci066.script
=====================================
@@ -0,0 +1,2 @@
+:set -XMagicHash
+:doc GHC.Prim.byteSwap#
=====================================
testsuite/tests/ghci/scripts/ghci066.stdout
=====================================
@@ -0,0 +1 @@
+Swap bytes in a word.
=====================================
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,28 +364,31 @@ 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
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]
@@ -782,6 +789,30 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries)
-> unlines alternatives
++ fn_name ++ " _ = " ++ getAltRhs xx ++ "\n"
+{-
+Note [GHC.Prim Docs]
+~~~~~~~~~~~~~~~~~~~~
+For haddocks of GHC.Prim we generate a dummy haskell file (gen_hs_source) that
+contains the type signatures and the commends (but no implementations)
+specifically for consumption by haddock.
+
+GHCi's :doc command reads directly from ModIface's though, and GHC.Prim has a
+wired-in iface that has nothing to do with the above haskell file. The code
+below converts primops.txt into an intermediate form that would later be turned
+into a proper DeclDocMap.
+
+We output the docs as a list of pairs (name, docs). We use stringy names here
+because mapping names to "Name"s is difficult for things like primtypes and
+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
+
------------------------------------------------------------------
-- Create PrimOpInfo text from PrimOpSpecs -----------------------
------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c42754d5fdd3c2db554d9541bab22d1b3def4be7...0ac29c885fba7ed69de83a597cdbd03696c9ed13
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c42754d5fdd3c2db554d9541bab22d1b3def4be7...0ac29c885fba7ed69de83a597cdbd03696c9ed13
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200423/3b242b7d/attachment-0001.html>
More information about the ghc-commits
mailing list