- --
- ; let bndr_ty = mkChunkified mkBoxedTupleTy $ map idType bndr_ids
- m_bndr_ty = m_ty `mkAppTy` bndr_ty
- ; return_op' <- tcSyntaxOp MCompOrigin return_op $ bndr_ty `mkFunTy` m_bndr_ty
-
- -- '>>=' is used to pass the grouped binders to the rest of the
- -- comprehension.
- --
- -- (>>=) :: m (m a, m b, m c, ..)
- -- -> ( (m a, m b, m c, ..) -> new_elt_ty )
- -- -> elt_ty
- --
- ; let bndr_m_ty = mkChunkified mkBoxedTupleTy $ map (mkAppTy m_ty . idType) bndr_ids
- m_bndr_m_ty = m_ty `mkAppTy` bndr_m_ty
- ; new_elt_ty <- newFlexiTyVarTy liftedTypeKind
- ; bind_op' <- tcSyntaxOp MCompOrigin bind_op $
- m_bndr_m_ty `mkFunTy` (bndr_m_ty `mkFunTy` new_elt_ty)
- `mkFunTy` elt_ty
-
- -- Finally make sure the type of the inner comprehension
- -- represents the types of our binders
- ; _ <- unifyType elt_ty' m_bndr_ty
-
- ; return (bndr_ids, by', using_ty, return_op', bind_op') }
+ ; return_op' <- tcSyntaxOp MCompOrigin return_op $
+ (mkBigCoreVarTupTy bndr_ids) `mkFunTy` res_ty'
+
+ ; return (bndr_ids, by_e_ty, return_op') }
+
+
+
+ ; let tup_ty = mkBigCoreVarTupTy bndr_ids -- (a,b,c)
+ using_arg_ty = m1_ty `mkAppTy` tup_ty -- m1 (a,b,c)
+ n_tup_ty = n_ty `mkAppTy` tup_ty -- n (a,b,c)
+ using_res_ty = m2_ty `mkAppTy` n_tup_ty -- m2 (n (a,b,c))
+ using_fun_ty = using_arg_ty `mkFunTy` using_arg_ty
+
+ -- (>>=) :: m2 (n (a,b,c)) -> ( n (a,b,c) -> new_res_ty ) -> res_ty
+ -- using :: ((a,b,c)->t) -> m1 (a,b,c) -> m2 (n (a,b,c))
+
+ --------------- Typecheck the 'bind' function -------------
+ ; bind_op' <- tcSyntaxOp MCompOrigin bind_op $
+ using_res_ty `mkFunTy` (n_tup_ty `mkFunTy` new_res_ty)
+ `mkFunTy` res_ty
+
+ --------------- Typecheck the 'using' function -------------
+ ; let poly_fun_ty = (m1_ty `mkAppTy` alphaTy) `mkFunTy`
+ (m2_ty `mkAppTy` (n_ty `mkAppTy` alphaTy))
+ using_poly_ty = case by_e_ty of
+ Nothing -> mkForAllTy alphaTyVar poly_fun_ty
+ -- using :: forall a. m1 a -> m2 (n a)
+
+ Just (_,t_ty) -> mkForAllTy alphaTyVar $
+ (alphaTy `mkFunTy` t_ty) `mkFunTy` poly_fun_ty
+ -- using :: forall a. (a->t) -> m1 a -> m2 (n a)
+ -- where by :: t
+
+ ; using' <- tcPolyExpr using using_poly_ty
+ ; coi <- unifyType (applyTy using_poly_ty tup_ty)
+ (case by_e_ty of
+ Nothing -> using_fun_ty
+ Just (_,t_ty) -> (tup_ty `mkFunTy` t_ty) `mkFunTy` using_fun_ty)
+ ; let final_using = fmap (mkHsWrapCoI coi . HsWrap (WpTyApp tup_ty)) using'
+
+ --------------- Typecheck the 'fmap' function -------------
+ ; fmap_op' <- fmap unLoc . tcPolyExpr (noLoc fmap_op) $
+ mkForAllTy alphaTyVar $ mkForAllTy betaTyVar $
+ (alphaTy `mkFunTy` betaTy)
+ `mkFunTy` (n_ty `mkAppTy` alphaTy)
+ `mkFunTy` (n_ty `mkAppTy` betaTy)