X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSAT.lhs;h=81f3c4c406d83b0e197e42f723b8951b72c5ed64;hb=0f800dc9f3dc695cd06d0fdd7799a52c37241752;hp=dbd4f54000fd2490d1de4255ed2f6fbee22b534d;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SAT.lhs b/ghc/compiler/simplCore/SAT.lhs
index dbd4f54..81f3c4c 100644
--- a/ghc/compiler/simplCore/SAT.lhs
+++ b/ghc/compiler/simplCore/SAT.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 %************************************************************************
 %*									*
@@ -7,6 +7,8 @@
 %*									*
 %************************************************************************
 
+96/03: We aren't using the static-argument transformation right now.
+
 May be seen as removing invariants from loops:
 Arguments of recursive functions that do not change in recursive
 calls are removed from the recursion, which is done locally
@@ -36,24 +38,31 @@ Experimental Evidence: Heap: +/- 7%
 		       Instrs: Always improves for 2 or more Static Args.
 
 \begin{code}
+module SAT ( doStaticArgs ) where
+
 #include "HsVersions.h"
 
-module SAT (
-	doStaticArgs
+import Panic	( panic )
 
-	-- and to make the interface self-sufficient...
-    ) where
+doStaticArgs = panic "SAT.doStaticArgs (ToDo)"
+
+{- LATER: to end of file:
 
-import Maybes		( Maybe(..) )
 import SATMonad
 import Util
 \end{code}
 
 \begin{code}
-doStaticArgs :: [CoreBinding] -> UniqSupply -> [CoreBinding]
+doStaticArgs :: [CoreBind] -> UniqSupply -> [CoreBind]
 
 doStaticArgs binds
-  = initSAT (mapSAT sat_bind binds)
+  = do {
+	showPass "Static argument";
+	let { binds' = initSAT (mapSAT sat_bind binds) };
+	endPass "Static argument" 
+		False		-- No specific flag for dumping SAT
+		binds'
+    }
   where
     sat_bind (NonRec binder expr)
       = emptyEnvSAT  `thenSAT_`
@@ -67,7 +76,7 @@ doStaticArgs binds
     sat_bind (Rec pairs)
       = emptyEnvSAT		`thenSAT_`
 	mapSAT satExpr rhss	`thenSAT` \ rhss' ->
-	returnSAT (Rec (binders `zip` rhss'))
+	returnSAT (Rec (zipEqual "doStaticArgs" binders rhss'))
       where
 	(binders, rhss)	= unzip pairs
 \end{code}
@@ -89,10 +98,6 @@ satExpr var@(Var v)
 
 satExpr lit@(Lit _) = returnSAT lit
 
-satExpr e@(Con con types args)
-  = mapSAT satAtom args	    `thenSAT_`
-    returnSAT e
-
 satExpr e@(Prim prim ty args)
   = mapSAT satAtom args	    `thenSAT_`
     returnSAT e
@@ -158,11 +163,11 @@ satExpr (Let (Rec binds) body)
     in
     satExpr body		    `thenSAT` \ body' ->
     mapSAT satExpr rhss		    `thenSAT` \ rhss' ->
-    returnSAT (Let (Rec (binders `zip` rhss')) body')
+    returnSAT (Let (Rec (zipEqual "satExpr:Rec" binders rhss')) body')
 
-satExpr (SCC cc expr)
+satExpr (Note note expr)
   = satExpr expr		    `thenSAT` \ expr2 ->
-    returnSAT (SCC cc expr2)
+    returnSAT (Note note expr2)
 \end{code}
 
 \begin{code}
@@ -205,5 +210,5 @@ getAppArgs app
     get e
       = satExpr e	`thenSAT` \ e2 ->
 	returnSAT (e2, Nothing)
+-}
 \end{code}
-