[project @ 1999-01-15 15:57:33 by simonm]

Haskell 98 updates.

13 files changed, 31 insertions, 24 deletions

diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h
index c5663b12dc..f6acb0acb6 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 0b0a3d8a70..1a48d0cdf0 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 ede2a97f9c..499363fa86 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 1cf5d2bd48..12bbf021ad 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 bba6d76256..e44bf1f2cc 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 16fa5fdac7..ced547477f 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 8dd4415c2a..f65aa02f90 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 e548c1ee3a..c1f74baf46 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 066c9919fb..a1c404f833 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 2894fbd1e9..176b3f7bc4 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 f345c08325..015ea5a3dd 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 739df230a5..a35a909abe 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 d3f1ee1ba0..0e81a32c7e 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)