[project @ 1999-07-16 15:03:40 by sewardj]

cpp-ify some H98isms with PSEQ and SAPPLY to placate ghc-3.0X

diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h
index f6acb0a..b90e474 100644 (file)
--- a/ghc/compiler/HsVersions.h
+++ b/ghc/compiler/HsVersions.h
@@ -179,13 +179,17 @@ import qualified FastString
 #endif
 
 #if __HASKELL1__ > 4
-#define FMAP fmap
-#define ISALPHANUM isAlphaNum
-#define IOERROR ioError
+# 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 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 9209295..48597a5 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -150,7 +150,7 @@ Setters
 
 \begin{code}
 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
-setSpecInfo      info sp = sp `seq` info { specInfo = sp }
+setSpecInfo      info sp = PSEQ sp (info { specInfo = sp })
 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
        -- Try to avoid spack leaks by seq'ing

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index fde23a9..bd502b5 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -18,7 +18,7 @@ module Type (
 
        boxedTypeKind, unboxedTypeKind, openTypeKind,   -- Kind :: superKind
 
-       mkArrowKind, mkArrowKinds, hasMoreBoxityInfo,
+       mkArrowKind, mkArrowKinds, -- mentioned below: hasMoreBoxityInfo,
 
        funTyCon,
 
@@ -789,14 +789,14 @@ 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 $! (go_note note)) $! (go ty)
-    go (AppTy fun arg)     = (AppTy $! (go fun)) $! (go arg)
-    go (FunTy fun arg)     = (FunTy $! (go fun)) $! (go arg)
-    go (ForAllTy tv ty)            = ForAllTy tv' $! (tidyType env' ty)
-                           where
-                             (env', tv') = tidyTyVar env tv
+    go (NoteTy note ty)     = (NoteTy SAPPLY (go_note note)) SAPPLY (go ty)
+    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)
+                             where
+                               (envp, tvp) = tidyTyVar env tv
 
-    go_note (SynNote ty)        = SynNote $! (go ty)
+    go_note (SynNote ty)        = SynNote SAPPLY (go ty)
     go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
     go_note note@(UsgNote _)    = note  -- Usage annotation is already tidy
     go_note note@(UsgForAll _)  = note  -- Uvar binder is already tidy
@@ -805,7 +805,7 @@ tidyTypes  env tys    = map (tidyType env) tys
 \end{code}
 
 
-@tidyOpenType@ grabs the free type varibles, tidies them
+@tidyOpenType@ grabs the free type variables, tidies them
 and then uses @tidyType@ to work over the type itself
 
 \begin{code}