projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
f84b83e
)
Monadify typecheck/TcArrows: use do and return
author
Twan van Laarhoven
<twanvl@gmail.com>
Thu, 17 Jan 2008 21:08:18 +0000
(21:08 +0000)
committer
Twan van Laarhoven
<twanvl@gmail.com>
Thu, 17 Jan 2008 21:08:18 +0000
(21:08 +0000)
compiler/typecheck/TcArrows.lhs
patch
|
blob
|
history
diff --git
a/compiler/typecheck/TcArrows.lhs
b/compiler/typecheck/TcArrows.lhs
index
52b22cf
..
538eaa7
100644
(file)
--- a/
compiler/typecheck/TcArrows.lhs
+++ b/
compiler/typecheck/TcArrows.lhs
@@
-42,6
+42,8
@@
import Type
import SrcLoc
import Outputable
import Util
import SrcLoc
import Outputable
import Util
+
+import Control.Monad
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-128,12
+130,11
@@
tc_cmd env (HsLet binds (L body_loc body)) res_ty
; return (HsLet binds' (L body_loc body')) }
tc_cmd env in_cmd@(HsCase scrut matches) (stk, res_ty)
; return (HsLet binds' (L body_loc body')) }
tc_cmd env in_cmd@(HsCase scrut matches) (stk, res_ty)
- = addErrCtxt (cmdCtxt in_cmd) $
- addErrCtxt (caseScrutCtxt scrut) (
- tcInferRho scrut
- ) `thenM` \ (scrut', scrut_ty) ->
- tcMatchesCase match_ctxt scrut_ty matches res_ty `thenM` \ matches' ->
- returnM (HsCase scrut' matches')
+ = addErrCtxt (cmdCtxt in_cmd) $ do
+ (scrut', scrut_ty) <- addErrCtxt (caseScrutCtxt scrut) $
+ tcInferRho scrut
+ matches' <- tcMatchesCase match_ctxt scrut_ty matches res_ty
+ return (HsCase scrut' matches')
where
match_ctxt = MC { mc_what = CaseAlt,
mc_body = mc_body }
where
match_ctxt = MC { mc_what = CaseAlt,
mc_body = mc_body }
@@
-272,7
+273,7
@@
tc_cmd env cmd@(HsArrForm expr fixity cmd_args) (cmd_stk, res_ty)
-- the s1..sm and check each cmd
; cmds' <- mapM (tc_cmd w_tv) cmds_w_tys
-- the s1..sm and check each cmd
; cmds' <- mapM (tc_cmd w_tv) cmds_w_tys
- ; returnM (HsArrForm (noLoc $ HsWrap (WpTyLam w_tv)
+ ; return (HsArrForm (noLoc $ HsWrap (WpTyLam w_tv)
(unLoc $ mkHsDictLet inst_binds expr'))
fixity cmds')
}
(unLoc $ mkHsDictLet inst_binds expr'))
fixity cmds')
}