X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fgenprimopcode%2FMain.hs;h=5b802bccd744b8fd9f6aa9fdf8f293f599eb4457;hb=5882c5ff503c5b3b425708621cbc3371cc36e5de;hp=9a80a50ecc8ea18b7f7f8691bdebf90bd7437517;hpb=9f135e47a4311c778b33d5a33613009f1119ba78;p=ghc-hetmet.git

diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index 9a80a50..5b802bc 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -8,11 +8,10 @@ module Main where
 import Parser
 import Syntax
 
-import Monad
-import Char
-import List
-import System ( getArgs )
-import Maybe ( catMaybes )
+import Data.Char
+import Data.List
+import Data.Maybe ( catMaybes )
+import System.Environment ( getArgs )
 
 main :: IO ()
 main = getArgs >>= \args ->
@@ -125,13 +124,15 @@ 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"
-    ++ "import GHC.Bool\n"
+    ++ "import GHC.Types\n"
     ++ "\n"
     ++ "{-\n"
 	++ unlines (map opt defaults)
@@ -486,7 +487,7 @@ gen_wrappers (Info _ entries)
 	-- don't need the Prelude here so we add NoImplicitPrelude.
      ++ "module GHC.PrimopWrappers where\n" 
      ++ "import qualified GHC.Prim\n" 
-     ++ "import GHC.Bool (Bool)\n"
+     ++ "import GHC.Types (Bool)\n"
      ++ "import GHC.Unit ()\n"
      ++ "import GHC.Prim (" ++ types ++ ")\n"
      ++ unlines (concatMap f specs)
@@ -661,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 ++ "))"