+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