-\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
- = ASSERT(var == should_be_the_same_var)
- scrut
-
-mkCoreSel vars the_var scrut_var scrut
- = ASSERT( notNull vars )
- Case scrut scrut_var (idType the_var)
- [(DataAlt (tupleCon Boxed (length vars)), vars, Var the_var)]