genprimopcode: Replace LaTeX documentation syntax with Haddock

The LaTeX documentation generator does not seem to have been used for
quite some time, so the LaTeX-to-Haddock preprocessing step has become a
pointless complication that makes documenting the contents of GHC.Prim
needlessly difficult. This commit replaces the LaTeX syntax with the
Haddock it would have been converted into, anyway, though with an
additional distinction: it uses single quotes in places to instruct
Haddock to generate hyperlinks to bindings. This improves the quality of
the generated output.

2 files changed, 5 insertions, 204 deletions

diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index 2bd12e117b..bf1ed76f9e 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -188,9 +188,6 @@ main = getArgs >>= \args ->
                       "--make-haskell-source"
                          -> putStr (gen_hs_source p_o_specs)
 
-                      "--make-latex-doc"
-                         -> putStr (gen_latex_doc p_o_specs)
-
                       "--wired-in-docs"
                          -> putStr (gen_wired_in_docs p_o_specs)
 
@@ -301,8 +298,8 @@ gen_hs_source (Info defaults entries) =
            hdr (PrimVecTypeSpec { ty = TyApp (VecTyCon n _) _ }) = wrapOp n ++ ","
            hdr (PrimVecTypeSpec {})                              = error $ "Illegal type spec"
 
-           sec s = "\n-- * " ++ escape (title s) ++ "\n"
-                    ++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ desc s)
+           sec s = "\n-- * " ++ title s ++ "\n"
+                    ++ (unlines $ map ("-- " ++ ) $ lines $ "|" ++ desc s)
 
 
            ent   (Section {})         = []
@@ -314,7 +311,7 @@ gen_hs_source (Info defaults entries) =
 
            spec o = ([ "" ] ++) . concat $
              -- Doc comments
