- vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
- map varToCoreExpr alt_bndrs
-
- gadt_args = map (substExpr subst . varToCoreExpr) alt_bndrs
- -- This call generates some bogus warnings from substExpr,
- -- because it's inconvenient to put all the Ids in scope
- -- Will be fixed when we move to FC
-
- (alt_tvs, _) = span isTyVar alt_bndrs
- Just (tv_subst, is_local) = coreRefineTys data_con alt_tvs (idType case_bndr)
- subst = mkSubst in_scope tv_subst emptyVarEnv -- No Id substitition
- in_scope = mkInScopeSet (tyVarsOfTypes (varEnvElts tv_subst))
-
- env1 | is_local = env
- | otherwise = env { cons = refineConstrEnv subst (cons env) }
-
-
-extendAlt :: ScEnv -> Id -> CoreExpr -> ConValue -> [Var] -> ScEnv
-extendAlt env case_bndr scrut val alt_bndrs
- = let
- env1 = SCE { scope = extendVarEnvList (scope env) [(b,Other) | b <- case_bndr : alt_bndrs],
- cons = extendVarEnv (cons env) case_bndr val }
- in
- case scrut of
- Var v -> -- Bind the scrutinee in the ConstrEnv if it's a variable
- -- Also forget if the scrutinee is a RecArg, because we're
- -- now in the branch of a case, and we don't want to
- -- record a non-scrutinee use of v if we have
- -- case v of { (a,b) -> ...(f v)... }
- SCE { scope = extendVarEnv (scope env1) v Other,
- cons = extendVarEnv (cons env1) v val }
- other -> env1
-
- -- When we encounter a recursive function binding
- -- f = \x y -> ...
- -- we want to extend the scope env with bindings
- -- that record that f is a RecFn and x,y are RecArgs
-extendRecBndr env fn bndrs
- = env { scope = scope env `extendVarEnvList`
- ((fn,RecFun): [(bndr,RecArg) | bndr <- bndrs]) }
+ (subst', bndr') = substBndr (sc_subst env) bndr
+ hb_env' = extendVarEnv (sc_how_bound env) bndr' how_bound
+
+extendRecBndrs :: ScEnv -> [Var] -> (ScEnv, [Var])
+extendRecBndrs env bndrs = (env { sc_subst = subst' }, bndrs')
+ where
+ (subst', bndrs') = substRecBndrs (sc_subst env) bndrs
+
+extendBndr :: ScEnv -> Var -> (ScEnv, Var)
+extendBndr env bndr = (env { sc_subst = subst' }, bndr')
+ where
+ (subst', bndr') = substBndr (sc_subst env) bndr
+
+extendValEnv :: ScEnv -> Id -> Maybe Value -> ScEnv
+extendValEnv env _ Nothing = env
+extendValEnv env id (Just cv) = env { sc_vals = extendVarEnv (sc_vals env) id cv }
+
+extendCaseBndrs :: ScEnv -> CoreExpr -> Id -> AltCon -> [Var] -> ScEnv
+-- When we encounter
+-- case scrut of b
+-- C x y -> ...
+-- we want to bind b, and perhaps scrut too, to (C x y)
+-- NB: Extends only the sc_vals part of the envt
+extendCaseBndrs env scrut case_bndr con alt_bndrs
+ = case scrut of
+ Var v -> extendValEnv env1 v cval
+ _other -> env1
+ where
+ env1 = extendValEnv env case_bndr cval
+ cval = case con of
+ DEFAULT -> Nothing
+ LitAlt {} -> Just (ConVal con [])
+ DataAlt {} -> Just (ConVal con vanilla_args)
+ where
+ vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
+ varsToCoreExprs alt_bndrs