projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
fd9c8b7
)
convert type variables to TcTyVars, otherwise the typechecker gets confused
author
Simon Marlow
<simonmar@microsoft.com>
Tue, 24 Apr 2007 14:18:47 +0000
(14:18 +0000)
committer
Simon Marlow
<simonmar@microsoft.com>
Tue, 24 Apr 2007 14:18:47 +0000
(14:18 +0000)
compiler/main/GHC.hs
patch
|
blob
|
history
diff --git
a/compiler/main/GHC.hs
b/compiler/main/GHC.hs
index
57cf7bb
..
d976152
100644
(file)
--- a/
compiler/main/GHC.hs
+++ b/
compiler/main/GHC.hs
@@
-214,8
+214,11
@@
import NameSet
import RdrName
import HsSyn
import Type hiding (typeKind)
import RdrName
import HsSyn
import Type hiding (typeKind)
+import TcType hiding (typeKind)
import Id
import Var hiding (setIdType)
import Id
import Var hiding (setIdType)
+import VarEnv
+import VarSet
import TysPrim ( alphaTyVars )
import TyCon
import Class
import TysPrim ( alphaTyVars )
import TyCon
import Class
@@
-2320,13
+2323,22
@@
extendEnvironment hsc_env apStack idsOffsets occs = do
let (ids, hValues) = unzip idsVals
new_ids <- zipWithM mkNewId occs ids
let names = map idName ids
let (ids, hValues) = unzip idsVals
new_ids <- zipWithM mkNewId occs ids
let names = map idName ids
+
+ let tyvars = varSetElems (tyVarsOfTypes (map idType new_ids))
+ new_tyvars = map (mkTyVarTy . mk_skol) tyvars
+ mk_skol tyvar = mkTcTyVar (tyVarName tyvar) (tyVarKind tyvar)
+ (SkolemTv UnkSkol)
+ subst = mkTvSubst emptyInScopeSet (mkVarEnv (zip tyvars new_tyvars))
+ subst_id id = id `setIdType` substTy subst (idType id)
+ subst_ids = map subst_id new_ids
+
Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknownTyConName
let result_name = mkSystemVarName (mkBuiltinUnique 33) FSLIT("_result")
result_id = Id.mkLocalId result_name (mkTyConApp unknown_tc [])
let ictxt = hsc_IC hsc_env
rn_env = ic_rn_local_env ictxt
type_env = ic_type_env ictxt
Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknownTyConName
let result_name = mkSystemVarName (mkBuiltinUnique 33) FSLIT("_result")
result_id = Id.mkLocalId result_name (mkTyConApp unknown_tc [])
let ictxt = hsc_IC hsc_env
rn_env = ic_rn_local_env ictxt
type_env = ic_type_env ictxt
- all_new_ids = result_id : new_ids
+ all_new_ids = result_id : subst_ids
bound_names = map idName all_new_ids
new_rn_env = extendLocalRdrEnv rn_env bound_names
-- Remove any shadowed bindings from the type_env;
bound_names = map idName all_new_ids
new_rn_env = extendLocalRdrEnv rn_env bound_names
-- Remove any shadowed bindings from the type_env;
@@
-2345,7
+2357,6
@@
extendEnvironment hsc_env apStack idsOffsets occs = do
where
mkNewId :: OccName -> Id -> IO Id
mkNewId occ id = do
where
mkNewId :: OccName -> Id -> IO Id
mkNewId occ id = do
- ty <- instantiateTyVarsToUnknown hsc_env
let uniq = idUnique id
loc = nameSrcLoc (idName id)
name = mkInternalName uniq occ loc
let uniq = idUnique id
loc = nameSrcLoc (idName id)
name = mkInternalName uniq occ loc