+lookupVar (_, _, _, id_env) v = case lookupVarEnv id_env v of
+ Just (_, expr) -> expr
+ other -> Var v
+
+abstractVars :: Level -> LevelEnv -> VarSet -> [Var]
+ -- Find the variables in fvs, free vars of the target expresion,
+ -- whose level is greater than the destination level
+ -- These are the ones we are going to abstract out
+abstractVars dest_lvl env fvs
+ = uniq (sortLe le [var | fv <- varSetElems fvs, var <- absVarsOf dest_lvl env fv])
+ where
+ -- Sort the variables so we don't get
+ -- mixed-up tyvars and Ids; it's just messy
+ v1 `le` v2 = case (isId v1, isId v2) of
+ (True, False) -> False
+ (False, True) -> True
+ other -> v1 <= v2 -- Same family
+
+ uniq :: [Var] -> [Var]
+ -- Remove adjacent duplicates; the sort will have brought them together
+ uniq (v1:v2:vs) | v1 == v2 = uniq (v2:vs)
+ | otherwise = v1 : uniq (v2:vs)
+ uniq vs = vs
+
+absVarsOf :: Level -> LevelEnv -> Var -> [Var]
+ -- If f is free in the expression, and f maps to poly_f a b c in the
+ -- current substitution, then we must report a b c as candidate type
+ -- variables
+absVarsOf dest_lvl (_, lvl_env, _, id_env) v
+ | isId v
+ = [zap av2 | av1 <- lookup_avs v, av2 <- add_tyvars av1, abstract_me av2]
+
+ | otherwise
+ = if abstract_me v then [v] else []
+
+ where
+ abstract_me v = case lookupVarEnv lvl_env v of
+ Just lvl -> dest_lvl `ltLvl` lvl
+ Nothing -> False
+
+ lookup_avs v = case lookupVarEnv id_env v of
+ Just (abs_vars, _) -> abs_vars
+ Nothing -> [v]
+
+ add_tyvars v | isId v = v : varSetElems (idFreeTyVars v)
+ | otherwise = [v]
+
+ -- We are going to lambda-abstract, so nuke any IdInfo,
+ -- and add the tyvars of the Id (if necessary)
+ zap v | isId v = WARN( workerExists (idWorkerInfo v) ||
+ not (isEmptySpecInfo (idSpecialisation v)),
+ text "absVarsOf: discarding info on" <+> ppr v )
+ setIdInfo v vanillaIdInfo
+ | otherwise = v