[project @ 1998-07-16 10:11:32 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / AnalFBWW.lhs

diff --git a/ghc/compiler/simplCore/AnalFBWW.lhs b/ghc/compiler/simplCore/AnalFBWW.lhs
index 33ee877..bc97044 100644 (file)
--- a/ghc/compiler/simplCore/AnalFBWW.lhs
+++ b/ghc/compiler/simplCore/AnalFBWW.lhs
@@ -4,13 +4,11 @@
 \section[AnalFBWW]{Spoting good functions for splitting into workers/wrappers}
 
 \begin{code}
-#include "HsVersions.h"
-
 module AnalFBWW ( analFBWW ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
-import CoreSyn         ( SYN_IE(CoreBinding) )
+import CoreSyn         ( CoreBinding )
 import Util            ( panic{-ToDo:rm-} )
 
 --import Util
@@ -104,7 +102,7 @@ analExprFBWW (App (App (App
                (CoTyApp (CoTyApp (Var foldr_id) _) _) (VarArg c)) _) _)
                env
        | pprTrace ("FOLDR:" ++ show (foldr_id == foldrId,isCons c))
-               (ppr PprDebug foldr_id)
+               (ppr foldr_id)
                (foldr_id == foldrId && isCons c) = goodProdFBType
    where
        isCons c = case lookupIdEnv env c of
@@ -137,12 +135,11 @@ analExprFBWW (Lam (id,_) e) env
   = addArgs 1 (analExprFBWW e (delOneFromIdEnv env id))
 
 analExprFBWW (CoTyLam tyvar e) env = analExprFBWW e env
-analExprFBWW (App f atom) env  = rmArg (analExprFBWW f env)
-analExprFBWW (CoTyApp f ty) env  = analExprFBWW f env
-analExprFBWW (SCC lab e) env   = analExprFBWW e env
-analExprFBWW (Coerce _ _ _) env   = panic "AnalFBWW:analExprFBWW:Coerce"
-analExprFBWW (Let binds e) env = analExprFBWW e (analBind binds env)
-analExprFBWW (Case e alts) env = foldl1 joinFBType (analAltsFBWW alts env)
+analExprFBWW (App f atom) env   = rmArg (analExprFBWW f env)
+analExprFBWW (CoTyApp f ty) env = analExprFBWW f env
+analExprFBWW (Note _ e) env     = analExprFBWW e env
+analExprFBWW (Let binds e) env  = analExprFBWW e (analBind binds env)
+analExprFBWW (Case e alts) env  = foldl1 joinFBType (analAltsFBWW alts env)
 
 analAltsFBWW (AlgAlts alts deflt) env
   = case analDefFBWW deflt env of
@@ -188,7 +185,7 @@ analBind (NonRec (v,bnd) e) env =
 analBind (Rec binds) env =
    let
        first_set = [ (v,IsFB (FBType [FBBadConsum | _ <- args ] FBGoodProd)) | ((v,_),e) <- binds,
-                               (_,_,args,_) <- [collectBinders e]]
+                               (_,args,_) <- [collectBinders e]]
        env' = delManyFromIdEnv env (map (fst.fst) binds)
    in
        growIdEnvList env' (fixpoint 0 binds env' first_set)
@@ -218,8 +215,7 @@ annotateExprFBWW (Lam (id,_) e) env
 annotateExprFBWW (CoTyLam tyvar e) env = CoTyLam tyvar (annotateExprFBWW e env)
 annotateExprFBWW (App f atom) env = App (annotateExprFBWW f env) atom
 annotateExprFBWW (CoTyApp f ty) env = CoTyApp (annotateExprFBWW f env) ty
-annotateExprFBWW (SCC lab e) env = SCC lab (annotateExprFBWW e env)
-annotateExprFBWW (Coerce c ty e) env = Coerce c ty (annotateExprFBWW e env)
+annotateExprFBWW (Note note e) env = Note note (annotateExprFBWW e env)
 annotateExprFBWW (Case e alts) env = Case (annotateExprFBWW e env)
                                            (annotateAltsFBWW alts env)
 annotateExprFBWW (Let bnds e) env = Let bnds' (annotateExprFBWW e env')
@@ -252,7 +248,7 @@ annotateBindingFBWW env bnds = (env',bnds')
        fixId v =
                (case lookupIdEnv env' v of
                   Just (IsFB ty@(FBType xs p))
-                   | not (null xs) -> pprTrace "ADDED to:" (ppr PprDebug v)
+                   | not (null xs) -> pprTrace "ADDED to:" (ppr v)
                                        (addIdFBTypeInfo v (mkFBTypeInfo ty))
                   _ -> v)
 -}