From 88ca0162dc43bf5c36a7fd8af490895a6bacecd9 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Fri, 5 Feb 1999 16:37:24 +0000
Subject: [PATCH] [project @ 1999-02-05 16:37:13 by sof] -fwarn-type-defaults
is your friend; misc changes to avoid H98's 'default default' of Integer to
kick when what we really want is Int.
---
ghc/compiler/absCSyn/PprAbsC.lhs | 6 +++---
ghc/compiler/basicTypes/Name.lhs | 7 ++++---
ghc/compiler/basicTypes/OccName.lhs | 1 +
ghc/compiler/deSugar/DsForeign.lhs | 3 ++-
ghc/compiler/main/Constants.lhs | 1 +
ghc/compiler/main/Main.lhs | 8 ++++++++
ghc/compiler/simplCore/Simplify.lhs | 1 +
ghc/compiler/stranal/SaAbsInt.lhs | 2 +-
ghc/compiler/typecheck/TcMonoType.lhs | 1 +
9 files changed, 22 insertions(+), 8 deletions(-)
diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index 63646ce9185b..4901261d10ac 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 bfdd645c9cbd..8cce8ef618da 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 a22c59093bb6..139a17f5547e 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 c5e90f390b38..bfe23c3eba89 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 d30a976b7b83..e24fe836beac 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 a2b89c5df2c5..c38079e9e195 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 d4063e250bf9..a4c5e70b997d 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 dc1efe4a45c5..62c26ee80c29 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 ef3c6709f2c4..d7bd21c0fdf6 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
--
GitLab