summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
authormniip <mniip@mniip.com>2020-04-22 18:27:39 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-23 18:33:21 -0400
commit72da0c29cd7c336cdce3b36d1dd9e8b65a53afbd (patch)
treee22c0e2cbb3c1d7f341ee2ff7da2e42a13b3d277 /utils
parentc42754d5fdd3c2db554d9541bab22d1b3def4be7 (diff)
downloadhaskell-72da0c29cd7c336cdce3b36d1dd9e8b65a53afbd.tar.gz
Add :doc to GHC.Prim
Diffstat (limited to 'utils')
-rw-r--r--utils/genprimopcode/Main.hs46
1 files changed, 32 insertions, 14 deletions
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 -----------------------
------------------------------------------------------------------