From 1181f398e73359a2e6387364b4fe270d4cc78f36 Mon Sep 17 00:00:00 2001 From: sof Date: Tue, 23 Oct 2001 22:25:48 +0000 Subject: [PATCH] [project @ 2001-10-23 22:25:46 by sof] Deleted HsVersions.h #defines that were now past their use-by-dates; in particular, make the assumption that a post-Haskell 1.4 compiler is now used to compile ghc/compiler/ Hanging on to those FastString #defines is probably not worth it any longer, either, but I punted on making that (much bigger) change. --- ghc/compiler/HsVersions.h | 32 -------------------------------- ghc/compiler/basicTypes/IdInfo.lhs | 2 +- ghc/compiler/basicTypes/OccName.lhs | 4 ++-- ghc/compiler/nativeGen/MachCode.lhs | 2 +- ghc/compiler/typecheck/TcMonad.lhs | 2 +- ghc/compiler/types/Type.lhs | 12 ++++++------ ghc/compiler/utils/StringBuffer.lhs | 2 +- 7 files changed, 12 insertions(+), 44 deletions(-) diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h index 39285ba..72c1185 100644 --- a/ghc/compiler/HsVersions.h +++ b/ghc/compiler/HsVersions.h @@ -37,21 +37,6 @@ name = Util.global (value) :: IORef (ty); \ #define UASSERT2(e,msg) #endif -#if __STDC__ -#define CAT2(a,b)a##b -#else -#define CAT2(a,b)a/**/b -#endif - -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 202 -# define failWith fail -# define MkIOError(h,errt,msg) (IOError (Just h) errt msg) -# define minInt (minBound::Int) -# define maxInt (maxBound::Int) -#else -# define MkIOError(h,errt,msg) (errt msg) -#endif - #if __GLASGOW_HASKELL__ >= 23 -- This #ifndef lets us switch off the "import FastString" @@ -72,11 +57,9 @@ import qualified FastString # define _TAIL_ FastString.tailFS # define _LENGTH_ FastString.lengthFS # define _PK_ FastString.mkFastString -# define _PK_INT_ FastString.mkFastStringInt # define _UNPK_ FastString.unpackFS # define _UNPK_INT_ FastString.unpackIntFS # define _APPEND_ `FastString.appendFS` -# define _CONCAT_ FastString.concatFS #else # error I think that FastString is now always used. If not, fix this. # define FAST_STRING String @@ -92,21 +75,6 @@ import qualified FastString # define _UNPK_ (\x->x) # define _SUBSTR_ substr{-from Utils-} # define _APPEND_ ++ -# define _CONCAT_ concat -#endif - -#if __HASKELL1__ > 4 -# define FMAP fmap -# define ISALPHANUM isAlphaNum -# define IOERROR ioError -# define PSEQ seq -# define SAPPLY $! -#else -# define FMAP map -# define ISALPHANUM isAlphanum -# define IOERROR fail -# define PSEQ (\x y -> y) -# define SAPPLY $ #endif #endif diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 07598a3..1aecb54 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -282,7 +282,7 @@ Setters \begin{code} setWorkerInfo info wk = wk `seq` info { workerInfo = wk } -setSpecInfo info sp = PSEQ sp (info { specInfo = sp }) +setSpecInfo info sp = sp `seq` info { specInfo = sp } setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg } setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } setOccInfo info oc = oc `seq` info { occInfo = oc } diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs index c743343..f569a50 100644 --- a/ghc/compiler/basicTypes/OccName.lhs +++ b/ghc/compiler/basicTypes/OccName.lhs @@ -40,7 +40,7 @@ module OccName ( #include "HsVersions.h" -import Char ( isDigit, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt ) +import Char ( isDigit, isUpper, isLower, isAlphaNum, ord, chr, digitToInt ) import Util ( thenCmp ) import Unique ( Unique ) import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM ) @@ -458,7 +458,7 @@ alreadyEncoded s = all ok s -- in names we'd have to encode them. But we do put -- spaces in ccall "occurrences", and we don't want to -- reject them here - ok ch = ISALPHANUM ch + ok ch = isAlphaNum ch alreadyEncodedFS :: FAST_STRING -> Bool alreadyEncodedFS fs = alreadyEncoded (_UNPK_ fs) diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index b96f7e6..d4ea026 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -256,7 +256,7 @@ maybeImm (StCLbl l) maybeImm (StIndex rep (StCLbl l) (StInt off)) = Just (ImmIndex l (fromInteger off * sizeOf rep)) maybeImm (StInt i) - | i >= toInteger minInt && i <= toInteger maxInt + | i >= toInteger (minBound::Int) && i <= toInteger (maxBound::Int) = Just (ImmInt (fromInteger i)) | otherwise = Just (ImmInteger i) diff --git a/ghc/compiler/typecheck/TcMonad.lhs b/ghc/compiler/typecheck/TcMonad.lhs index 8b484a3..41f0890 100644 --- a/ghc/compiler/typecheck/TcMonad.lhs +++ b/ghc/compiler/typecheck/TcMonad.lhs @@ -295,7 +295,7 @@ failTc :: TcM a failTc down env = give_up give_up :: IO a -give_up = IOERROR (userError "Typecheck failed") +give_up = ioError (userError "Typecheck failed") failWithTc :: Message -> TcM a -- Add an error message and fail failWithTc err_msg = failWithTcM (emptyTidyEnv, err_msg) diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs index 101363d..eb159f7 100644 --- a/ghc/compiler/types/Type.lhs +++ b/ghc/compiler/types/Type.lhs @@ -808,16 +808,16 @@ tidyType env@(tidy_env, subst) ty Just tv' -> TyVarTy tv' go (TyConApp tycon tys) = let args = map go tys in args `seqList` TyConApp tycon args - go (NoteTy note ty) = (NoteTy SAPPLY (go_note note)) SAPPLY (go ty) + go (NoteTy note ty) = (NoteTy $! (go_note note)) $! (go ty) go (SourceTy sty) = SourceTy (tidySourceType env sty) - go (AppTy fun arg) = (AppTy SAPPLY (go fun)) SAPPLY (go arg) - go (FunTy fun arg) = (FunTy SAPPLY (go fun)) SAPPLY (go arg) - go (ForAllTy tv ty) = ForAllTy tvp SAPPLY (tidyType envp ty) + go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg) + go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg) + go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty) where (envp, tvp) = tidyTyVarBndr env tv - go (UsageTy u ty) = (UsageTy SAPPLY (go u)) SAPPLY (go ty) + go (UsageTy u ty) = (UsageTy $! (go u)) $! (go ty) - go_note (SynNote ty) = SynNote SAPPLY (go ty) + go_note (SynNote ty) = SynNote $! (go ty) go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars tidyTypes env tys = map (tidyType env) tys diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs index 0b65aa2..f49449e 100644 --- a/ghc/compiler/utils/StringBuffer.lhs +++ b/ghc/compiler/utils/StringBuffer.lhs @@ -195,7 +195,7 @@ slurpFileExpandTabs fname = do (\ handle -> do sz <- hFileSize handle if sz > toInteger (maxBound::Int) - then IOERROR (userError "slurpFile: file too big") + then ioError (userError "slurpFile: file too big") else do let sz_i = fromInteger sz sz_i' = (sz_i * 12) `div` 10 -- add 20% for tabs -- 1.7.10.4