projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2005-01-31 13:22:57 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
simplCore
/
SATMonad.lhs
diff --git
a/ghc/compiler/simplCore/SATMonad.lhs
b/ghc/compiler/simplCore/SATMonad.lhs
index
0c33a91
..
0df2551
100644
(file)
--- a/
ghc/compiler/simplCore/SATMonad.lhs
+++ b/
ghc/compiler/simplCore/SATMonad.lhs
@@
-14,7
+14,7
@@
module SATMonad where
#include "HsVersions.h"
#include "HsVersions.h"
-import Util ( panic )
+import Panic ( panic )
junk_from_SATMonad = panic "SATMonad.junk"
junk_from_SATMonad = panic "SATMonad.junk"
@@
-35,7
+35,7
@@
import Type ( mkTyVarTy, mkSigmaTy,
InstTyEnv(..)
)
import MkId ( mkSysLocal )
InstTyEnv(..)
)
import MkId ( mkSysLocal )
-import Id ( idType, idName, mkUserId )
+import Id ( idType, idName, mkLocalId )
import UniqSupply
import Util
import UniqSupply
import Util
@@
-139,7
+139,7
@@
newSATName id ty us env
let
new_name = mkCompoundName SLIT("$sat") unique (idName id)
in
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
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
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))) (
-> newSATName binder (new_ty tyargs args) `thenSAT` \ binder' ->
mkNewRhs binder binder' tyargs args rhs `thenSAT` \ new_rhs ->
trace ("SAT "++ show (length (filter isStatic args))) (
@@
-213,7
+213,7
@@
saTransform binder rhs
-- top-level or exported somehow.)
-- A better fix is to use binder directly but with the TopLevel
-- tag (or Exported tag) modified.
-- top-level or exported somehow.)
-- A better fix is to use binder directly but with the TopLevel
-- tag (or Exported tag) modified.
- fake_binder = mkSysLocal
+ fake_binder = mkSysLocal SLIT("sat")
(getUnique binder)
(idType binder)
rec_body = mkValLam non_static_args
(getUnique binder)
(idType binder)
rec_body = mkValLam non_static_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
-- 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
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
tau_ty' = glueTyArgs reg_arg_tys' res_type
mk_inst_tyenv [] _ = emptyVarEnv