diff options
| author | keithw <unknown> | 1999-06-25 11:45:30 +0000 | 
|---|---|---|
| committer | keithw <unknown> | 1999-06-25 11:45:30 +0000 | 
| commit | 10b66230065ac2426509b60eb2da0a314b34d0e3 (patch) | |
| tree | d42c317482b2703db99e1911f385203816f61565 | |
| parent | 3c0c2b28456ba4076e3ceb942825a79c329d62af (diff) | |
| download | haskell-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.lhs | 4 | ||||
| -rw-r--r-- | ghc/compiler/coreSyn/CoreTidy.lhs | 3 | ||||
| -rw-r--r-- | ghc/compiler/rename/RnHsSyn.lhs | 1 | ||||
| -rw-r--r-- | ghc/compiler/simplCore/SimplCore.lhs | 1 | ||||
| -rw-r--r-- | ghc/compiler/usageSP/UsageSPInf.lhs | 4 | ||||
| -rw-r--r-- | ghc/compiler/usageSP/UsageSPLint.lhs | 4 | ||||
| -rw-r--r-- | ghc/compiler/usageSP/UsageSPUtils.lhs | 5 | 
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  | 
