-tcMcStmt ctxt (GroupStmt stmts bindersMap by using return_op bind_op liftM_op) elt_ty thing_inside
- = do { let (bndr_names, m_bndr_names) = unzip bindersMap
-
- ; (_,(m_ty,_)) <- matchExpectedAppTy elt_ty
- ; let alphaMTy = m_ty `mkAppTy` alphaTy
- alphaMMTy = m_ty `mkAppTy` alphaMTy
-
- -- We don't know the type of the bindings yet. It's not elt_ty!
- ; bndr_ty_dummy <- newFlexiTyVarTy liftedTypeKind
-
- ; (stmts', (bndr_ids, by', using_ty, return_op', bind_op')) <-
- tcStmts (TransformStmtCtxt ctxt) tcMcStmt stmts bndr_ty_dummy $ \elt_ty' -> do
- { (by', using_ty) <-
- case by of
- Nothing -> -- check that using :: forall a. m a -> m (m a)
- return (Nothing, mkForAllTy alphaTyVar $
- alphaMTy `mkFunTy` alphaMMTy)
-
- Just by_e -> -- check that using :: forall a. (a -> t) -> m a -> m (m a)
- -- where by :: t
- do { (by_e', t_ty) <- tcInferRhoNC by_e
- ; return (Just by_e', mkForAllTy alphaTyVar $
- (alphaTy `mkFunTy` t_ty)
- `mkFunTy` alphaMTy
- `mkFunTy` alphaMMTy) }
-
+tcMcStmt ctxt (GroupStmt stmts bindersMap by using return_op bind_op fmap_op) res_ty thing_inside
+ = do { m1_ty <- newFlexiTyVarTy liftedTypeKind
+ ; m2_ty <- newFlexiTyVarTy liftedTypeKind
+ ; n_ty <- newFlexiTyVarTy liftedTypeKind
+ ; tup_ty_var <- newFlexiTyVarTy liftedTypeKind
+ ; new_res_ty <- newFlexiTyVarTy liftedTypeKind
+ ; let (bndr_names, n_bndr_names) = unzip bindersMap
+ m1_tup_ty = m1_ty `mkAppTy` tup_ty_var
+
+ -- 'stmts' returns a result of type (m1_ty tuple_ty),
+ -- typically something like [(Int,Bool,Int)]
+ -- We don't know what tuple_ty is yet, so we use a variable
+ ; (stmts', (bndr_ids, by_e_ty, return_op')) <-
+ tcStmts (TransformStmtCtxt ctxt) tcMcStmt stmts m1_tup_ty $ \res_ty' -> do
+ { by_e_ty <- mapM tcInferRhoNC by_e