ghc/compiler/typecheck/TcGRHSs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[TcGRHSs]{Typecheck guarded right-hand-sides}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module TcGRHSs ( tcGRHSsAndBinds ) where
  10
  11 IMP_Ubiq(){-uitous-}
  12 IMPORT_DELOOPER(TcLoop) -- for paranoia checking
  13
  14 import HsSyn            ( GRHSsAndBinds(..), GRHS(..),
  15                           HsExpr, HsBinds(..), InPat, OutPat, Bind, Sig, Fake )
  16 import RnHsSyn          ( RenamedGRHSsAndBinds(..), RenamedGRHS(..) )
  17 import TcHsSyn          ( TcGRHSsAndBinds(..), TcGRHS(..), TcIdOcc(..) )
  18
  19 import TcMonad          hiding ( rnMtoTcM )
  20 import Inst             ( Inst, LIE(..), plusLIE )
  21 import TcBinds          ( tcBindsAndThen )
  22 import TcExpr           ( tcExpr )
  23 import TcType           ( TcType(..) )
  24 import Unify            ( unifyTauTy )
  25
  26 import TysWiredIn       ( boolTy )
  27 \end{code}
  28
  29 \begin{code}
  30 tcGRHSs :: [RenamedGRHS] -> TcM s ([TcGRHS s], LIE s, TcType s)
  31
  32 tcGRHSs [grhs]
  33   = tcGRHS grhs         `thenTc` \ (grhs', lie, ty) ->
  34     returnTc ([grhs'], lie, ty)
  35
  36 tcGRHSs (grhs:grhss)
  37   = tcGRHS  grhs        `thenTc` \ (grhs',  lie1, ty1) ->
  38     tcGRHSs grhss       `thenTc` \ (grhss', lie2, ty2) ->
  39     unifyTauTy ty1 ty2  `thenTc_`
  40     returnTc (grhs' : grhss', lie1 `plusLIE` lie2, ty1)
  41
  42
  43 tcGRHS (OtherwiseGRHS expr locn)
  44   = tcAddSrcLoc locn     $
  45     tcExpr expr `thenTc` \ (expr, lie, ty) ->
  46     returnTc (OtherwiseGRHS expr locn, lie, ty)
  47
  48 tcGRHS (GRHS guard expr locn)
  49   = tcAddSrcLoc locn            $
  50     tcExpr guard                `thenTc` \ (guard2, guard_lie, guard_ty) ->
  51     unifyTauTy boolTy guard_ty  `thenTc_`
  52     tcExpr expr                 `thenTc` \ (expr2, expr_lie, expr_ty) ->
  53     returnTc (GRHS guard2 expr2 locn, plusLIE guard_lie expr_lie, expr_ty)
  54 \end{code}
  55
  56
  57 @tcGRHSsAndBinds@ typechecks (grhss where binds), returning suitable
  58 pieces.
  59
  60 \begin{code}
  61 tcGRHSsAndBinds :: RenamedGRHSsAndBinds
  62                 -> TcM s (TcGRHSsAndBinds s, LIE s, TcType s)
  63
  64 tcGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
  65   = tcBindsAndThen
  66          combiner binds
  67          (tcGRHSs grhss         `thenTc` \ (grhss', lie, ty) ->
  68           returnTc (GRHSsAndBindsOut grhss' EmptyBinds ty, lie, ty)
  69          )
  70   where
  71     combiner binds1 (GRHSsAndBindsOut grhss binds2 ty)
  72         = GRHSsAndBindsOut grhss (binds1 `ThenBinds` binds2) ty
  73 \end{code}