projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1998-12-02 13:17:09 by simonm]
[ghc-hetmet.git]
/
ghc
/
compiler
/
simplCore
/
SAT.lhs
diff --git
a/ghc/compiler/simplCore/SAT.lhs
b/ghc/compiler/simplCore/SAT.lhs
index
062dada
..
c79a174
100644
(file)
--- a/
ghc/compiler/simplCore/SAT.lhs
+++ b/
ghc/compiler/simplCore/SAT.lhs
@@
-1,5
+1,5
@@
%
%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
%************************************************************************
%* *
%
%************************************************************************
%* *
@@
-38,27
+38,31
@@
Experimental Evidence: Heap: +/- 7%
Instrs: Always improves for 2 or more Static Args.
\begin{code}
Instrs: Always improves for 2 or more Static Args.
\begin{code}
-#include "HsVersions.h"
-
module SAT ( doStaticArgs ) where
module SAT ( doStaticArgs ) where
-import Ubiq{-uitous-}
+#include "HsVersions.h"
+
import Util ( panic )
doStaticArgs = panic "SAT.doStaticArgs (ToDo)"
{- LATER: to end of file:
import Util ( panic )
doStaticArgs = panic "SAT.doStaticArgs (ToDo)"
{- LATER: to end of file:
-import Maybes ( Maybe(..) )
import SATMonad
import Util
\end{code}
\begin{code}
import SATMonad
import Util
\end{code}
\begin{code}
-doStaticArgs :: [CoreBinding] -> UniqSupply -> [CoreBinding]
+doStaticArgs :: [CoreBind] -> UniqSupply -> [CoreBind]
doStaticArgs binds
doStaticArgs binds
- = initSAT (mapSAT sat_bind binds)
+ = do {
+ beginPass "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_`
where
sat_bind (NonRec binder expr)
= emptyEnvSAT `thenSAT_`
@@
-72,7
+76,7
@@
doStaticArgs binds
sat_bind (Rec pairs)
= emptyEnvSAT `thenSAT_`
mapSAT satExpr rhss `thenSAT` \ rhss' ->
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}
where
(binders, rhss) = unzip pairs
\end{code}
@@
-163,15
+167,11
@@
satExpr (Let (Rec binds) body)
in
satExpr body `thenSAT` \ body' ->
mapSAT satExpr rhss `thenSAT` \ rhss' ->
in
satExpr body `thenSAT` \ body' ->
mapSAT satExpr rhss `thenSAT` \ rhss' ->
- returnSAT (Let (Rec (binders `zip` rhss')) body')
-
-satExpr (SCC cc expr)
- = satExpr expr `thenSAT` \ expr2 ->
- returnSAT (SCC cc expr2)
+ returnSAT (Let (Rec (zipEqual "satExpr:Rec" binders rhss')) body')
-satExpr (Coerce c ty expr)
+satExpr (Note note expr)
= satExpr expr `thenSAT` \ expr2 ->
= satExpr expr `thenSAT` \ expr2 ->
- returnSAT (Coerce c ty expr2)
+ returnSAT (Note note expr2)
\end{code}
\begin{code}
\end{code}
\begin{code}