[project @ 2000-12-08 12:02:25 by simonpj]
[ghc-hetmet.git] / ghc / compiler / usageSP / UsageSPLint.lhs
index 5e74b74..97da3ee 100644 (file)
@@ -9,26 +9,34 @@ September 1998 .. May 1999.
 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}
 
 ======================================================================
@@ -66,7 +74,7 @@ doCheckIfWorseUSP :: [CoreBind] -> [CoreBind] -> IO ()
 doCheckIfWorseUSP binds binds'
   = case checkIfWorseUSP binds binds' of
       Nothing    -> return ()
-      Just warns -> printErrs warns
+      Just warns -> printDump warns
 \end{code}
 
 ======================================================================
@@ -264,9 +272,9 @@ already since they are imported and not changeable.
 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
@@ -312,10 +320,7 @@ checkBind _            _              = panic "UsageSPLint.checkBind"
 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')
@@ -357,7 +362,7 @@ checkCE t                     t'                     = pprPanic "usageSPLint.che
 
 -- 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')
@@ -367,9 +372,9 @@ checkVar v v' | isTyVar v       = emptyBag
         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')
@@ -422,6 +427,8 @@ runULM m = case (unULintM m) (panic "runULM: no location") of
              (_,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}
 
 ======================================================================