From: keithw <unknown>
Date: Fri, 25 Jun 1999 11:45:30 +0000 (+0000)
Subject: [project @ 1999-06-25 11:45:24 by keithw]
X-Git-Tag: Approximately_9120_patches~6080
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=10b66230065ac2426509b60eb2da0a314b34d0e3;p=ghc-hetmet.git

[project @ 1999-06-25 11:45:24 by keithw]
Rescue UsageSP analysis from bit-rot.
---

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 4b32253..d5e2ccc 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 76d43f5..bec784c 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 496a518..f183777 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 995d026..2f4aecf 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 6de6609..88b7162 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 41d71c5..5e74b74 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 16ace6c..6f7c636 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