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

Haskell 98 updates.

diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h
index c5663b1..f6acb0a 100644 (file)
--- 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 0b0a3d8..1a48d0c 100644 (file)
--- 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 ede2a97..499363f 100644 (file)
--- 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 1cf5d2b..12bbf02 100644 (file)
--- 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 bba6d76..e44bf1f 100644 (file)
--- 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 16fa5fd..ced5474 100644 (file)
--- 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 8dd4415..f65aa02 100644 (file)
--- 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 e548c1e..c1f74ba 100644 (file)
--- 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 066c991..a1c404f 100644 (file)
--- 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 2894fbd..176b3f7 100644 (file)
--- 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 f345c08..015ea5a 100644 (file)
--- 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 739df23..a35a909 100644 (file)
--- 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 d3f1ee1..0e81a32 100644 (file)
--- 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)