-             [ case unlatex (escape (desc o)) ++ extra (opts o) of
+             [ case desc o ++ extra (opts o) of
                  "" -> []
                  cmmt -> map ("-- " ++) $ lines $ "|" ++ cmmt
 
@@ -365,24 +362,6 @@ gen_hs_source (Info defaults entries) =
 
            prim_data t = [ "data " ++ pprTy t ]
 
-           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
@@ -438,183 +417,6 @@ asInfix :: String -> String
 asInfix nm | isAlpha (head nm) = "`" ++ nm ++ "`"
            | otherwise         = nm
 
-gen_latex_doc :: Info -> String
-gen_latex_doc (Info defaults entries)
-   = "\\primopdefaults{"
-         ++ mk_options defaults
-         ++ "}\n"
-     ++ (concat (map mk_entry entries))
-     where mk_entry (PrimOpSpec {cons=constr,name=n,ty=t,cat=c,desc=d,opts=o}) =
-                 "\\primopdesc{"
-                 ++ latex_encode constr ++ "}{"
-                 ++ latex_encode n ++ "}{"
-                 ++ latex_encode (zencode n) ++ "}{"
-                 ++ latex_encode (show c) ++ "}{"
-                 ++ latex_encode (mk_source_ty t) ++ "}{"
-                 ++ latex_encode (mk_core_ty t) ++ "}{"
-                 ++ d ++ "}{"
-                 ++ mk_options o
-                 ++ "}\n"
-           mk_entry (PrimVecOpSpec {}) =
-                 ""
-           mk_entry (Section {title=ti,desc=d}) =
-                 "\\primopsection{"
-                 ++ latex_encode ti ++ "}{"
-                 ++ d ++ "}\n"
-           mk_entry (PrimTypeSpec {ty=t,desc=d,opts=o}) =
-                 "\\primtypespec{"
-                 ++ latex_encode (mk_source_ty t) ++ "}{"
-                 ++ latex_encode (mk_core_ty t) ++ "}{"
-                 ++ d ++ "}{"
-                 ++ mk_options o
-                 ++ "}\n"
-           mk_entry (PrimVecTypeSpec {}) =
-                 ""
-           mk_entry (PseudoOpSpec {name=n,ty=t,desc=d,opts=o}) =
-                 "\\pseudoopspec{"
-                 ++ latex_encode (zencode n) ++ "}{"
-                 ++ latex_encode (mk_source_ty t) ++ "}{"
-                 ++ latex_encode (mk_core_ty t) ++ "}{"
-                 ++ d ++ "}{"
-                 ++ mk_options o
-                 ++ "}\n"
-           mk_source_ty typ = pty typ
-             where pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
-                   pty (TyC t1 t2) = pbty t1 ++ " => " ++ pty t2
-                   pty t = pbty t
-                   pbty (TyApp tc ts) = show tc ++ (concat (map (' ':) (map paty ts)))
-                   pbty (TyUTup ts) = "(# " ++ (concat (intersperse "," (map pty ts))) ++ " #)"
-                   pbty t = paty t
-                   paty (TyVar tv) = tv
-                   paty t = "(" ++ pty t ++ ")"
-
-           mk_core_ty typ = foralls ++ (pty typ)
-             where pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
-                   pty (TyC t1 t2) = pbty t1 ++ " => " ++ pty t2
-                   pty t = pbty t
-                   pbty (TyApp tc ts) = (zencode (show tc)) ++ (concat (map (' ':) (map paty ts)))
-                   pbty (TyUTup ts) = (zencode (utuplenm (length ts))) ++ (concat ((map (' ':) (map paty ts))))
-                   pbty t = paty t
-                   paty (TyVar tv) = zencode tv
-                   paty (TyApp tc []) = zencode (show tc)
-                   paty t = "(" ++ pty t ++ ")"
-                   utuplenm 1 = "(# #)"
-                   utuplenm n = "(#" ++ (replicate (n-1) ',') ++ "#)"
-                   foralls = if tvars == [] then "" else "%forall " ++ (tbinds tvars)
-                   tvars = tvars_of typ
-                   tbinds [] = ". "
-                   tbinds ("o":tbs) = "(o::TYPE q) " ++ (tbinds tbs)
-                   tbinds ("p":tbs) = "(p::TYPE r) " ++ (tbinds tbs)
-                   tbinds ("v":tbs) = "(v::TYPE (BoxedRep l)) " ++ (tbinds tbs)
-                   tbinds ("w":tbs) = "(w::TYPE (BoxedRep k)) " ++ (tbinds tbs)
-                   tbinds (tv:tbs) = tv ++ " " ++ (tbinds tbs)
-           tvars_of (TyF t1 t2) = tvars_of t1 `union` tvars_of t2
-           tvars_of (TyC t1 t2) = tvars_of t1 `union` tvars_of t2
-           tvars_of (TyApp _ ts) = foldl union [] (map tvars_of ts)
-           tvars_of (TyUTup ts) = foldr union [] (map tvars_of ts)
-           tvars_of (TyVar tv) = [tv]
-
-           mk_options o =
-             "\\primoptions{"
-              ++ mk_has_side_effects o ++ "}{"
-              ++ mk_out_of_line o ++ "}{"
-              ++ mk_commutable o ++ "}{"
-              ++ mk_needs_wrapper o ++ "}{"
-              ++ mk_can_fail o ++ "}{"
-              ++ mk_fixity o ++ "}{"
-              ++ latex_encode (mk_strictness o) ++ "}{"
-              ++ "}"
-
-           mk_has_side_effects o = mk_bool_opt o "has_side_effects" "Has side effects." "Has no side effects."
-           mk_out_of_line o = mk_bool_opt o "out_of_line" "Implemented out of line." "Implemented in line."
-           mk_commutable o = mk_bool_opt o "commutable" "Commutable." "Not commutable."
-           mk_needs_wrapper o = mk_bool_opt o "needs_wrapper" "Needs wrapper." "Needs no wrapper."
-           mk_can_fail o = mk_bool_opt o "can_fail" "Can fail." "Cannot fail."
-
-           mk_bool_opt o opt_name if_true if_false =
-             case lookup_attrib opt_name o of
-               Just (OptionTrue _) -> if_true
-               Just (OptionFalse _) -> if_false
-               Just (OptionString _ _) -> error "String value for boolean option"
-               Just (OptionInteger _ _) -> error "Integer value for boolean option"
-               Just (OptionFixity _) -> error "Fixity value for boolean option"
-               Just (OptionVector _) -> error "vector template for boolean option"
-               Nothing -> ""
-
-           mk_strictness o =
-             case lookup_attrib "strictness" o of
-               Just (OptionString _ s) -> s  -- for now
-               Just _ -> error "Wrong value for strictness"
-               Nothing -> ""
-
-           mk_fixity o = case lookup_attrib "fixity" o of
-             Just (OptionFixity (Just (Fixity _ i d)))
-               -> pprFixityDir d ++ " " ++ show i
-             _ -> ""
-
-           zencode xs =
-             case maybe_tuple xs of
-                Just n  -> n            -- Tuples go to Z2T etc
-                Nothing -> concat (map encode_ch xs)
-             where
-               maybe_tuple "(# #)" = Just("Z1H")
-               maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
-                                                (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) "H")
-                                                _                  -> Nothing
-               maybe_tuple "()" = Just("Z0T")
-               maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of
-                                                (n, ')' : _) -> Just ('Z' : shows (n+1) "T")
-                                                _            -> Nothing
-               maybe_tuple _                 = Nothing
-
-               count_commas :: Int -> String -> (Int, String)
-               count_commas n (',' : cs) = count_commas (n+1) cs
-               count_commas n cs          = (n,cs)
-
-               unencodedChar :: Char -> Bool    -- True for chars that don't need encoding
-               unencodedChar 'Z' = False
-               unencodedChar 'z' = False
-               unencodedChar c   = isAlphaNum c
-
-               encode_ch :: Char -> String
-               encode_ch c | unencodedChar c = [c]      -- Common case first
-
-               -- Constructors
-               encode_ch '('  = "ZL"    -- Needed for things like (,), and (->)
-               encode_ch ')'  = "ZR"    -- For symmetry with (
-               encode_ch '['  = "ZM"
-               encode_ch ']'  = "ZN"
-               encode_ch ':'  = "ZC"
-               encode_ch 'Z'  = "ZZ"
-
-               -- Variables
-               encode_ch 'z'  = "zz"
-               encode_ch '&'  = "za"
-               encode_ch '|'  = "zb"
-               encode_ch '^'  = "zc"
-               encode_ch '$'  = "zd"
-               encode_ch '='  = "ze"
-               encode_ch '>'  = "zg"
-               encode_ch '#'  = "zh"
-               encode_ch '.'  = "zi"
-               encode_ch '<'  = "zl"
-               encode_ch '-'  = "zm"
-               encode_ch '!'  = "zn"
-               encode_ch '+'  = "zp"
-               encode_ch '\'' = "zq"
-               encode_ch '\\' = "zr"
-               encode_ch '/'  = "zs"
-               encode_ch '*'  = "zt"
-               encode_ch '_'  = "zu"
-               encode_ch '%'  = "zv"
-               encode_ch c    = 'z' : shows (ord c) "U"
-
-           latex_encode [] = []
-           latex_encode (c:cs) | c `elem` "#$%&_^{}" = "\\" ++ c:(latex_encode cs)
-           latex_encode ('~':cs) = "\\verb!~!" ++ (latex_encode cs)
-           latex_encode ('\\':cs) = "$\\backslash$" ++ (latex_encode cs)
-           latex_encode (c:cs) = c:(latex_encode cs)
-
 gen_wrappers :: Info -> String
 gen_wrappers (Info _ entries)
    =    "{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples #-}\n"
@@ -818,7 +620,7 @@ 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)
+               , not $ null $ desc po = Just $ show (poName, desc po)
                | otherwise = Nothing
 
 ------------------------------------------------------------------
diff --git a/utils/genprimopcode/gen_bytearray_ops.py b/utils/genprimopcode/gen_bytearray_ops.py
index a7212740b6..e4cb2ab015 100644
--- a/utils/genprimopcode/gen_bytearray_ops.py
+++ b/utils/genprimopcode/gen_bytearray_ops.py
@@ -25,7 +25,7 @@ element_types = [
     ElementType("Addr",      "Addr#",        "machine address",                       MACH_WORD),
     ElementType("Float",     "Float#",       "single-precision floating-point value", 4),
     ElementType("Double",    "Double#",      "double-precision floating-point value", 8),
-    ElementType("StablePtr", "StablePtr# a", "{\\tt StablePtr#} value",               MACH_WORD),
+    ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value",                    MACH_WORD),
 ]
 
 # TODO: Eventually when the sized integer primops use proper unboxed types we
@@ -141,4 +141,3 @@ for t in element_types:
            with has_side_effects = True
                 can_fail = True
     ''', **t._asdict())
-