diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index 63646ce9185b572da9e463b42f2f4b724fe832ef..4901261d10ac7f92ca3d5291e7bae060ab296f74 100644
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -1559,7 +1559,7 @@ big_doubles = (getPrimRepSize DoubleRep) /= 1
 floatToWord :: CAddrMode -> CAddrMode
 floatToWord (CLit (MachFloat r))
   = runST (do
-	arr <- newFloatArray (0,0)
+	arr <- newFloatArray ((0::Int),0)
 	writeFloatArray arr 0 (fromRational r)
 	i <- readIntArray arr 0
 	return (CLit (MachInt (toInteger i) True))
@@ -1569,7 +1569,7 @@ doubleToWords :: CAddrMode -> [CAddrMode]
 doubleToWords (CLit (MachDouble r))
   | big_doubles				-- doubles are 2 words
   = runST (do
-	arr <- newDoubleArray (0,1)
+	arr <- newDoubleArray ((0::Int),1)
 	writeDoubleArray arr 0 (fromRational r)
 	i1 <- readIntArray arr 0
 	i2 <- readIntArray arr 1
@@ -1579,7 +1579,7 @@ doubleToWords (CLit (MachDouble r))
     )
   | otherwise				-- doubles are 1 word
   = runST (do
-	arr <- newDoubleArray (0,0)
+	arr <- newDoubleArray ((0::Int),0)
 	writeDoubleArray arr 0 (fromRational r)
 	i <- readIntArray arr 0
 	return [ CLit (MachInt (toInteger i) True) ]
diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index bfdd645c9cbde1887ecdf6ceed59108ac31d2fc0..8cce8ef618da108e7b25d6361c0b42a06e6806d3 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -493,9 +493,10 @@ pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ, n_prov = prov})
 
     pp_mod_dot sty
       = case prov of
-    	   SystemProv	  			     -> pp_qual mod  dot    user_sty
-		-- Hack alert!  Omit the qualifier on SystemProv things, which I claim
-		-- will also be WiredIn things. We can't get the omit flag right
+    	   SystemProv	  			     -> pp_qual mod  pp_sep    user_sty
+		-- Hack alert!  Omit the qualifier on SystemProv things in user style
+                -- I claim such SystemProv things will also be WiredIn things.
+		-- We can't get the omit flag right
 		-- on wired in tycons etc (sigh) so we just leave it out in user style, 
 		-- and hope that leaving it out isn't too consfusing.
 		-- (e.g. if the programmer hides Bool and  redefines it.  If so, use -dppr-debug.)
diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index a22c59093bb64cdb8ae754d0b3583284fcadd284..139a17f5547e5ee671564ed34bb0ea13d21ec172 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -574,6 +574,7 @@ encode cs = case maybe_tuple cs of
 maybe_tuple ('(' : cs) = check_tuple 0 cs
 maybe_tuple other      = Nothing
 
+check_tuple :: Int -> String -> Maybe Int
 check_tuple n (',' : cs) = check_tuple (n+1) cs
 check_tuple n ")"	 = Just n
 check_tuple n other      = Nothing
diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index c5e90f390b3816e772761debdf9f9c4cb9cac3f8..bfe23c3eba894460b4d747da407e90d3a92bec7f 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -524,7 +524,8 @@ fexportEntry c_nm helper args res cc isDyn = (header_bits, c_bits)
 				, head args : addrTy : tail args)
     | otherwise = (mkCArgNames 0 args, args)
 
-  mkCArgNames n as = zipWith (\ _ n -> text ('a':show n)) as [n..] 
+mkCArgNames :: Int -> [a] -> [SDoc]
+mkCArgNames n as = zipWith (\ _ n -> text ('a':show n)) as [n..] 
 
 mkHObj :: Type -> SDoc
 mkHObj t = text "rts_mk" <> showFFIType t
diff --git a/ghc/compiler/main/Constants.lhs b/ghc/compiler/main/Constants.lhs
index d30a976b7b836a3ea825cf729804d00b4c96227b..e24fe836beac36f8d89c851a399b5e881e9b5f47 100644
--- a/ghc/compiler/main/Constants.lhs
+++ b/ghc/compiler/main/Constants.lhs
@@ -227,5 +227,6 @@ The version of the interface file format we're
 using:
 
 \begin{code}
