From 2655acaaf0ca7f7a17ead44f17e5cfe2c43463c5 Mon Sep 17 00:00:00 2001 From: sof Date: Mon, 26 May 1997 02:25:19 +0000 Subject: [PATCH] [project @ 1997-05-26 02:25:19 by sof] Removed sa_top_binds, folded into SaTopBinds --- ghc/compiler/stranal/StrictAnal.lhs | 46 +++++++++++------------------------ 1 file changed, 14 insertions(+), 32 deletions(-) diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs index 0a46822..751b671 100644 --- a/ghc/compiler/stranal/StrictAnal.lhs +++ b/ghc/compiler/stranal/StrictAnal.lhs @@ -9,12 +9,11 @@ Semantique analyser) was written by Andy Gill. \begin{code} #include "HsVersions.h" -module StrictAnal ( saWwTopBinds, saTopBinds ) where +module StrictAnal ( saWwTopBinds ) where IMP_Ubiq(){-uitous-} -import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict, - opt_D_dump_stranal, opt_D_simplifier_stats +import CmdLineOpts ( opt_D_dump_stranal, opt_D_simplifier_stats ) import CoreSyn import Id ( idType, addIdStrictness, isWrapperId, @@ -25,7 +24,7 @@ import IdInfo ( mkStrictnessInfo, mkBottomStrictnessInfo, mkDemandInfo, willBeDemanded, DemandInfo ) import PprCore ( pprCoreBinding, pprBigCoreBinder ) -import PprStyle ( PprStyle(..) ) +import Outputable ( PprStyle(..) ) import PprType ( GenType{-instance Outputable-}, GenTyVar{-ditto-} ) import Pretty ( Doc, hcat, ptext, int, char, vcat ) import SaAbsInt @@ -90,15 +89,14 @@ saWwTopBinds :: UniqSupply saWwTopBinds us binds = let - strflags = (opt_AllStrict, opt_NumbersStrict) -- mark each binder with its strictness #ifndef OMIT_STRANAL_STATS (binds_w_strictness, sa_stats) - = sa_top_binds strflags binds nullSaStats + = saTopBinds binds nullSaStats #else binds_w_strictness - = sa_top_binds strflags binds + = saTopBindsBinds binds #endif in -- possibly show what we decided about strictness... @@ -153,19 +151,11 @@ environment which maps @Id@s to their abstract values (i.e., an @AbsValEnv@ maps an @Id@ to its @AbsVal@). \begin{code} -saTopBinds :: StrAnalFlags -> [CoreBinding] -> [CoreBinding] -- exported -sa_top_binds :: StrAnalFlags -> [CoreBinding] -> SaM [CoreBinding] -- not exported +saTopBinds :: [CoreBinding] -> SaM [CoreBinding] -- not exported -saTopBinds strflags binds -#ifndef OMIT_STRANAL_STATS - = fst (sa_top_binds strflags binds nullSaStats) -#else - = sa_top_binds strflags binds -#endif - -sa_top_binds strflags binds +saTopBinds binds = let - starting_abs_env = nullAbsValEnv strflags + starting_abs_env = nullAbsValEnv in do_it starting_abs_env starting_abs_env binds where @@ -189,8 +179,6 @@ saTopBind :: StrictEnv -> AbsenceEnv saTopBind str_env abs_env (NonRec binder rhs) = saExpr str_env abs_env rhs `thenSa` \ new_rhs -> let - strflags = getStrAnalFlags str_env - str_rhs = absEval StrAnal rhs str_env abs_rhs = absEval AbsAnal rhs abs_env @@ -201,7 +189,6 @@ saTopBind str_env abs_env (NonRec binder rhs) new_binder = addStrictnessInfoToId - strflags widened_str_rhs widened_abs_rhs binder rhs @@ -215,14 +202,13 @@ saTopBind str_env abs_env (NonRec binder rhs) saTopBind str_env abs_env (Rec pairs) = let - strflags = getStrAnalFlags str_env (binders,rhss) = unzip pairs str_rhss = fixpoint StrAnal binders rhss str_env abs_rhss = fixpoint AbsAnal binders rhss abs_env -- fixpoint returns widened values new_str_env = growAbsValEnvList str_env (binders `zip` str_rhss) new_abs_env = growAbsValEnvList abs_env (binders `zip` abs_rhss) - new_binders = zipWith4Equal "saTopBind" (addStrictnessInfoToId strflags) + new_binders = zipWith4Equal "saTopBind" addStrictnessInfoToId str_rhss abs_rhss binders rhss in mapSa (saExpr new_str_env new_abs_env) rhss `thenSa` \ new_rhss -> @@ -301,8 +287,6 @@ saExpr str_env abs_env (Let (NonRec binder rhs) body) = -- Analyse the RHS in the environment at hand saExpr str_env abs_env rhs `thenSa` \ new_rhs -> let - strflags = getStrAnalFlags str_env - -- Bind this binder to the abstract value of the RHS; analyse -- the body of the `let' in the extended environment. str_rhs_val = absEval StrAnal rhs str_env @@ -318,7 +302,7 @@ saExpr str_env abs_env (Let (NonRec binder rhs) body) -- Now determine the strictness of this binder; use that info -- to record DemandInfo/StrictnessInfo in the binder. - new_binder = addStrictnessInfoToId strflags + new_binder = addStrictnessInfoToId widened_str_rhs widened_abs_rhs (addDemandInfoToId str_env abs_env body binder) rhs @@ -329,7 +313,6 @@ saExpr str_env abs_env (Let (NonRec binder rhs) body) saExpr str_env abs_env (Let (Rec pairs) body) = let - strflags = getStrAnalFlags str_env (binders,rhss) = unzip pairs str_vals = fixpoint StrAnal binders rhss str_env abs_vals = fixpoint AbsAnal binders rhss abs_env @@ -352,7 +335,7 @@ saExpr str_env abs_env (Let (Rec pairs) body) -- deciding that y is absent, which is plain wrong! -- It's much easier simply not to do this. - improved_binders = zipWith4Equal "saExpr" (addStrictnessInfoToId strflags) + improved_binders = zipWith4Equal "saExpr" addStrictnessInfoToId str_vals abs_vals binders rhss whiter_than_white_binders = launder improved_binders @@ -396,14 +379,13 @@ tell how many args could safely be grabbed. \begin{code} addStrictnessInfoToId - :: StrAnalFlags - -> AbsVal -- Abstract strictness value + :: AbsVal -- Abstract strictness value -> AbsVal -- Ditto absence -> Id -- The id -> CoreExpr -- Its RHS -> Id -- Augmented with strictness -addStrictnessInfoToId strflags str_val abs_val binder body +addStrictnessInfoToId str_val abs_val binder body | isBot str_val = binder `addIdStrictness` mkBottomStrictnessInfo @@ -415,7 +397,7 @@ addStrictnessInfoToId strflags str_val abs_val binder body mkStrictnessInfo strictness Nothing where tys = map idType lambda_bounds - strictness = findStrictness strflags tys str_val abs_val + strictness = findStrictness tys str_val abs_val \end{code} \begin{code} -- 1.7.10.4