X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSAT.lhs;h=81f3c4c406d83b0e197e42f723b8951b72c5ed64;hb=e8964a486b2d0915617116eedf8b34670d443fbf;hp=d4fb6e6fb153fe3c95f2b0b9426c65e5dc56e7fa;hpb=9dd6e1c216993624a2cd74b62ca0f0569c02c26b;p=ghc-hetmet.git diff --git a/ghc/compiler/simplCore/SAT.lhs b/ghc/compiler/simplCore/SAT.lhs index d4fb6e6..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-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % %************************************************************************ %* * @@ -42,7 +42,7 @@ module SAT ( doStaticArgs ) where #include "HsVersions.h" -import Util ( panic ) +import Panic ( panic ) doStaticArgs = panic "SAT.doStaticArgs (ToDo)" @@ -53,10 +53,16 @@ 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_` @@ -92,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 @@ -163,13 +165,9 @@ satExpr (Let (Rec binds) body) mapSAT satExpr rhss `thenSAT` \ rhss' -> returnSAT (Let (Rec (zipEqual "satExpr:Rec" binders rhss')) body') -satExpr (SCC cc expr) - = satExpr expr `thenSAT` \ expr2 -> - returnSAT (SCC cc expr2) - -satExpr (Coerce c ty expr) +satExpr (Note note expr) = satExpr expr `thenSAT` \ expr2 -> - returnSAT (Coerce c ty expr2) + returnSAT (Note note expr2) \end{code} \begin{code}