+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
matchCtxt, TcMatchCtxt(..),
tcStmts, tcDoStmts, tcBody,
module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
matchCtxt, TcMatchCtxt(..),
tcStmts, tcDoStmts, tcBody,
-- The pprSetDepth makes the abstraction print briefly
ptext SLIT("has") <+> speakNOf n_pats (ptext SLIT("argument"))]
match_ctxt = MC { mc_what = LambdaExpr,
-- The pprSetDepth makes the abstraction print briefly
ptext SLIT("has") <+> speakNOf n_pats (ptext SLIT("argument"))]
match_ctxt = MC { mc_what = LambdaExpr,
; (stmts', body') <- tcStmts ListComp (tcLcStmt listTyCon) stmts
(emptyRefinement,elt_ty) $
tcBody body
; (stmts', body') <- tcStmts ListComp (tcLcStmt listTyCon) stmts
(emptyRefinement,elt_ty) $
tcBody body
; (stmts', body') <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts
(emptyRefinement, elt_ty) $
tcBody body
; (stmts', body') <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts
(emptyRefinement, elt_ty) $
tcBody body
; let res_ty' = mkAppTy m_ty elt_ty -- The boxySplit consumes res_ty
; (stmts', body') <- tcStmts DoExpr (tcDoStmt m_ty) stmts
(emptyRefinement, res_ty') $
tcBody body
; let res_ty' = mkAppTy m_ty elt_ty -- The boxySplit consumes res_ty
; (stmts', body') <- tcStmts DoExpr (tcDoStmt m_ty) stmts
(emptyRefinement, res_ty') $
tcBody body
; let res_ty' = mkAppTy m_ty elt_ty -- The boxySplit consumes res_ty
tc_rhs rhs = withBox liftedTypeKind $ \ pat_ty ->
tcMonoExpr rhs (mkAppTy m_ty pat_ty)
; let res_ty' = mkAppTy m_ty elt_ty -- The boxySplit consumes res_ty
tc_rhs rhs = withBox liftedTypeKind $ \ pat_ty ->
tcMonoExpr rhs (mkAppTy m_ty pat_ty)
; let names = [mfixName, bindMName, thenMName, returnMName, failMName]
; insts <- mapM (newMethodFromName DoOrigin m_ty) names
; let names = [mfixName, bindMName, thenMName, returnMName, failMName]
; insts <- mapM (newMethodFromName DoOrigin m_ty) names