[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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