core_body,
exprFreeVars core_binds `intersectVarSet` local_vars)
-dsCmd ids local_vars env_ids [] res_ty (HsDo _ctxt stmts body _)
+dsCmd ids local_vars env_ids [] res_ty (HsDo _ctxt stmts body _ _)
= dsCmdDo ids local_vars env_ids res_ty stmts body
-- A |- e :: forall e. a1 (e*ts1) t1 -> ... an (e*tsn) tn -> a (e*ts) t
-- ---> arr (\ (xs) -> ((xs1),(xs'))) >>> first c >>>
-- arr snd >>> ss
-dsCmdStmt ids local_vars env_ids out_ids (ExprStmt cmd _ c_ty) = do
+dsCmdStmt ids local_vars env_ids out_ids (ExprStmt cmd _ _ c_ty) = do
(core_cmd, fv_cmd, env_ids1) <- dsfixCmd ids local_vars [] c_ty cmd
core_mux <- matchEnvStack env_ids []
(mkCorePairExpr (mkBigCoreVarTup env_ids1) (mkBigCoreVarTup out_ids))
dsCmdStmt ids local_vars env_ids out_ids
(RecStmt { recS_stmts = stmts, recS_later_ids = later_ids, recS_rec_ids = rec_ids
- , recS_rec_rets = rhss, recS_dicts = _binds }) = do
- let -- ToDo: ****** binds not desugared; ROSS PLEASE FIX ********
+ , recS_rec_rets = rhss }) = do
+ let
env2_id_set = mkVarSet out_ids `minusVarSet` mkVarSet later_ids
env2_ids = varSetElems env2_id_set
env2_ty = mkBigCoreVarTupTy env2_ids
= go pat
where
go (VarPat var) = var : bndrs
- go (VarPatOut var bs) = var : collectEvBinders bs
- ++ bndrs
go (WildPat _) = bndrs
go (LazyPat pat) = collectl pat bndrs
go (BangPat pat) = collectl pat bndrs