-The general case:
-
-\begin{code}
-mkTupleBind tyvars dicts local_global_prs tuple_expr
- = --pprTrace "mkTupleBind:\n" (ppAboves [ppCat (map (pprId PprShowAll) locals), ppCat (map (pprId PprShowAll) globals), {-ppr PprDebug local_tuple, pprType PprDebug res_ty,-} ppr PprDebug tuple_expr]) $
-
- newSysLocalDs tuple_var_ty `thenDs` \ tuple_var ->
-
- zipWithDs (mk_selector (Var tuple_var))
- local_global_prs
- [(0::Int) .. (length local_global_prs - 1)]
- `thenDs` \ tup_selectors ->
- returnDs (
- (tuple_var, mkLam tyvars dicts tuple_expr)
- : tup_selectors
- )
- where
- locals, globals :: [Id]
- locals = [local | (local,global) <- local_global_prs]
- globals = [global | (local,global) <- local_global_prs]
-
- no_of_binders = length local_global_prs
- tyvar_tys = mkTyVarTys tyvars
-
- tuple_var_ty :: Type
- tuple_var_ty
- = mkForAllTys tyvars $
- mkRhoTy theta $
- applyTyCon (tupleTyCon no_of_binders)
- (map idType locals)
- where
- theta = mkTheta (map idType dicts)
-
- mk_selector :: CoreExpr -> (Id, Id) -> Int -> DsM (Id, CoreExpr)
-
- mk_selector tuple_var_expr (local, global) which_local
- = mapDs duplicateLocalDs locals{-the whole bunch-} `thenDs` \ binders ->
- let
- selected = binders !! which_local
- in
- returnDs (
- global,
- mkLam tyvars dicts (
- mkTupleSelector
- (mkValApp (mkTyApp tuple_var_expr tyvar_tys)
- (map VarArg dicts))
- binders
- selected)
- )
-\end{code}