+interfaceFileFormatVersion :: Int
 interfaceFileFormatVersion = HscIfaceFileVersion
 \end{code}
diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index a2b89c5df2c5809c09e908c285dee3f5b1ab20cd..c38079e9e195141648fd8e2cff883c8811228912 100644
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -397,6 +397,14 @@ ppSourceStats short (HsModule name version exports imports decls src_loc)
 	    (_,_,ss,is) ->
 	       (addpr (count_monobinds inst_meths), ss, is)
 
+    addpr :: (Int,Int) -> Int
+    add1  :: Int -> Int -> Int
+    add2  :: (Int,Int) -> (Int,Int) -> (Int, Int)
+    add3  :: (Int,Int,Int) -> (Int,Int,Int) -> (Int, Int, Int)
+    add4  :: (Int,Int,Int,Int) -> (Int,Int,Int,Int) -> (Int, Int, Int, Int)
+    add5  :: (Int,Int,Int,Int,Int) -> (Int,Int,Int,Int,Int) -> (Int, Int, Int, Int, Int)
+    add6  :: (Int,Int,Int,Int,Int,Int) -> (Int,Int,Int,Int,Int,Int) -> (Int, Int, Int, Int, Int, Int)
+
     addpr (x,y) = x+y
     add1 x1 y1  = x1+y1
     add2 (x1,x2) (y1,y2) = (x1+y1,x2+y2)
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index d4063e250bf9ab547266999da1c3c25ca51bb476..a4c5e70b997d911d0789f0428d830167ecb569ba 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -309,6 +309,7 @@ zapLambdaBndr bndr body body_cont
 				      -> ICanSafelyBeINLINEd InsideLam nalts
 				other -> inline_prag
 
+    definitely_saturated :: Int -> CoreExpr -> SimplCont -> Bool
     definitely_saturated 0 _	        _		     = False	-- Too expensive to find out
     definitely_saturated n (Lam _ body) (ApplyTo _ _ _ cont) = definitely_saturated (n-1) body cont
     definitely_saturated n (Lam _ _)    other_cont	     = False
diff --git a/ghc/compiler/stranal/SaAbsInt.lhs b/ghc/compiler/stranal/SaAbsInt.lhs
index dc1efe4a45c5e8bcdfbdf4e60618383f046a331f..62c26ee80c299307cd259e842e75dbdb9b26f161 100644
--- a/ghc/compiler/stranal/SaAbsInt.lhs
+++ b/ghc/compiler/stranal/SaAbsInt.lhs
@@ -630,7 +630,7 @@ findStrictness :: [Type]		-- Types of args in which strictness is wanted
 findStrictness tys str_val abs_val
   = (map find_str tys_w_index, isBot (foldl (absApply StrAnal) str_val all_tops))
   where
-    tys_w_index = tys `zip` [1..]
+    tys_w_index = tys `zip` [(1::Int) ..]
 
     find_str (ty,n) = findRecDemand str_fn abs_fn ty
 		    where
diff --git a/ghc/compiler/typecheck/TcMonoType.lhs b/ghc/compiler/typecheck/TcMonoType.lhs
index ef3c6709f2c40f308318c620f04b09ad7e92445b..d7bd21c0fdf68487a3f971cdfb03fdc52db7a671 100644
--- a/ghc/compiler/typecheck/TcMonoType.lhs
+++ b/ghc/compiler/typecheck/TcMonoType.lhs
@@ -563,6 +563,7 @@ escape_msg sig_tv tv globs
 			       ptext SLIT("which is mentioned in the environment")
 	      | otherwise    = ptext SLIT("It is mentioned in the environment")
 
+    vcat_first :: Int -> [SDoc] -> SDoc
     vcat_first n []     = empty
     vcat_first 0 (x:xs) = text "...others omitted..."
     vcat_first n (x:xs) = x $$ vcat_first (n-1) xs