From: simonpj <unknown>
Date: Thu, 7 Sep 2000 16:28:44 +0000 (+0000)
Subject: [project @ 2000-09-07 16:28:44 by simonpj]
X-Git-Tag: Approximately_9120_patches~3771
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=2c7fe84e550ea0372f260d20db79f3275104a2ef;p=ghc-hetmet.git

[project @ 2000-09-07 16:28:44 by simonpj]
Do the begin-pass/end-pass stuff like the other core passes
---

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index f3ba9c4..3fbdc74 100644
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -72,16 +72,14 @@ tidyCorePgm us module_name binds_in rulebase_in
   = do
 	beginPass "Tidy Core"
 
-        (binds_in1,mrulebase_in1) <- if opt_UsageSPOn
-                                     then _scc_ "CoreUsageSPInf"
-                                          doUsageSPInf us binds_in rulebase_in
-                                     else return (binds_in,Nothing)
+        binds_in1 <- if opt_UsageSPOn
+                     then _scc_ "CoreUsageSPInf"
+                                doUsageSPInf us binds_in rulebase_in
+                     else return binds_in
 
-	let rulebase_in1            = maybe rulebase_in id mrulebase_in1
-
-            (tidy_env1, binds_out)  = mapAccumL (tidyBind (Just module_name))
+	let (tidy_env1, binds_out)  = mapAccumL (tidyBind (Just module_name))
                                                 init_tidy_env binds_in1
-	    rules_out	  	    = tidyProtoRules tidy_env1 (mk_local_protos rulebase_in1)
+	    rules_out	  	    = tidyProtoRules tidy_env1 (mk_local_protos rulebase_in)
 
 	endPass "Tidy Core" (opt_D_dump_simpl || opt_D_verbose_core2core) binds_out
 	return (binds_out, rules_out)
diff --git a/ghc/compiler/usageSP/UsageSPInf.lhs b/ghc/compiler/usageSP/UsageSPInf.lhs
index bfd5e71..0cdf16f 100644
--- a/ghc/compiler/usageSP/UsageSPInf.lhs
+++ b/ghc/compiler/usageSP/UsageSPInf.lhs
@@ -39,7 +39,8 @@ import UniqSupply       ( UniqSupply, UniqSM,
 import Outputable
 import Maybes           ( expectJust )
 import List             ( unzip4 )
-import CmdLineOpts	( opt_D_dump_usagesp, opt_DoUSPLinting )
+import CmdLineOpts	( opt_D_dump_usagesp, opt_DoUSPLinting, opt_UsageSPOn )
+import CoreLint		( beginPass, endPass )
 import ErrUtils		( doIfSet, dumpIfSet )
 import PprCore          ( pprCoreBindings )
 \end{code}
@@ -91,36 +92,42 @@ monad.
 doUsageSPInf :: UniqSupply
              -> [CoreBind]
              -> RuleBase
-             -> IO ([CoreBind], Maybe RuleBase)
+             -> IO [CoreBind]
 
 doUsageSPInf us binds local_rules
-                      = do
-                           let binds1      = doUnAnnotBinds binds
-
-                           dumpIfSet opt_D_dump_usagesp "UsageSPInf unannot'd" $
+  | not opt_UsageSPOn
+  = do { printErrs (text "WARNING: ignoring requested -fusagesp pass; requires -fusagesp-on") ;
+	 return binds
+    }
+      
+  | otherwise
+  = do
+        let binds1 = doUnAnnotBinds binds
+
+	beginPass "UsageSPInf"
+
+        dumpIfSet opt_D_dump_usagesp "UsageSPInf unannot'd" $
                              pprCoreBindings binds1
 
-                           let ((binds2,ucs,_),_)
-                                      = initUs us (uniqSMMToUs (usgInfBinds emptyVarEnv binds1))
-
-                           dumpIfSet opt_D_dump_usagesp "UsageSPInf annot'd" $
-                             pprCoreBindings binds2
-
-                           let ms     = solveUCS ucs
-                               s      = case ms of
-                                          Just s  -> s
-                                          Nothing -> panic "doUsageSPInf: insol. conset!"
-                               binds3 = appUSubstBinds s binds2
-
-                           doIfSet opt_DoUSPLinting $
-                             do doLintUSPAnnotsBinds binds3     -- lint check 1
-                                doLintUSPConstBinds  binds3     -- lint check 2 (force solution)
-                                doCheckIfWorseUSP binds binds3  -- check for worsening of usages
-
-                           dumpIfSet opt_D_dump_usagesp "UsageSPInf" $
-                             pprCoreBindings binds3
+        let ((binds2,ucs,_),_) = initUs us (uniqSMMToUs (usgInfBinds emptyVarEnv binds1))
 
-                           return (binds3, Nothing)
+        dumpIfSet opt_D_dump_usagesp "UsageSPInf annot'd" $
+          pprCoreBindings binds2
+	
+        let ms     = solveUCS ucs
+            s      = case ms of
+                       Just s  -> s
+                       Nothing -> panic "doUsageSPInf: insol. conset!"
+            binds3 = appUSubstBinds s binds2
+	
+        doIfSet opt_DoUSPLinting $
+          do doLintUSPAnnotsBinds binds3     -- lint check 1
+             doLintUSPConstBinds  binds3     -- lint check 2 (force solution)
+             doCheckIfWorseUSP binds binds3  -- check for worsening of usages
+	
+        endPass "UsageSPInf" opt_D_dump_usagesp binds3
+	
+        return binds3
 \end{code}
 
 ======================================================================
diff --git a/ghc/compiler/usageSP/UsageSPUtils.lhs b/ghc/compiler/usageSP/UsageSPUtils.lhs
index 9246709..96cd002 100644
--- a/ghc/compiler/usageSP/UsageSPUtils.lhs
+++ b/ghc/compiler/usageSP/UsageSPUtils.lhs
@@ -165,7 +165,7 @@ for us.  @sigVarTyMF@ checks the variable to see how to set the flags.
 
 @hasLocalDef@ tells us if the given variable has an actual local
 definition that we can play with.  This is not quite the same as
-@isLocallyDefined@, since @mayHaveNoBindingId@ things (usually) don't have
+@isLocallyDefined@, since @hasNoBindingId@ things (usually) don't have
 a local definition - the simplifier will inline whatever their
 unfolding is anyway.  We treat these as if they were externally
 defined, since we don't have access to their definition (at least not