+lookupVar :: Var -> VM (Scope Var (Var, Var))
+lookupVar v
+ = do
+ r <- readLEnv $ \env -> lookupVarEnv (local_vars env) v
+ case r of
+ Just e -> return (Local e)
+ Nothing -> liftM Global
+ $ traceMaybeV "lookupVar" (ppr v)
+ (readGEnv $ \env -> lookupVarEnv (global_vars env) v)
+
+lookupTyCon :: TyCon -> VM (Maybe TyCon)
+lookupTyCon tc
+ | isUnLiftedTyCon tc || isTupleTyCon tc = return (Just tc)
+
+ | otherwise = readGEnv $ \env -> lookupNameEnv (global_tycons env) (tyConName tc)
+
+defTyCon :: TyCon -> TyCon -> VM ()
+defTyCon tc tc' = updGEnv $ \env ->
+ env { global_tycons = extendNameEnv (global_tycons env) (tyConName tc) tc' }
+
+lookupDataCon :: DataCon -> VM (Maybe DataCon)
+lookupDataCon dc
+ | isTupleTyCon (dataConTyCon dc) = return (Just dc)
+ | otherwise = readGEnv $ \env -> lookupNameEnv (global_datacons env) (dataConName dc)
+
+defDataCon :: DataCon -> DataCon -> VM ()
+defDataCon dc dc' = updGEnv $ \env ->
+ env { global_datacons = extendNameEnv (global_datacons env) (dataConName dc) dc' }
+
+lookupPrimPArray :: TyCon -> VM (Maybe TyCon)
+lookupPrimPArray = liftDs . primPArray
+
+lookupPrimMethod :: TyCon -> String -> VM (Maybe Var)
+lookupPrimMethod tycon = liftDs . primMethod tycon
+
+lookupTyConPA :: TyCon -> VM (Maybe Var)
+lookupTyConPA tc = readGEnv $ \env -> lookupNameEnv (global_pa_funs env) (tyConName tc)
+
+defTyConPA :: TyCon -> Var -> VM ()
+defTyConPA tc pa = updGEnv $ \env ->
+ env { global_pa_funs = extendNameEnv (global_pa_funs env) (tyConName tc) pa }
+
+defTyConPAs :: [(TyCon, Var)] -> VM ()
+defTyConPAs ps = updGEnv $ \env ->
+ env { global_pa_funs = extendNameEnvList (global_pa_funs env)
+ [(tyConName tc, pa) | (tc, pa) <- ps] }
+
+lookupTyVarPA :: Var -> VM (Maybe CoreExpr)
+lookupTyVarPA tv = readLEnv $ \env -> lookupVarEnv (local_tyvar_pa env) tv
+
+lookupTyConPR :: TyCon -> VM (Maybe Var)
+lookupTyConPR tc = readGEnv $ \env -> lookupNameEnv (global_pr_funs env) (tyConName tc)
+
+lookupBoxedTyCon :: TyCon -> VM (Maybe TyCon)
+lookupBoxedTyCon tc = readGEnv $ \env -> lookupNameEnv (global_boxed_tycons env)
+ (tyConName tc)
+
+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
+ }
+
+localTyVars :: VM [TyVar]
+localTyVars = readLEnv (reverse . local_tyvars)
+
+-- Look up the dfun of a class instance.
+--
+-- The match must be unique - ie, match exactly one instance - but the
+-- type arguments used for matching may be more specific than those of
+-- the class instance declaration. The found class instances must not have
+-- any type variables in the instance context that do not appear in the
+-- instances head (i.e., no flexi vars); for details for what this means,
+-- see the docs at InstEnv.lookupInstEnv.
+--
+{-
+lookupInst :: Class -> [Type] -> VM (DFunId, [Type])
+lookupInst cls tys
+ = do { instEnv <- getInstEnv
+ ; case lookupInstEnv instEnv cls tys of
+ ([(inst, inst_tys)], _)
+ | noFlexiVar -> return (instanceDFunId inst, inst_tys')
+ | otherwise -> pprPanic "VectMonad.lookupInst: flexi var: "
+ (ppr $ mkTyConApp (classTyCon cls) tys)
+ where
+ inst_tys' = [ty | Right ty <- inst_tys]
+ noFlexiVar = all isRight inst_tys
+ _other -> traceNoV "lookupInst" (ppr cls <+> ppr tys)
+ }
+ where
+ isRight (Left _) = False
+ isRight (Right _) = True
+-}
+
+-- Look up the representation tycon of a family instance.
+--
+-- The match must be unique - ie, match exactly one instance - but the
+-- type arguments used for matching may be more specific than those of
+-- the family instance declaration.
+--
+-- Return the instance tycon and its type instance. For example, if we have
+--
+-- lookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
+--
+-- then we have a coercion (ie, type instance of family instance coercion)
+--
+-- :Co:R42T Int :: T [Int] ~ :R42T Int
+--
+-- which implies that :R42T was declared as 'data instance T [a]'.
+--
+lookupFamInst :: TyCon -> [Type] -> VM (TyCon, [Type])
+lookupFamInst tycon tys
+ = ASSERT( isOpenTyCon tycon )
+ do { instEnv <- getFamInstEnv
+ ; case lookupFamInstEnv instEnv tycon tys of
+ [(fam_inst, rep_tys)] -> return (famInstTyCon fam_inst, rep_tys)
+ _other ->
+ pprPanic "VectMonad.lookupFamInst: not found: "
+ (ppr $ mkTyConApp tycon tys)
+ }