Fix warnings in ByteCodeItbls

1 files changed, 50 insertions, 56 deletions

diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index ed94526aa2..76d01dfc08 100644
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -12,33 +12,26 @@ module ByteCodeItbls ( ItblEnv, ItblPtr(..), itblCode, mkITbls
 
 #include "HsVersions.h"
 
-import Name		( Name, getName )
+import Name             ( Name, getName )
 import NameEnv
 import ClosureInfo
-import DataCon		( DataCon, dataConRepArgTys, dataConIdentity )
-import TyCon		( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
-import Constants	( mIN_PAYLOAD_SIZE, wORD_SIZE )
-import CgHeapery	( mkVirtHeapOffsets )
-import FastString	( FastString(..) )
+import DataCon          ( DataCon, dataConRepArgTys, dataConIdentity )
+import TyCon            ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
+import Constants        ( mIN_PAYLOAD_SIZE, wORD_SIZE )
+import CgHeapery        ( mkVirtHeapOffsets )
 import Util
-import Outputable
 
 import Foreign
 import Foreign.C
-import Foreign.C.String
-import Data.Bits	( Bits(..), shiftR )
 
-import GHC.Exts		( Int(I#), addr2Int# )
+import GHC.Exts         ( Int(I#), addr2Int# )
 import GHC.Ptr          ( Ptr(..) )
-
-import Debug.Trace
-import Text.Printf
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Manufacturing of info tables for DataCons}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -50,11 +43,12 @@ itblCode (ItblPtr ptr)
  | otherwise            = castPtr ptr
 
 -- XXX bogus
+conInfoTableSizeB :: Int
 conInfoTableSizeB = 3 * wORD_SIZE
 
 type ItblEnv = NameEnv (Name, ItblPtr)
-	-- We need the Name in the range so we know which
-	-- elements to filter out when unloading a module
+        -- We need the Name in the range so we know which
+        -- elements to filter out when unloading a module
 
 mkItblEnv :: [(Name,ItblPtr)] -> ItblEnv
 mkItblEnv pairs = mkNameEnv [(n, (n,p)) | (n,p) <- pairs]
@@ -77,15 +71,17 @@ mkITbl tc
         dcs = tyConDataCons tc
         n   = tyConFamilySize tc
 
+mkITbl _ = error "Unmatched patter in mkITbl: assertion failed!"
+
 #include "../includes/rts/storage/ClosureTypes.h"
-cONSTR :: Int	-- Defined in ClosureTypes.h
+cONSTR :: Int   -- Defined in ClosureTypes.h
 cONSTR = CONSTR 
 
 -- Assumes constructors are numbered from zero, not one
 make_constr_itbls :: [DataCon] -> IO ItblEnv
 make_constr_itbls cons
    = do is <- mapM mk_dirret_itbl (zip cons [0..])
-	return (mkItblEnv is)
+        return (mkItblEnv is)
      where
         mk_dirret_itbl (dcon, conNo)
            = mk_itbl dcon conNo stg_interp_constr_entry
@@ -95,22 +91,22 @@ make_constr_itbls cons
            let rep_args = [ (typeCgRep arg,arg) | arg <- dataConRepArgTys dcon ]
                (tot_wds, ptr_wds, _) = mkVirtHeapOffsets False{-not a THUNK-} rep_args
 
-               ptrs  = ptr_wds
-               nptrs = tot_wds - ptr_wds
+               ptrs'  = ptr_wds
+               nptrs' = tot_wds - ptr_wds
                nptrs_really
-                  | ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs
-                  | otherwise = mIN_PAYLOAD_SIZE - ptrs
-               code = mkJumpToAddr entry_addr
+                  | ptrs' + nptrs' >= mIN_PAYLOAD_SIZE = nptrs'
+                  | otherwise = mIN_PAYLOAD_SIZE - ptrs'
+               code' = mkJumpToAddr entry_addr
                itbl  = StgInfoTable {
 #ifndef GHCI_TABLES_NEXT_TO_CODE
                            entry = entry_addr,
 #endif
-                           ptrs  = fromIntegral ptrs, 
+                           ptrs  = fromIntegral ptrs', 
                            nptrs = fromIntegral nptrs_really,
                            tipe  = fromIntegral cONSTR,
                            srtlen = fromIntegral conNo
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-                         , code  = code
+                         , code  = code'
 #endif
                         }
            qNameCString <- newArray0 0 $ dataConIdentity dcon 
@@ -139,6 +135,7 @@ itblCodeLength = length (mkJumpToAddr undefined)
 
 mkJumpToAddr :: Ptr () -> [ItblCode]
 
+ptrToInt :: Ptr a -> Int
 ptrToInt (Ptr a#) = I# (addr2Int# a#)
 
 #if sparc_TARGET_ARCH
@@ -176,13 +173,13 @@ mkJumpToAddr a
 type ItblCode = Word32
 mkJumpToAddr a =
     let w32 = fromIntegral (ptrToInt a)
-	hi16 x = (x `shiftR` 16) .&. 0xFFFF
-	lo16 x = x .&. 0xFFFF
-    in	[
-	0x3D800000 .|. hi16 w32,
-	0x618C0000 .|. lo16 w32,
-	0x7D8903A6, 0x4E800420
-	]
+        hi16 x = (x `shiftR` 16) .&. 0xFFFF
+        lo16 x = x .&. 0xFFFF
+    in  [
+        0x3D800000 .|. hi16 w32,
+        0x618C0000 .|. lo16 w32,
+        0x7D8903A6, 0x4E800420
+        ]
 
 #elif i386_TARGET_ARCH
 -- Let the address to jump to be 0xWWXXYYZZ.
@@ -203,10 +200,10 @@ mkJumpToAddr a
 
 #elif x86_64_TARGET_ARCH
 -- Generates:
--- 	jmpq *.L1(%rip)
--- 	.align 8
--- .L1:	
--- 	.quad <addr>
+--      jmpq *.L1(%rip)
+--      .align 8
+-- .L1: 
+--      .quad <addr>
 --
 -- We need a full 64-bit pointer (we can't assume the info table is
 -- allocated in low memory).  Assuming the info pointer is aligned to
@@ -218,8 +215,8 @@ mkJumpToAddr a
          insnBytes :: [Word8]
          insnBytes
             = [0xff, 0x25, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
-	       byte0 w64, byte1 w64, byte2 w64, byte3 w64,
-	       byte4 w64, byte5 w64, byte6 w64, byte7 w64]
+               byte0 w64, byte1 w64, byte2 w64, byte3 w64,
+               byte4 w64, byte5 w64, byte6 w64, byte7 w64]
      in
          insnBytes
 
@@ -277,7 +274,7 @@ instance Storable StgConInfoTable where
    sizeOf conInfoTable    
       = sum [ sizeOf (conDesc conInfoTable)
             , sizeOf (infoTable conInfoTable) ]
-   alignment conInfoTable = SIZEOF_VOID_P
+   alignment _ = SIZEOF_VOID_P
    peek ptr 
       = runState (castPtr ptr) $ do
 #ifdef GHCI_TABLES_NEXT_TO_CODE
@@ -342,7 +339,7 @@ instance Storable StgInfoTable where
 #endif
         ]
 
-   alignment itbl 
+   alignment _ 
       = SIZEOF_VOID_P
 
    poke a0 itbl
@@ -363,26 +360,26 @@ instance Storable StgInfoTable where
       = runState (castPtr a0)
       $ do
 #ifndef GHCI_TABLES_NEXT_TO_CODE
-           entry  <- load
+           entry'  <- load
 #endif
-           ptrs   <- load
-           nptrs  <- load
-           tipe   <- load
-           srtlen <- load
+           ptrs'   <- load
+           nptrs'  <- load
+           tipe'   <- load
+           srtlen' <- load
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-           code   <- sequence (replicate itblCodeLength load)
+           code'   <- sequence (replicate itblCodeLength load)
 #endif
            return 
               StgInfoTable { 
 #ifndef GHCI_TABLES_NEXT_TO_CODE
                  entry  = entry,
 #endif
-                 ptrs   = ptrs,
-                 nptrs  = nptrs, 
-                 tipe   = tipe,
-                 srtlen = srtlen
+                 ptrs   = ptrs',
+                 nptrs  = nptrs',
+                 tipe   = tipe',
+                 srtlen = srtlen'
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-                ,code   = code
+                ,code   = code'
 #endif
               }
 
@@ -394,7 +391,7 @@ newtype State s m a = State (s -> m (s, a))
 instance Monad m => Monad (State s m) where
   return a      = State (\s -> return (s, a))
   State m >>= k = State (\s -> m s >>= \(s', a) -> case k a of State n -> n s')
-  fail str      = State (\s -> fail str)
+  fail str      = State (\_ -> fail str)
 
 class (Monad m, Monad (t m)) => MonadT t m where
   lift :: m a -> t m a
@@ -432,9 +429,6 @@ newExec poke_fn obj
         ex_ptr <- peek pcode
         poke_fn wr_ptr ex_ptr obj
         return (castPtrToFunPtr ex_ptr)
-   where
-   codeSize :: Storable a => a -> [a] -> Int
-   codeSize dummy array = sizeOf(dummy) * length array
 
 foreign import ccall unsafe "allocateExec"
   _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)