From 88ca0162dc43bf5c36a7fd8af490895a6bacecd9 Mon Sep 17 00:00:00 2001 From: sof 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 63646ce..4901261 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 bfdd645..8cce8ef 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 a22c590..139a17f 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 c5e90f3..bfe23c3 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 d30a976..e24fe83 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 a2b89c5..c38079e 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 d4063e2..a4c5e70 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 dc1efe4..62c26ee 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 ef3c670..d7bd21c 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 -- 1.7.10.4