defGlobalVar, lookupVar,
lookupTyCon,
- lookupTyVarPA, extendTyVarPA, deleteTyVarPA,
+ lookupTyVarPA, defLocalTyVar, defLocalTyVarWithPA, localTyVars,
lookupInst, lookupFamInst
) where
--
local_vars :: VarEnv (CoreExpr, CoreExpr)
+ -- In-scope type variables
+ --
+ , local_tyvars :: [TyVar]
+
-- Mapping from tyvars to their PA dictionaries
, local_tyvar_pa :: VarEnv CoreExpr
}
emptyLocalEnv = LocalEnv {
local_vars = emptyVarEnv
+ , local_tyvars = []
, local_tyvar_pa = emptyVarEnv
}
lookupTyVarPA :: Var -> VM (Maybe CoreExpr)
lookupTyVarPA tv = readLEnv $ \env -> lookupVarEnv (local_tyvar_pa env) tv
-extendTyVarPA :: Var -> CoreExpr -> VM ()
-extendTyVarPA tv pa = updLEnv $ \env -> env { local_tyvar_pa = extendVarEnv (local_tyvar_pa env) tv pa }
+defLocalTyVar :: TyVar -> VM ()
+defLocalTyVar tv = updLEnv $ \env ->
+ env { local_tyvars = tv : local_tyvars env
+ , local_tyvar_pa = local_tyvar_pa env `delVarEnv` tv
+ }
+
+defLocalTyVarWithPA :: TyVar -> CoreExpr -> VM ()
+defLocalTyVarWithPA tv pa = updLEnv $ \env ->
+ env { local_tyvars = tv : local_tyvars env
+ , local_tyvar_pa = extendVarEnv (local_tyvar_pa env) tv pa
+ }
-deleteTyVarPA :: Var -> VM ()
-deleteTyVarPA tv = updLEnv $ \env -> env { local_tyvar_pa = delVarEnv (local_tyvar_pa env) tv }
+localTyVars :: VM [TyVar]
+localTyVars = readLEnv (reverse . local_tyvars)
-- Look up the dfun of a class instance.
--
abstractOverTyVars tvs p
= do
mdicts <- mapM mk_dict_var tvs
- zipWithM_ (\tv -> maybe (deleteTyVarPA tv) (extendTyVarPA tv . Var)) tvs mdicts
+ zipWithM_ (\tv -> maybe (defLocalTyVar tv) (defLocalTyVarWithPA tv . Var)) tvs mdicts
p (mk_lams mdicts)
where
mk_dict_var tv = do
vectExpr lc (fvs, AnnLam bndr body)
= do
- let tyvars = filter isTyVar (varSetElems fvs)
+ tyvars <- localTyVars
info <- mkCEnvInfo fvs bndr body
(poly_vfn, poly_lfn) <- mkClosureFns info tyvars bndr body