From: sewardj <unknown>
Date: Fri, 16 Jul 1999 15:03:43 +0000 (+0000)
Subject: [project @ 1999-07-16 15:03:40 by sewardj]
X-Git-Tag: Approximately_9120_patches~5966
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=06babe955146e81fd458941aa765bbc4e260a310;p=ghc-hetmet.git

[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
--- 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
--- 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
--- 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}