Scope(..),
VM,
- noV, tryV, maybeV, orElseV, localV, closedV, initV,
+ noV, tryV, maybeV, orElseV, fixV, localV, closedV, initV,
cloneName, newLocalVar, newTyVar,
Builtins(..), paDictTyCon,
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
}
orElseV :: VM a -> VM a -> VM a
orElseV p q = maybe q return =<< tryV p
+fixV :: (a -> VM a) -> VM a
+fixV f = VM (\bi genv lenv -> fixDs $ \r -> runVM (f (unYes r)) bi genv lenv )
+ where
+ unYes (Yes _ _ x) = x
+
localV :: VM a -> VM a
localV p = do
env <- readLEnv id
u <- liftDs newUnique
return $ mkTyVar (mkSysTvName u fs) k
-defGlobalVar :: Var -> CoreExpr -> VM ()
-defGlobalVar v e = updGEnv $ \env -> env { global_vars = extendVarEnv (global_vars env) v e }
+defGlobalVar :: Var -> Var -> VM ()
+defGlobalVar v v' = updGEnv $ \env ->
+ env { global_vars = extendVarEnv (global_vars env) v (Var v')
+ , global_exported_vars = upd (global_exported_vars env)
+ }
+ where
+ upd env | isExportedId v = extendVarEnv env v (v, v')
+ | otherwise = env
lookupVar :: Var -> VM (Scope CoreExpr (CoreExpr, CoreExpr))
lookupVar v
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.
--