X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FusageSP%2FUsageSPInf.lhs;h=e74568990c4bfbd30a31feb75b66e8ecbf3f25ce;hb=20d1c20c49feae6b862c87504bbd9b8c483044f3;hp=d9cdc77bc8a6a3269c9971824f3bca62114b684f;hpb=9aa6d18bd696e8861fb8c3e065e49a989d2d67ac;p=ghc-hetmet.git

diff --git a/ghc/compiler/usageSP/UsageSPInf.lhs b/ghc/compiler/usageSP/UsageSPInf.lhs
index d9cdc77..e745689 100644
--- a/ghc/compiler/usageSP/UsageSPInf.lhs
+++ b/ghc/compiler/usageSP/UsageSPInf.lhs
@@ -21,15 +21,12 @@ import CoreSyn
 import CoreFVs		( mustHaveLocalBinding )
 import Rules            ( RuleBase )
 import TypeRep          ( Type(..), TyNote(..) ) -- friend
-import Type             ( UsageAnn(..),
-                          applyTy, applyTys,
-                          splitFunTy_maybe, splitFunTys, splitTyConApp_maybe,
-                          mkUsgTy, splitUsgTy, isUsgTy, isNotUsgTy, unUsgTy, tyUsg,
-                          splitUsForAllTys, substUsTy,
+import Type             ( applyTy, applyTys,
+                          splitFunTy_maybe, splitFunTys, splitTyConApp,
                           mkFunTy, mkForAllTy )
 import TyCon            ( tyConArgVrcs_maybe, isFunTyCon )
 import Literal          ( Literal(..), literalType )
-import Var              ( Var, UVar, varType, setVarType, mkUVar, modifyIdInfo )
+import Var              ( Var, varType, setVarType, modifyIdInfo )
 import IdInfo           ( setLBVarInfo, LBVarInfo(..) )
 import Id               ( isExportedId )
 import VarEnv
@@ -40,7 +37,7 @@ import Outputable
 import Maybes           ( expectJust )
 import List             ( unzip4 )
 import CmdLineOpts	( DynFlags, DynFlag(..), dopt, opt_UsageSPOn )
-import CoreLint		( beginPass, endPass )
+import CoreLint		( showPass, endPass )
 import ErrUtils		( doIfSet_dyn, dumpIfSet_dyn )
 import PprCore          ( pprCoreBindings )
 \end{code}
@@ -92,20 +89,26 @@ monad.
 doUsageSPInf :: DynFlags 
 	     -> UniqSupply
              -> [CoreBind]
-             -> RuleBase
              -> IO [CoreBind]
 
-doUsageSPInf dflags us binds local_rules
+doUsageSPInf dflags us binds
   | not opt_UsageSPOn
-  = do { printErrs (text "WARNING: ignoring requested -fusagesp pass; requires -fusagesp-on") ;
+  = do { printDump (text "WARNING: ignoring requested -fusagesp pass; requires -fusagesp-on") ;
 	 return binds
     }
-      
+
+{- ENTIRE PASS 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 pass.
+
+
   | otherwise
   = do
         let binds1 = doUnAnnotBinds binds
 
-	beginPass dflags "UsageSPInf"
+	showPass dflags "UsageSPInf"
 
         dumpIfSet_dyn dflags Opt_D_dump_usagesp "UsageSPInf unannot'd" $
                              pprCoreBindings binds1
@@ -349,7 +352,7 @@ usgInfCE ve e0@(Case e1 v1 alts)
        (e2,y2u,h2,f2) <- usgInfCE ve e1
        let h3       = usgEqTy y2u y1u -- **! why not subty?
            (u2,y2)  = splitUsgTy y2u
-           (tc,y2s) = expectJust "usgInfCE:Case" $ splitTyConApp_maybe y2
+           (tc,y2s) = splitTyConApp y2
            (cs,v1ss,es) = unzip3 alts
            v2ss     = map (map (\ v -> setVarType v (mkUsgTy u2 (annotManyN (varType v)))))
                           v1ss
@@ -661,6 +664,9 @@ isUnAnnotated (AppTy ty1 ty2)           = isUnAnnotated ty1 && isUnAnnotated ty2
 isUnAnnotated (TyConApp tc tys)         = all isUnAnnotated tys
 isUnAnnotated (FunTy ty1 ty2)           = isUnAnnotated ty1 && isUnAnnotated ty2
 isUnAnnotated (ForAllTy tyv ty)         = isUnAnnotated ty
+
+
+END OF ENTIRELY-COMMENTED-OUT PASS   -- KSW 2000-10-13 -}
 \end{code}
 
 ======================================================================