From a4f49e905541846b236ecafd21307f57fe15bc44 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Fri, 5 Sep 2008 12:14:43 +0000 Subject: [PATCH] Make genprimopcode generate code that haddock 2 understands Mainly this means adding a binding for all the exports, e.g. as well as gtAddr# :: Addr# -> Addr# -> Bool we also generate gtAddr# = let x = x in x --- utils/genprimopcode/Main.hs | 36 ++++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 71b1e76..d5279b7 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -123,9 +123,20 @@ gen_hs_source (Info defaults entries) = ++ "-----------------------------------------------------------------------------\n" ++ "module GHC.Prim (\n" ++ unlines (map (("\t" ++) . hdr) entries) - ++ ") where\n\n{-\n" - ++ unlines (map opt defaults) ++ "-}\n" - ++ unlines (map ent entries) ++ "\n\n\n" + ++ ") where\n" + ++ "\n" + ++ "{-\n" + ++ "This is a generated file (generated by genprimopcode).\n" + ++ "It is not code to actually be used. Its only purpose is to be\n" + ++ "consumed by haddock.\n" + ++ "-}\n" + ++ "\n" + ++ "import GHC.Bool\n" + ++ "\n" + ++ "{-\n" + ++ unlines (map opt defaults) + ++ "-}\n" + ++ unlines (concatMap ent entries) ++ "\n\n\n" where opt (OptionFalse n) = n ++ " = False" opt (OptionTrue n) = n ++ " = True" opt (OptionString n v) = n ++ " = { " ++ v ++ "}" @@ -136,7 +147,7 @@ gen_hs_source (Info defaults entries) = hdr (PrimTypeSpec { ty = TyApp n _ }) = wrapTy n ++ "," hdr (PrimTypeSpec {}) = error "Illegal type spec" - ent (Section {}) = "" + ent (Section {}) = [] ent o@(PrimOpSpec {}) = spec o ent o@(PrimTypeSpec {}) = spec o ent o@(PseudoOpSpec {}) = spec o @@ -144,12 +155,17 @@ gen_hs_source (Info defaults entries) = sec s = "\n-- * " ++ escape (title s) ++ "\n" ++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ desc s) ++ "\n" - spec o = comm ++ decl - where decl = case o of - PrimOpSpec { name = n, ty = t } -> wrapOp n ++ " :: " ++ pprTy t - PseudoOpSpec { name = n, ty = t } -> wrapOp n ++ " :: " ++ pprTy t - PrimTypeSpec { ty = t } -> "data " ++ pprTy t - Section { } -> "" + spec o = comm : decls + where decls = case o of + PrimOpSpec { name = n, ty = t } -> + [ wrapOp n ++ " :: " ++ pprTy t, + wrapOp n ++ " = let x = x in x" ] + PseudoOpSpec { name = n, ty = t } -> + [ wrapOp n ++ " :: " ++ pprTy t, + wrapOp n ++ " = let x = x in x" ] + PrimTypeSpec { ty = t } -> + [ "data " ++ pprTy t ] + Section { } -> [] comm = case (desc o) of [] -> "" -- 1.7.10.4