- 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 (mkTupleTyCon 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)
- )
+mkTupleBind locals tuple_expr
+ = newSysLocalDs (coreExprType tuple_expr) `thenDs` \ tuple_var ->
+ let
+ mk_bind local = (local, mkTupleSelector locals local (Var tuple_var))
+ in
+ returnDs ( (tuple_var, tuple_expr) :
+ map mk_bind locals )