2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[TcGRHSs]{Typecheck guarded right-hand-sides}
7 module TcGRHSs ( tcGRHSsAndBinds ) where
9 #include "HsVersions.h"
11 import HsSyn ( HsBinds(..), GRHSsAndBinds(..), GRHS(..), DoOrListComp(..) )
12 import RnHsSyn ( RenamedGRHSsAndBinds, RenamedGRHS )
13 import TcHsSyn ( TcGRHSsAndBinds, TcGRHS )
16 import Inst ( Inst, LIE, plusLIE )
17 import TcBinds ( tcBindsAndThen )
18 import TcExpr ( tcExpr, tcStmt )
19 import TcType ( TcType, newTyVarTy )
20 import TcEnv ( TcIdOcc(..) )
22 import TysWiredIn ( boolTy )
26 tcGRHSs :: TcType s -> [RenamedGRHS] -> TcM s ([TcGRHS s], LIE s)
28 tcGRHSs expected_ty [grhs]
29 = tcGRHS expected_ty grhs `thenTc` \ (grhs', lie) ->
30 returnTc ([grhs'], lie)
32 tcGRHSs expected_ty (grhs:grhss)
33 = tcGRHS expected_ty grhs `thenTc` \ (grhs', lie1) ->
34 tcGRHSs expected_ty grhss `thenTc` \ (grhss', lie2) ->
35 returnTc (grhs' : grhss', lie1 `plusLIE` lie2)
37 tcGRHS expected_ty (GRHS guard expr locn)
39 tcStmts guard `thenTc` \ ((guard', expr'), lie) ->
40 returnTc (GRHS guard' expr' locn, lie)
42 tcStmts [] = tcExpr expr expected_ty `thenTc` \ (expr2, expr_lie) ->
43 returnTc (([], expr2), expr_lie)
44 tcStmts (stmt:stmts) = tcStmt tcExpr Guard (\x->x) combine stmt $
47 combine stmt _ (stmts, expr) = (stmt:stmts, expr)
51 @tcGRHSsAndBinds@ typechecks (grhss where binds), returning suitable
55 tcGRHSsAndBinds :: TcType s -- Expected type of RHSs
56 -> RenamedGRHSsAndBinds
57 -> TcM s (TcGRHSsAndBinds s, LIE s)
59 -- Shortcut for common case
60 tcGRHSsAndBinds expected_ty (GRHSsAndBindsIn grhss EmptyBinds)
61 = tcGRHSs expected_ty grhss `thenTc` \ (grhss', lie) ->
62 returnTc (GRHSsAndBindsOut grhss' EmptyBinds expected_ty, lie)
64 tcGRHSsAndBinds expected_ty (GRHSsAndBindsIn grhss binds)
67 (tcGRHSs expected_ty grhss)
69 combiner is_rec binds grhss
70 = GRHSsAndBindsOut grhss (MonoBind binds [] is_rec) expected_ty