[project @ 1996-12-19 09:10:02 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 7e45607..33ee877 100644 (file)
--- a/ghc/compiler/simplCore/AnalFBWW.lhs
+++ b/ghc/compiler/simplCore/AnalFBWW.lhs
@@ -8,29 +8,36 @@
 
 module AnalFBWW ( analFBWW ) where
 
-import Util
-import Id                      ( addIdFBTypeInfo )
-import IdInfo
-import PrelInfo          ( foldrId, buildId,
-                         nilDataCon, consDataCon, mkListTy, mkFunTy,
-                         unpackCStringAppendId
-                       )
-import BinderInfo
-import SimplEnv                -- everything
-import OccurAnal       -- OLD: was NewOccurAnal
-import Maybes
-
+IMP_Ubiq(){-uitous-}
+
+import CoreSyn         ( SYN_IE(CoreBinding) )
+import Util            ( panic{-ToDo:rm-} )
+
+--import Util
+--import Id                    ( addIdFBTypeInfo )
+--import IdInfo
+--import PrelInfo          ( foldrId, buildId,
+--                       nilDataCon, consDataCon, mkListTy, mkFunTy,
+--                       unpackCStringAppendId
+--                     )
+--import BinderInfo
+--import SimplEnv              -- everything
+--import OccurAnal     -- OLD: was NewOccurAnal
+--import Maybes
 \end{code}
 
 \begin{code}
 analFBWW
-       :: (GlobalSwitch -> Bool)
-       -> [CoreBinding]
+       :: [CoreBinding]
        -> [CoreBinding]
-analFBWW switch top_binds = trace "ANALFBWW" (snd anno)
+
+analFBWW = panic "analFBWW (ToDo)"
+
+{- LATER:
+analFBWW top_binds = trace "ANALFBWW" (snd anno)
  where
        anals :: [InBinding]
-       anals = newOccurAnalyseBinds top_binds switch (const False)
+       anals = newOccurAnalyseBinds top_binds (const False)
        anno = mapAccumL annotateBindingFBWW nullIdEnv anals
 \end{code}
 
@@ -52,7 +59,7 @@ maybeFBtoFB (Nothing) = IsNotFB
 
 addArgs :: Int -> OurFBType -> OurFBType
 addArgs n (IsFB (FBType args prod))
-       = IsFB (FBType (take n (repeat FBBadConsum) ++ args) prod)
+       = IsFB (FBType (nOfThem n FBBadConsum ++ args) prod)
 addArgs n IsNotFB = IsNotFB
 addArgs n IsCons = panic "adding argument to a cons"
 addArgs n IsBottom = IsNotFB
@@ -67,7 +74,7 @@ joinFBType :: OurFBType -> OurFBType -> OurFBType
 joinFBType (IsBottom) a = a
 joinFBType a (IsBottom) = a
 joinFBType (IsFB (FBType args prod)) (IsFB (FBType args' prod'))
-       | length args == length args' = (IsFB (FBType (zipWith argJ args args')
+       | length args == length args' = (IsFB (FBType (zipWith{-Equal-} argJ args args')
                                                      (prodJ prod prod')))
    where
        argJ FBGoodConsum FBGoodConsum = FBGoodConsum
@@ -133,17 +140,18 @@ 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)
 
-analAltsFBWW (AlgAlts alts deflt) env =
-    case analDefFBWW deflt env of
+analAltsFBWW (AlgAlts alts deflt) env
+  = case analDefFBWW deflt env of
        Just ty -> ty : tys
        Nothing -> tys
    where
      tys = map (\(con,binders,e) -> analExprFBWW e (delManyFromIdEnv env (map fst binders))) alts
-analAltsFBWW (PrimAlts alts deflt) env =
-    case analDefFBWW deflt env of
+analAltsFBWW (PrimAlts alts deflt) env
+  = case analDefFBWW deflt env of
        Just ty -> ty : tys
        Nothing -> tys
    where
@@ -162,8 +170,8 @@ Only add a type info if:
 
 \begin{code}
 analBindExpr :: BinderInfo -> InExpr -> IdEnv OurFBType -> OurFBType
-analBindExpr bnd expr env =
-       case analExprFBWW expr env of
+analBindExpr bnd expr env
+  =    case analExprFBWW expr env of
              IsFB ty@(FBType [] _) ->
                   if oneSafeOcc False bnd
                   then IsFB ty
@@ -211,6 +219,7 @@ 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 (Case e alts) env = Case (annotateExprFBWW e env)
                                            (annotateAltsFBWW alts env)
 annotateExprFBWW (Let bnds e) env = Let bnds' (annotateExprFBWW e env')
@@ -246,4 +255,5 @@ annotateBindingFBWW env bnds = (env',bnds')
                    | not (null xs) -> pprTrace "ADDED to:" (ppr PprDebug v)
                                        (addIdFBTypeInfo v (mkFBTypeInfo ty))
                   _ -> v)
+-}
 \end{code}