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,
+module UsageSPLint ( {- SEE BELOW: -- KSW 2000-10-13
+ doLintUSPAnnotsBinds,
doLintUSPConstBinds,
doLintUSPBinds,
- doCheckIfWorseUSP,
+ doCheckIfWorseUSP, -}
) where
#include "HsVersions.h"
import UsageSPUtils
import CoreSyn
-import Type ( Type(..), TyNote(..), UsageAnn(..), isUsgTy, tyUsg )
+import TypeRep ( Type(..), TyNote(..) ) -- friend
+import Type ( )
import TyCon ( isAlgTyCon, isPrimTyCon, isSynTyCon, isFunTyCon )
-import Var ( IdOrTyVar, varType, idInfo )
-import IdInfo ( LBVarInfo(..), lbvarInfo )
-import SrcLoc ( noSrcLoc )
-import ErrUtils ( Message, ghcExit )
+import Var ( Var, varType )
+import Id ( idLBVarInfo )
+import IdInfo ( LBVarInfo(..) )
+import ErrUtils ( ghcExit )
import Util ( zipWithEqual )
-import PprCore
import Bag
import Outputable
+
+{- ENTIRE FILE COMMENTED OUT FOR NOW -- KSW 2000-10-13
+
+ This monomorphic version of the analysis is outdated. I'm
+ currently ripping out the old one and inserting the new one. For
+ now, I'm simply commenting out this entire file.
+
\end{code}
======================================================================
doCheckIfWorseUSP binds binds'
= case checkIfWorseUSP binds binds' of
Nothing -> return ()
- Just warns -> printErrs warns
+ Just warns -> printDump warns
\end{code}
======================================================================
First, the various kinds of worsenings we can have:
\begin{code}
-data WorseErr = WorseVar IdOrTyVar IdOrTyVar -- variable gets worse
+data WorseErr = WorseVar Var Var -- variable gets worse
| WorseTerm CoreExpr CoreExpr -- term gets worse
- | WorseLam IdOrTyVar IdOrTyVar -- lambda gets worse
+ | WorseLam Var Var -- lambda gets worse
instance Outputable WorseErr where
ppr (WorseVar v0 v) = ptext SLIT("Identifier:") <+> ppr v0 <+> dcolon
checkCE :: CoreExpr -> CoreExpr -> Bag WorseErr
checkCE (Var _) (Var _) = emptyBag
-
-checkCE (Con _ args) (Con _ args') = unionManyBags $
- zipWithEqual "UsageSPLint.checkCE:Con"
- checkCE args args'
+checkCE (Lit _) (Lit _) = emptyBag
checkCE (App e arg) (App e' arg') = (checkCE e e')
`unionBags` (checkCE arg arg')
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'))
-- does binder change from Once to Many?
-- notice we only check the top-level annotation; this is all that's necessary. KSW 1999-04.
-checkVar :: IdOrTyVar -> IdOrTyVar -> Bag WorseErr
+checkVar :: Var -> Var -> Bag WorseErr
checkVar v v' | isTyVar v = emptyBag
| not (isUsgTy y) = emptyBag -- if initially no annot, definitely OK
| otherwise = checkUsg u u' (WorseVar v v')
u' = tyUsg y'
-- does lambda change from Once to Many?
-checkLamVar :: IdOrTyVar -> IdOrTyVar -> Bag WorseErr
+checkLamVar :: Var -> Var -> Bag WorseErr
checkLamVar v v' | isTyVar v = emptyBag
- | otherwise = case ((lbvarInfo . idInfo) v, (lbvarInfo . idInfo) v') of
+ | otherwise = case (idLBVarInfo v, idLBVarInfo v') of
(NoLBVarInfo , _ ) -> emptyBag
(IsOneShotLambda, IsOneShotLambda) -> emptyBag
(IsOneShotLambda, NoLBVarInfo ) -> unitBag (WorseLam v v')
(_,errs) -> if isEmptyBag errs
then Nothing
else Just (vcat (map pprULintErr (bagToList errs)))
+
+END OF ENTIRELY-COMMENTED-OUT FILE -- KSW 2000-10-13 -}
\end{code}
======================================================================