projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix Trac #1470: improve handling of recursive instances (needed for SYB3)
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcArrows.lhs
diff --git
a/compiler/typecheck/TcArrows.lhs
b/compiler/typecheck/TcArrows.lhs
index
082f9da
..
4593482
100644
(file)
--- a/
compiler/typecheck/TcArrows.lhs
+++ b/
compiler/typecheck/TcArrows.lhs
@@
-123,8
+123,7
@@
tc_cmd env (HsLet binds (L body_loc body)) res_ty
tc_cmd env in_cmd@(HsCase scrut matches) (stk, res_ty)
= addErrCtxt (cmdCtxt in_cmd) $ do
tc_cmd env in_cmd@(HsCase scrut matches) (stk, res_ty)
= addErrCtxt (cmdCtxt in_cmd) $ do
- (scrut', scrut_ty) <- addErrCtxt (caseScrutCtxt scrut) $
- tcInferRho scrut
+ (scrut', scrut_ty) <- tcInferRho scrut
matches' <- tcMatchesCase match_ctxt scrut_ty matches res_ty
return (HsCase scrut' matches')
where
matches' <- tcMatchesCase match_ctxt scrut_ty matches res_ty
return (HsCase scrut' matches')
where
@@
-341,10
+340,6
@@
arrowTyConKind = mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind
cmdCtxt :: HsExpr Name -> SDoc
cmdCtxt cmd = ptext (sLit "In the command:") <+> ppr cmd
cmdCtxt :: HsExpr Name -> SDoc
cmdCtxt cmd = ptext (sLit "In the command:") <+> ppr cmd
-caseScrutCtxt :: LHsExpr Name -> SDoc
-caseScrutCtxt cmd
- = hang (ptext (sLit "In the scrutinee of a case command:")) 4 (ppr cmd)
-
nonEmptyCmdStkErr :: HsExpr Name -> SDoc
nonEmptyCmdStkErr cmd
= hang (ptext (sLit "Non-empty command stack at command:"))
nonEmptyCmdStkErr :: HsExpr Name -> SDoc
nonEmptyCmdStkErr cmd
= hang (ptext (sLit "Non-empty command stack at command:"))