From f82fe6c8b3675b36b1650a62bc78b42242c0aca8 Mon Sep 17 00:00:00 2001 From: sof Date: Thu, 5 Jun 1997 21:08:51 +0000 Subject: [PATCH] [project @ 1997-06-05 21:08:51 by sof] removed auto-scc annotation (now done in dsBinds) --- ghc/compiler/deSugar/Desugar.lhs | 44 +++++++------------------------------- 1 file changed, 8 insertions(+), 36 deletions(-) diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs index a967bc0..209a8f9 100644 --- a/ghc/compiler/deSugar/Desugar.lhs +++ b/ghc/compiler/deSugar/Desugar.lhs @@ -24,13 +24,11 @@ import TcHsSyn ( SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedHsExpr) import CoreSyn import Name ( isExported ) import DsMonad -import DsBinds ( dsBinds, dsMonoBinds ) +import DsBinds ( dsBinds ) import DsUtils import Bag ( unionBags ) -import CmdLineOpts ( opt_DoCoreLinting, opt_AutoSccsOnAllToplevs, - opt_AutoSccsOnExportedToplevs, opt_SccGroup - ) +import CmdLineOpts ( opt_DoCoreLinting, opt_SccGroup ) import CostCentre ( IsCafCC(..), mkAutoCC ) import CoreLift ( liftCoreBindings ) import CoreLint ( lintCoreBindings ) @@ -72,23 +70,23 @@ deSugar us mod_name (recsel_binds, clas_binds, inst_binds, val_binds, const_inst Nothing -> mod_name -- default: module name (core_const_binds, shadows1) - = initDs us0 nullIdEnv mod_name (dsBinds const_inst_binds) + = initDs us0 nullIdEnv mod_name (dsBinds Nothing const_inst_binds) core_const_prs = pairsFromCoreBinds core_const_binds (core_clas_binds, shadows2) - = initDs us1 nullIdEnv mod_name (dsBinds clas_binds) + = initDs us1 nullIdEnv mod_name (dsBinds Nothing clas_binds) core_clas_prs = pairsFromCoreBinds core_clas_binds (core_inst_binds, shadows3) - = initDs us2 nullIdEnv mod_name (dsBinds inst_binds) + = initDs us2 nullIdEnv mod_name (dsBinds Nothing inst_binds) core_inst_prs = pairsFromCoreBinds core_inst_binds (core_val_binds, shadows4) - = initDs us3 nullIdEnv mod_name (dsBinds val_binds) - core_val_pairs = map (addAutoScc module_and_group) (pairsFromCoreBinds core_val_binds) + = initDs us3 nullIdEnv mod_name (dsBinds (Just module_and_group) val_binds) + core_val_pairs = pairsFromCoreBinds core_val_binds (core_recsel_binds, shadows5) - = initDs us4 nullIdEnv mod_name (dsBinds recsel_binds) + = initDs us4 nullIdEnv mod_name (dsBinds Nothing recsel_binds) core_recsel_prs = pairsFromCoreBinds core_recsel_binds final_binds @@ -112,29 +110,3 @@ deSugar us mod_name (recsel_binds, clas_binds, inst_binds, val_binds, const_inst in (really_final_binds, shadows) \end{code} - - -%************************************************************************ -%* * -\subsection[addAutoScc]{Adding automatic sccs} -%* * -%************************************************************************ - -\begin{code} -addAutoScc :: (FAST_STRING, FAST_STRING) -- Module and group - -> (Id, CoreExpr) - -> (Id,CoreExpr) - -addAutoScc (mod, grp) pair@(bndr, core_expr) - | worthSCC core_expr && - (opt_AutoSccsOnAllToplevs || - (isExported bndr && opt_AutoSccsOnExportedToplevs)) - = (bndr, SCC (mkAutoCC bndr mod grp IsNotCafCC) core_expr) - - | otherwise - = pair - -worthSCC (SCC _ _) = False -worthSCC (Con _ _) = False -worthSCC core_expr = True -\end{code} -- 1.7.10.4