+mkTupleSelector vars the_var scrut_var scrut
+ = mk_tup_sel (chunkify vars) the_var
+ where
+ mk_tup_sel [vars] the_var = mkCoreSel vars the_var scrut_var scrut
+ mk_tup_sel vars_s the_var = mkCoreSel group the_var tpl_v $
+ mk_tup_sel (chunkify tpl_vs) tpl_v
+ where
+ tpl_tys = [mkCoreTupTy (map idType gp) | gp <- vars_s]
+ tpl_vs = mkTemplateLocals tpl_tys
+ [(tpl_v, group)] = [(tpl,gp) | (tpl,gp) <- zipEqual "mkTupleSelector" tpl_vs vars_s,
+ the_var `elem` gp ]
+\end{code}
+
+A generalization of @mkTupleSelector@, allowing the body
+of the case to be an arbitrary expression.
+
+If the tuple is big, it is nested:
+
+ mkTupleCase uniqs [a,b,c,d] body v e
+ = case e of v { (p,q) ->
+ case p of p { (a,b) ->
+ case q of q { (c,d) ->
+ body }}}
+
+To avoid shadowing, we use uniqs to invent new variables p,q.
+
+ToDo: eliminate cases where none of the variables are needed.
+
+\begin{code}
+mkTupleCase
+ :: UniqSupply -- for inventing names of intermediate variables
+ -> [Id] -- the tuple args
+ -> CoreExpr -- body of the case
+ -> Id -- a variable of the same type as the scrutinee
+ -> CoreExpr -- scrutinee
+ -> CoreExpr
+
+mkTupleCase uniqs vars body scrut_var scrut
+ = mk_tuple_case uniqs (chunkify vars) body
+ where
+ mk_tuple_case us [vars] body
+ = mkSmallTupleCase vars body scrut_var scrut
+ mk_tuple_case us vars_s body
+ = let
+ (us', vars', body') = foldr one_tuple_case (us, [], body) vars_s
+ in
+ mk_tuple_case us' (chunkify vars') body'
+ one_tuple_case chunk_vars (us, vs, body)
+ = let
+ (us1, us2) = splitUniqSupply us
+ scrut_var = mkSysLocal FSLIT("ds") (uniqFromSupply us1)
+ (mkCoreTupTy (map idType chunk_vars))
+ body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var)
+ in (us2, scrut_var:vs, body')
+\end{code}
+
+The same, but with a tuple small enough not to need nesting.
+
+\begin{code}
+mkSmallTupleCase
+ :: [Id] -- the tuple args
+ -> CoreExpr -- body of the case
+ -> Id -- a variable of the same type as the scrutinee
+ -> CoreExpr -- scrutinee
+ -> CoreExpr
+
+mkSmallTupleCase [var] body _scrut_var scrut
+ = bindNonRec var scrut body
+mkSmallTupleCase vars body scrut_var scrut
+-- One branch no refinement?
+ = Case scrut scrut_var (exprType body) [(DataAlt (tupleCon Boxed (length vars)), vars, body)]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[mkFailurePair]{Code for pattern-matching and other failures}
+%* *
+%************************************************************************
+
+Call the constructor Ids when building explicit lists, so that they
+interact well with rules.
+
+\begin{code}
+mkNilExpr :: Type -> CoreExpr
+mkNilExpr ty = mkConApp nilDataCon [Type ty]
+
+mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr
+mkConsExpr ty hd tl = mkConApp consDataCon [Type ty, hd, tl]
+
+mkListExpr :: Type -> [CoreExpr] -> CoreExpr
+mkListExpr ty xs = foldr (mkConsExpr ty) (mkNilExpr ty) xs
+
+
+-- The next three functions make tuple types, constructors and selectors,
+-- with the rule that a 1-tuple is represented by the thing itselg
+mkCoreTupTy :: [Type] -> Type
+mkCoreTupTy [ty] = ty
+mkCoreTupTy tys = mkTupleTy Boxed (length tys) tys
+
+mkCoreTup :: [CoreExpr] -> CoreExpr
+-- Builds exactly the specified tuple.
+-- No fancy business for big tuples
+mkCoreTup [] = Var unitDataConId
+mkCoreTup [c] = c
+mkCoreTup cs = mkConApp (tupleCon Boxed (length cs))
+ (map (Type . exprType) cs ++ cs)
+
+mkCoreSel :: [Id] -- The tuple args
+ -> Id -- The selected one
+ -> Id -- A variable of the same type as the scrutinee
+ -> CoreExpr -- Scrutinee
+ -> CoreExpr
+-- mkCoreSel [x,y,z] x v e
+-- ===> case e of v { (x,y,z) -> x
+mkCoreSel [var] should_be_the_same_var scrut_var scrut