Make genprimopcode generate code that haddock 2 understands
authorIan Lynagh <igloo@earth.li>
Fri, 5 Sep 2008 12:14:43 +0000 (12:14 +0000)
committerIan Lynagh <igloo@earth.li>
Fri, 5 Sep 2008 12:14:43 +0000 (12:14 +0000)
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

index 71b1e76..d5279b7 100644 (file)
@@ -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
                        [] -> ""