[project @ 2003-06-27 18:28:31 by sof]

[ghc-hetmet.git] / ghc / compiler / simplCore / SATMonad.lhs

diff --git a/ghc/compiler/simplCore/SATMonad.lhs b/ghc/compiler/simplCore/SATMonad.lhs
index 3982c8a..0df2551 100644 (file)
--- a/ghc/compiler/simplCore/SATMonad.lhs
+++ b/ghc/compiler/simplCore/SATMonad.lhs
@@ -35,7 +35,7 @@ import Type           ( mkTyVarTy, mkSigmaTy,
                          InstTyEnv(..)
                        )
 import MkId            ( mkSysLocal )
-import Id              ( idType, idName, mkUserId )
+import Id              ( idType, idName, mkLocalId )
 import UniqSupply
 import Util
 
@@ -139,7 +139,7 @@ newSATName id ty us env
     let
        new_name = mkCompoundName SLIT("$sat") unique (idName id)
     in
-    (mkUserId new_name ty, env) }
+    (mkLocalId new_name ty, env) }
 
 getArgLists :: CoreExpr -> ([Arg Type],[Arg Id])
 getArgLists expr
@@ -179,7 +179,7 @@ saTransform binder rhs
     case r of
       -- [Andre] test: do it only if we have more than one static argument.
       --Just (tyargs,args) | any isStatic args
-      Just (tyargs,args) | length (filter isStatic args) > 1
+      Just (tyargs,args) | (filter isStatic args) `lengthExceeds` 1
        -> newSATName binder (new_ty tyargs args)  `thenSAT` \ binder' ->
           mkNewRhs binder binder' tyargs args rhs `thenSAT` \ new_rhs ->
           trace ("SAT "++ show (length (filter isStatic args))) (
@@ -240,10 +240,12 @@ saTransform binder rhs
 
        -- now, we drop the ones that are
        -- static, that is, the ones we will not pass to the local function
-       l            = length dict_tys
        tv_tmpl'     = dropStatics tyargs tv_tmpl
-       dict_tys'    = dropStatics (take l args) dict_tys
-       reg_arg_tys' = dropStatics (drop l args) reg_arg_tys
+
+       (args1, args2) = splitAtList dict_tys args
+       dict_tys'    = dropStatics args1 dict_tys
+       reg_arg_tys' = dropStatics args2 reg_arg_tys
+
        tau_ty'      = glueTyArgs reg_arg_tys' res_type
 
        mk_inst_tyenv []                    _ = emptyVarEnv