From 4e6d0831f8260f6cf1f8b9f118123d2c4fb86ee1 Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Fri, 15 Jan 1999 15:57:48 +0000
Subject: [PATCH] [project @ 1999-01-15 15:57:33 by simonm] Haskell 98 updates.
---
ghc/compiler/HsVersions.h | 10 ++++++++++
ghc/compiler/basicTypes/Const.lhs | 4 +---
ghc/compiler/basicTypes/OccName.lhs | 6 ------
ghc/compiler/codeGen/CgClosure.lhs | 6 +++---
ghc/compiler/main/Main.lhs | 2 +-
ghc/compiler/nativeGen/MachMisc.lhs | 2 +-
ghc/compiler/prelude/PrimOp.lhs | 4 ++--
ghc/compiler/rename/ParseIface.y | 4 ++++
ghc/compiler/rename/RnEnv.lhs | 1 -
ghc/compiler/rename/RnMonad.lhs | 6 +++---
ghc/compiler/simplCore/SimplCore.lhs | 2 ++
ghc/compiler/specialise/Specialise.lhs | 6 +++---
ghc/compiler/typecheck/TcMonad.lhs | 2 +-
13 files changed, 31 insertions(+), 24 deletions(-)
diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h
index c5663b12dcf1..f6acb0acb62b 100644
--- a/ghc/compiler/HsVersions.h
+++ b/ghc/compiler/HsVersions.h
@@ -178,4 +178,14 @@ import qualified FastString
# define _CONCAT_ concat
#endif
+#if __HASKELL1__ > 4
+#define FMAP fmap
+#define ISALPHANUM isAlphaNum
+#define IOERROR ioError
+#else
+#define FMAP map
+#define ISALPHANUM isAlphanum
+#define IOERROR fail
+#endif
+
#endif
diff --git a/ghc/compiler/basicTypes/Const.lhs b/ghc/compiler/basicTypes/Const.lhs
index 0b0a3d8a7036..1a48d0cdf057 100644
--- a/ghc/compiler/basicTypes/Const.lhs
+++ b/ghc/compiler/basicTypes/Const.lhs
@@ -37,9 +37,7 @@ import CStrings ( stringToC, charToC, charToEasyHaskell )
import Outputable
import Util ( thenCmp )
-#if __HASKELL1__ > 4
-import Ratio (numerator, denominator)
-#endif
+import Ratio ( numerator, denominator )
\end{code}
diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index ede2a97f9c41..499363fa8640 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -38,12 +38,6 @@ module OccName (
#include "HsVersions.h"
-#if __HASKELL1__ > 4
-#define ISALPHANUM isAlphaNum
-#else
-#define ISALPHANUM isAlphanum
-#endif
-
import Char ( isAlpha, isUpper, isLower, ISALPHANUM, ord )
import Util ( thenCmp )
import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 1cf5d2bd485c..12bbf021ad68 100644
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -1,7 +1,7 @@
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgClosure.lhs,v 1.21 1998/12/18 17:40:49 simonpj Exp $
+% $Id: CgClosure.lhs,v 1.22 1999/01/15 15:57:36 simonm Exp $
%
\section[CgClosure]{Code generation for closures}
@@ -438,9 +438,9 @@ Node is guaranteed to point to it, if profiling and not inherited.
\begin{code}
data IsThunk = IsThunk | IsFunction -- Bool-like, local
---#ifdef DEBUG
+-- #ifdef DEBUG
deriving Eq
---#endif
+-- #endif
enterCostCentreCode :: ClosureInfo -> CostCentreStack -> IsThunk -> Code
diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index bba6d762564e..e44bf1f2cc34 100644
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -435,7 +435,7 @@ motherShip :: IO SockAddr
motherShip = do
he <- getHostByName "laysan.dcs.gla.ac.uk"
case (hostAddresses he) of
- [] -> fail (userError "No address!")
+ [] -> IOERROR (userError "No address!")
(x:_) -> return (SockAddrInet motherShipPort x)
--magick
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 16fa5fdac73f..ced547477f70 100644
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -36,7 +36,7 @@ module MachMisc (
) where
#include "HsVersions.h"
---#include "config.h"
+-- #include "config.h"
import AbsCSyn ( MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 8dd4415c2a06..f65aa02f9083 100644
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -1402,14 +1402,14 @@ catch :: a -> (b -> a) -> a
\begin{code}
primOpInfo CatchOp
= let
- a = alphaTy; a_tv = alphaTyVar;
+ a = alphaTy; a_tv = alphaTyVar
b = betaTy; b_tv = betaTyVar;
in
mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
primOpInfo RaiseOp
= let
- a = alphaTy; a_tv = alphaTyVar;
+ a = alphaTy; a_tv = alphaTyVar
b = betaTy; b_tv = betaTyVar;
in
mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index e548c1ee3a03..c1f74baf465a 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -33,6 +33,10 @@ import Maybes
import Outputable
import GlaExts
+
+#if __HASKELL1__ > 4
+import Ratio ( (%) )
+#endif
}
%name parseIface
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 066c9919fbba..a1c404f83300 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -38,7 +38,6 @@ import SrcLoc ( SrcLoc, noSrcLoc )
import Outputable
import Util ( removeDups )
import List ( nub )
-import Char ( isAlphanum )
\end{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 2894fbd1e9e1..176b3f7bc474 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -436,13 +436,13 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do
hi_boot_xiffus = "toob-ih." -- .hi-boot reversed.
addModules his@(hi_env, hib_env) nm = fromMaybe his $
- map (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm v, hib_env))
+ FMAP (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm v, hib_env))
(go xiffus rev_nm) `seqMaybe`
- map (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm v))
+ FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm v))
(go hi_boot_version_xiffus rev_nm) `seqMaybe`
- map (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm v))
+ FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm v))
(go hi_boot_xiffus rev_nm)
where
rev_nm = reverse nm
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index f345c08325d4..015ea5a3ddaf 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -72,6 +72,8 @@ import Bag
import Maybes
import IO ( hPutStr, stderr )
import Outputable
+
+import Ratio ( numerator, denominator )
\end{code}
\begin{code}
diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
index 739df230a564..a35a909abe85 100644
--- a/ghc/compiler/specialise/Specialise.lhs
+++ b/ghc/compiler/specialise/Specialise.lhs
@@ -965,10 +965,10 @@ mkCallUDs f args
plusUDs :: UsageDetails -> UsageDetails -> UsageDetails
plusUDs (MkUD {dict_binds = db1, calls = calls1})
(MkUD {dict_binds = db2, calls = calls2})
- = MkUD {dict_binds, calls}
+ = MkUD {dict_binds = d, calls = c}
where
- dict_binds = db1 `unionBags` db2
- calls = calls1 `unionCalls` calls2
+ d = db1 `unionBags` db2
+ c = calls1 `unionCalls` calls2
plusUDList = foldr plusUDs emptyUDs
diff --git a/ghc/compiler/typecheck/TcMonad.lhs b/ghc/compiler/typecheck/TcMonad.lhs
index d3f1ee1ba0bd..0e81a32c7ecb 100644
--- a/ghc/compiler/typecheck/TcMonad.lhs
+++ b/ghc/compiler/typecheck/TcMonad.lhs
@@ -281,7 +281,7 @@ failTc :: TcM s a
failTc down env = give_up
give_up :: IO a
-give_up = fail (userError "Typecheck failed")
+give_up = IOERROR (userError "Typecheck failed")
failWithTc :: Message -> TcM s a -- Add an error message and fail
failWithTc err_msg = failWithTcM (emptyTidyEnv, err_msg)
--
GitLab