diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 4b32253e1b49cb76c5ee67ade9bf5a5983a85392..d5e2ccc4e89b7ad174a6e1b2e3b593fcb4a2a951 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 76d43f58d1fbf37c500c0f1abfb5b5ef75aaa136..bec784c7fcde7cfba8fb5094d42d936edec8b495 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 496a518923ff314e7acf458d597eb1d1867246c2..f183777e7292fd5cc2ff78898988751d07b6d993 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 995d02674d6453f40d3f89a9424b7183bbf1b9c2..2f4aecf856560f2456372fa53a0fc6167dae2fe1 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 6de660962dd33d7d9510537360c12a203f0cdfbc..88b7162ec21f47e3c48533b84fc4444fc87aa3d1 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 41d71c5dedfe3033234a01e98e3020cb16dc97ae..5e74b74c6ba205a07a57c6f010177529135ee480 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 16ace6c4cc8119def7c12bccd401a452fcbcb332..6f7c636310de8660cd658445c213a16c2cd0419a 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