summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkeithw <unknown>1999-06-25 11:45:30 +0000
committerkeithw <unknown>1999-06-25 11:45:30 +0000
commit10b66230065ac2426509b60eb2da0a314b34d0e3 (patch)
treed42c317482b2703db99e1911f385203816f61565
parent3c0c2b28456ba4076e3ceb942825a79c329d62af (diff)
downloadhaskell-10b66230065ac2426509b60eb2da0a314b34d0e3.tar.gz
[project @ 1999-06-25 11:45:24 by keithw]
Rescue UsageSP analysis from bit-rot.
-rw-r--r--ghc/compiler/basicTypes/IdInfo.lhs4
-rw-r--r--ghc/compiler/coreSyn/CoreTidy.lhs3
-rw-r--r--ghc/compiler/rename/RnHsSyn.lhs1
-rw-r--r--ghc/compiler/simplCore/SimplCore.lhs1
-rw-r--r--ghc/compiler/usageSP/UsageSPInf.lhs4
-rw-r--r--ghc/compiler/usageSP/UsageSPLint.lhs4
-rw-r--r--ghc/compiler/usageSP/UsageSPUtils.lhs5
7 files changed, 15 insertions, 7 deletions
diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 4b32253e1b..d5e2ccc4e8 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -659,7 +659,9 @@ noLBVarInfo = NoLBVarInfo
-- not safe to print or parse LBVarInfo because it is not really a
-- property of the definition, but a property of the context.
pprLBVarInfo NoLBVarInfo = empty
-pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
+pprLBVarInfo IsOneShotLambda = getPprStyle $ \ sty ->
+ if ifaceStyle sty then empty
+ else ptext SLIT("OneShot")
instance Outputable LBVarInfo where
ppr = pprLBVarInfo
diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index 76d43f58d1..bec784c7fc 100644
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -16,6 +16,7 @@ import CoreSyn
import CoreUnfold ( noUnfolding )
import CoreLint ( beginPass, endPass )
import Rules ( ProtoCoreRule(..) )
+import UsageSPInf ( doUsageSPInf )
import VarEnv
import VarSet
import Var ( Id, IdOrTyVar )
@@ -38,8 +39,6 @@ import Unique ( Uniquable(..) )
import SrcLoc ( noSrcLoc )
import Util ( mapAccumL )
import Outputable
-
-doUsageSPInf = panic "doUsageSpInf"
\end{code}
diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 496a518923..f183777e72 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -81,6 +81,7 @@ extractHsTyNames ty
`unionNameSets` extractHsTyNames_s tys
get (MonoFunTy ty1 ty2) = get ty1 `unionNameSets` get ty2
get (MonoDictTy cls tys) = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
+ get (MonoUsgTy u ty) = get ty
get (MonoTyVar tv) = unitNameSet tv
get (HsForAllTy (Just tvs)
ctxt ty) = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 995d02674d..2f4aecf856 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -19,7 +19,6 @@ import CmdLineOpts ( CoreToDo(..), SimplifierSwitch(..),
opt_UsageSPOn,
)
import CoreLint ( beginPass, endPass )
-import CoreTidy ( tidyCorePgm )
import CoreSyn
import CSE ( cseProgram )
import Rules ( RuleBase, ProtoCoreRule(..), pprProtoCoreRule, prepareRuleBase, orphanRule )
diff --git a/ghc/compiler/usageSP/UsageSPInf.lhs b/ghc/compiler/usageSP/UsageSPInf.lhs
index 6de660962d..88b7162ec2 100644
--- a/ghc/compiler/usageSP/UsageSPInf.lhs
+++ b/ghc/compiler/usageSP/UsageSPInf.lhs
@@ -6,7 +6,7 @@
This code is (based on) PhD work of Keith Wansbrough <kw217@cl.cam.ac.uk>,
September 1998 .. May 1999.
-Keith Wansbrough 1998-09-04..1999-05-05
+Keith Wansbrough 1998-09-04..1999-06-25
\begin{code}
module UsageSPInf ( doUsageSPInf ) where
@@ -356,6 +356,8 @@ usgInfCE (Note (Coerce ty1 ty0) e)
usgInfCE (Note InlineCall e) = usgInfCE e
+usgInfCE (Note InlineMe e) = usgInfCE e
+
usgInfCE (Note (TermUsg u) e) = pprTrace "usgInfCE: ignoring extra TermUsg:" (ppr u) $
usgInfCE e
diff --git a/ghc/compiler/usageSP/UsageSPLint.lhs b/ghc/compiler/usageSP/UsageSPLint.lhs
index 41d71c5ded..5e74b74c6b 100644
--- a/ghc/compiler/usageSP/UsageSPLint.lhs
+++ b/ghc/compiler/usageSP/UsageSPLint.lhs
@@ -6,7 +6,7 @@
This code is (based on) PhD work of Keith Wansbrough <kw217@cl.cam.ac.uk>,
September 1998 .. May 1999.
-Keith Wansbrough 1998-09-04..1999-05-03
+Keith Wansbrough 1998-09-04..1999-06-25
\begin{code}
module UsageSPLint ( doLintUSPAnnotsBinds,
@@ -343,6 +343,8 @@ checkCE (Note (Coerce _ _) e) (Note (Coerce _ _) e') = checkCE e e'
checkCE (Note InlineCall e) (Note InlineCall e') = checkCE e e'
+checkCE (Note InlineMe e) (Note InlineMe e') = checkCE e e'
+
checkCE t@(Note (TermUsg u) e) t'@(Note (TermUsg u') e')
= checkCE e e'
`unionBags` (checkUsg u u' (WorseTerm t t'))
diff --git a/ghc/compiler/usageSP/UsageSPUtils.lhs b/ghc/compiler/usageSP/UsageSPUtils.lhs
index 16ace6c4cc..6f7c636310 100644
--- a/ghc/compiler/usageSP/UsageSPUtils.lhs
+++ b/ghc/compiler/usageSP/UsageSPUtils.lhs
@@ -6,7 +6,7 @@
This code is (based on) PhD work of Keith Wansbrough <kw217@cl.cam.ac.uk>,
September 1998 .. May 1999.
-Keith Wansbrough 1998-09-04..1999-05-07
+Keith Wansbrough 1998-09-04..1999-06-25
\begin{code}
module UsageSPUtils ( AnnotM(AnnotM), initAnnotM,
@@ -290,6 +290,9 @@ genAnnotCE mungeType mungeTerm = go
go (Note InlineCall e) = do { e' <- go e
; return (Note InlineCall e')
}
+ go (Note InlineMe e) = do { e' <- go e
+ ; return (Note InlineMe e')
+ }
go e0@(Note (TermUsg _) _) = do { e1 <- mungeTerm e0
; case e1 of -- munge may have removed note
Note tu@(TermUsg _) e2 -> do { e3 <- go e2