X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fgenprimopcode%2FMain.hs;h=2f7a287ea2d5782b5504de2e774ec431c70e6da2;hb=4e7bbe99d475acc47fed45124bf748f3e258a702;hp=d5279b70baa146c9d4d4c4f1b8cd0fe00e578603;hpb=a4f49e905541846b236ecafd21307f57fe15bc44;p=ghc-hetmet.git

diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index d5279b7..2f7a287 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -8,7 +8,6 @@ module Main where
 import Parser
 import Syntax
 
-import Monad
 import Char
 import List
 import System ( getArgs )
@@ -110,7 +109,13 @@ known_args
 
 gen_hs_source :: Info -> String
 gen_hs_source (Info defaults entries) =
-	   "-----------------------------------------------------------------------------\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"
+	++ "-----------------------------------------------------------------------------\n"
 	++ "-- |\n"
 	++ "-- Module      :  GHC.Prim\n"
 	++ "-- \n"
@@ -119,18 +124,14 @@ gen_hs_source (Info defaults entries) =
 	++ "-- Portability :  non-portable (GHC extensions)\n"
 	++ "--\n"
 	++ "-- GHC\'s primitive types and operations.\n"
+	++ "-- Use GHC.Exts from the base package instead of importing this\n"
+	++ "-- module directly.\n"
 	++ "--\n" 
 	++ "-----------------------------------------------------------------------------\n"
 	++ "module GHC.Prim (\n"
 	++ unlines (map (("\t" ++) . hdr) entries)
 	++ ") 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"
@@ -189,6 +190,7 @@ gen_hs_source (Info defaults entries) =
 	   escape = concatMap (\c -> if c `elem` special then '\\':c:[] else c:[])
 	   	where special = "/'`\"@<"
 
+pprTy :: Ty -> String
 pprTy = pty
     where
           pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
@@ -253,14 +255,14 @@ gen_ext_core_source entries =
         -- ext-core's Prims module again.
         tcKind "Any" _                = "Klifted"
         tcKind tc [] | last tc == '#' = "Kunlifted"
-        tcKind tc [] | otherwise      = "Klifted"
+        tcKind _  [] | otherwise      = "Klifted"
         -- assumes that all type arguments are lifted (are they?)
-        tcKind tc (v:as)              = "(Karrow Klifted " ++ tcKind tc as 
-                                        ++ ")"
+        tcKind tc (_v:as)              = "(Karrow Klifted " ++ tcKind tc as
+                                         ++ ")"
         valEnt (PseudoOpSpec {name=n, ty=t}) = valEntry n t
         valEnt (PrimOpSpec {name=n, ty=t})   = valEntry n t
         valEnt _                             = ""
-        valEntry name ty = parens name (mkForallTy (freeTvars ty) (pty ty))
+        valEntry name' ty' = parens name' (mkForallTy (freeTvars ty') (pty ty'))
             where pty (TyF t1 t2) = mkFunTy (pty t1) (pty t2)
                   pty (TyApp tc ts) = mkTconApp (mkTcon tc) (map pty ts)  
                   pty (TyUTup ts)   = mkUtupleTy (map pty ts)
@@ -275,7 +277,7 @@ gen_ext_core_source entries =
                   mkForallTy [] t = t
                   mkForallTy vs t = foldr 
                      (\ v s -> "Tforall " ++ 
-                               (paren (quot v ++ ", " ++ vKind v)) ++ " "
+                               (paren (quote v ++ ", " ++ vKind v)) ++ " "
                                ++ paren s) t vs
 
                   -- hack alert!
@@ -292,7 +294,7 @@ gen_ext_core_source entries =
                   tcUTuple n = paren $ "Tcon " ++ paren (qualify False $ "Z" 
                                                           ++ show n ++ "H")
 
-        tyEnt (PrimTypeSpec {ty=(TyApp tc args)}) = "   " ++ paren ("Tcon " ++
+        tyEnt (PrimTypeSpec {ty=(TyApp tc _args)}) = "   " ++ paren ("Tcon " ++
                                                        (paren (qualify True tc)))
         tyEnt _ = ""
 
@@ -312,13 +314,13 @@ gen_ext_core_source entries =
         stringLitTys = prefixes ["Addr"]
         prefixes ps = filter (\ t ->
                         case t of
-                          (PrimTypeSpec {ty=(TyApp tc args)}) ->
+                          (PrimTypeSpec {ty=(TyApp tc _args)}) ->
                             any (\ p -> p `isPrefixOf` tc) ps
                           _ -> False)
 
-        parens n ty = "      (zEncodeString \"" ++ n ++ "\", " ++ ty ++ ")"
+        parens n ty' = "      (zEncodeString \"" ++ n ++ "\", " ++ ty' ++ ")"
         paren s = "(" ++ s ++ ")"
-        quot s = "\"" ++ s ++ "\""
+        quote s = "\"" ++ s ++ "\""
 
 gen_latex_doc :: Info -> String
 gen_latex_doc (Info defaults entries)
@@ -660,8 +662,7 @@ ppType (TyApp "MVar#" [x,y])     = "mkMVarPrimTy " ++ ppType x
                                    ++ " " ++ ppType y
 ppType (TyApp "TVar#" [x,y])     = "mkTVarPrimTy " ++ ppType x 
                                    ++ " " ++ ppType y
-ppType (TyUTup ts)               = "(mkTupleTy Unboxed " ++ show (length ts)
-                                   ++ " "
+ppType (TyUTup ts)               = "(mkTupleTy Unboxed " 
                                    ++ listify (map ppType ts) ++ ")"
 
 ppType (TyF s d) = "(mkFunTy (" ++ ppType s ++ ") (" ++ ppType d ++ "))"