[project @ 2001-06-01 17:14:07 by apt]

[ghc-hetmet.git] / ghc / utils / genprimopcode / Main.hs

diff --git a/ghc/utils/genprimopcode/Main.hs b/ghc/utils/genprimopcode/Main.hs
index 18f5ffe..2d267fc 100644 (file)
--- a/ghc/utils/genprimopcode/Main.hs
+++ b/ghc/utils/genprimopcode/Main.hs
@@ -77,7 +77,9 @@ main = getArgs >>= \args ->
 
                       "--make-haskell-wrappers" 
                          -> putStr (gen_wrappers p_o_specs)
-
+                       
+                     "--make-latex-table"
+                        -> putStr (gen_latex_table p_o_specs)
                    )
 
 
@@ -93,13 +95,32 @@ known_args
        "--primop-primop-info",
        "--primop-tag",
        "--primop-list",
-       "--make-haskell-wrappers"
+       "--make-haskell-wrappers",
+       "--make-latex-table"
      ]
 
 ------------------------------------------------------------------
 -- Code generators -----------------------------------------------
 ------------------------------------------------------------------
 
+gen_latex_table (Info defaults pos)
+   = "\\begin{tabular}{|l|l|}\n"
+     ++ "\\hline\nName &\t Type\\\\\n\\hline\n"
+     ++ (concat (map f pos))
+     ++ "\\end{tabular}"
+     where 
+       f spec = "@" ++ (encode (name spec)) ++ "@ &\t@" ++ (pty (ty spec)) ++ "@\\\\\n"
+       encode s = s
+       pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
+       pty t = pbty t
+       pbty (TyApp tc ts) = (encode tc) ++ (concat (map (' ':) (map paty ts)))
+       pbty (TyUTup ts) = (mkUtupnm (length ts)) ++ (concat (map (' ':) (map paty ts)))
+       pbty t = paty t
+       paty (TyVar tv) = encode tv
+       paty t = "(" ++ pty t ++ ")"
+       mkUtupnm 1 = "ZL#z32U#ZR"
+       mkUtupnm n = "Z" ++ (show (n-1)) ++ "U"
+
 gen_wrappers (Info defaults pos)
    = "module PrelPrimopWrappers where\n" 
      ++ "import qualified PrelGHC\n" 
@@ -495,7 +516,7 @@ optdef d p
 sel12 a b = a
 sel22 a b = b
 sel23 a b c = b
-apply = liftM
+apply f p = liftM f p
 
 -- Hacks for zapping whitespace and comments, unfortunately needed
 -- because Daan won't let us have a lexer before the parser :-(