--- Transform statements.
---
--- [ body | stmts, then f ] -> f :: forall a. m a -> m a
--- [ body | stmts, then f by e ] -> f :: forall a. (a -> t) -> m a -> m a
---
-tcMcStmt ctxt (TransformStmt stmts binders usingExpr maybeByExpr return_op bind_op) res_ty thing_inside
- = do {
- -- We don't know the types of binders yet, so we use this dummy and
- -- later unify this type with the `m_bndr_ty`
- ty_dummy <- newFlexiTyVarTy liftedTypeKind
-
- ; (stmts', (binders', usingExpr', maybeByExpr', return_op', bind_op', thing)) <-
- tcStmts (TransformStmtCtxt ctxt) tcMcStmt stmts ty_dummy $ \res_ty' -> do
- { (_, (m_ty, _)) <- matchExpectedAppTy res_ty'
- ; (usingExpr', maybeByExpr') <-
- case maybeByExpr of
- Nothing -> do
- -- We must validate that usingExpr :: forall a. m a -> m a
- let using_ty = mkForAllTy alphaTyVar $
- (m_ty `mkAppTy` alphaTy)
- `mkFunTy`
- (m_ty `mkAppTy` alphaTy)
- usingExpr' <- tcPolyExpr usingExpr using_ty
- return (usingExpr', Nothing)
- Just byExpr -> do
- -- We must infer a type such that e :: t and then check that
- -- usingExpr :: forall a. (a -> t) -> m a -> m a
- (byExpr', tTy) <- tcInferRhoNC byExpr
- let using_ty = mkForAllTy alphaTyVar $
- (alphaTy `mkFunTy` tTy)
- `mkFunTy`
- (m_ty `mkAppTy` alphaTy)
- `mkFunTy`
- (m_ty `mkAppTy` alphaTy)
- usingExpr' <- tcPolyExpr usingExpr using_ty
- return (usingExpr', Just byExpr')
-
- ; bndr_ids <- tcLookupLocalIds binders
-
- -- `return` and `>>=` are used to pass around/modify our
- -- binders, so we know their types:
- --
- -- return :: (a,b,c,..) -> m (a,b,c,..)
- -- (>>=) :: m (a,b,c,..)
- -- -> ( (a,b,c,..) -> m (a,b,c,..) )
- -- -> m (a,b,c,..)
- --
- ; let bndr_ty = mkBigCoreVarTupTy bndr_ids
- m_bndr_ty = m_ty `mkAppTy` bndr_ty
-
- ; return_op' <- tcSyntaxOp MCompOrigin return_op
- (bndr_ty `mkFunTy` m_bndr_ty)
-
- ; bind_op' <- tcSyntaxOp MCompOrigin bind_op $
- m_bndr_ty `mkFunTy` (bndr_ty `mkFunTy` res_ty)
- `mkFunTy` res_ty
-
- -- Unify types of the inner comprehension and the binders type
- ; _ <- unifyType res_ty' m_bndr_ty
-
- -- Typecheck the `thing` with out old type (which is the type
- -- of the final result of our comprehension)
- ; thing <- thing_inside res_ty
-
- ; return (bndr_ids, usingExpr', maybeByExpr', return_op', bind_op', thing) }
-
- ; return (TransformStmt stmts' binders' usingExpr' maybeByExpr' return_op' bind_op', thing) }
-