From 06babe955146e81fd458941aa765bbc4e260a310 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Fri, 16 Jul 1999 15:03:43 +0000
Subject: [PATCH] [project @ 1999-07-16 15:03:40 by sewardj] cpp-ify some
H98isms with PSEQ and SAPPLY to placate ghc-3.0X
---
ghc/compiler/HsVersions.h | 16 ++++++++++------
ghc/compiler/basicTypes/IdInfo.lhs | 2 +-
ghc/compiler/types/Type.lhs | 18 +++++++++---------
3 files changed, 20 insertions(+), 16 deletions(-)
diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h
index f6acb0acb62b..b90e474525bd 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 92092956e7ac..48597a5aebee 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 fde23a9786af..bd502b56fdab 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}
--
GitLab