Commit 61462d62 authored by sof's avatar sof

[project @ 1997-05-18 22:46:37 by sof]

2.04 updates
parent e99e6347
......@@ -11,15 +11,15 @@ module TcGRHSs ( tcGRHSsAndBinds ) where
IMP_Ubiq(){-uitous-}
IMPORT_DELOOPER(TcLoop) -- for paranoia checking
import HsSyn ( GRHSsAndBinds(..), GRHS(..),
HsExpr, HsBinds(..), InPat, OutPat, Bind, Sig, Fake )
import HsSyn ( GRHSsAndBinds(..), GRHS(..), MonoBinds, Stmt, DoOrListComp(..),
HsExpr, HsBinds(..), InPat, OutPat, Sig, Fake )
import RnHsSyn ( SYN_IE(RenamedGRHSsAndBinds), SYN_IE(RenamedGRHS) )
import TcHsSyn ( SYN_IE(TcGRHSsAndBinds), SYN_IE(TcGRHS), TcIdOcc(..) )
import TcMonad
import Inst ( Inst, SYN_IE(LIE), plusLIE )
import TcBinds ( tcBindsAndThen )
import TcExpr ( tcExpr )
import TcExpr ( tcExpr, tcStmt )
import TcType ( SYN_IE(TcType) )
import Unify ( unifyTauTy )
......@@ -47,10 +47,15 @@ tcGRHS (OtherwiseGRHS expr locn)
tcGRHS (GRHS guard expr locn)
= tcAddSrcLoc locn $
tcExpr guard `thenTc` \ (guard2, guard_lie, guard_ty) ->
unifyTauTy boolTy guard_ty `thenTc_`
tcExpr expr `thenTc` \ (expr2, expr_lie, expr_ty) ->
returnTc (GRHS guard2 expr2 locn, plusLIE guard_lie expr_lie, expr_ty)
tc_stmts guard `thenTc` \ ((guard', expr', ty), lie) ->
returnTc (GRHS guard' expr' locn, lie, ty)
where
tc_stmts [] = tcExpr expr `thenTc` \ (expr2, expr_lie, expr_ty) ->
returnTc (([], expr2, expr_ty), expr_lie)
tc_stmts (stmt:stmts) = tcStmt tcExpr ListComp (\x->x) combine stmt $
tc_stmts stmts
combine stmt _ (stmts, expr, ty) = (stmt:stmts, expr, ty)
\end{code}
......@@ -65,8 +70,9 @@ tcGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
= tcBindsAndThen
combiner binds
(tcGRHSs grhss `thenTc` \ (grhss', lie, ty) ->
returnTc (GRHSsAndBindsOut grhss' EmptyBinds ty, lie, ty)
)
returnTc (GRHSsAndBindsOut grhss' EmptyBinds ty, lie)
) `thenTc` \ (grhss_and_binds'@(GRHSsAndBindsOut _ _ result_ty), lie) ->
returnTc (grhss_and_binds', lie, result_ty)
where
combiner binds1 (GRHSsAndBindsOut grhss binds2 ty)
= GRHSsAndBindsOut grhss (binds1 `ThenBinds` binds2) ty
......
......@@ -30,8 +30,9 @@ module TcGenDeriv (
IMP_Ubiq()
IMPORT_1_3(List(partition))
import HsSyn ( HsBinds(..), Bind(..), MonoBinds(..), Match(..), GRHSsAndBinds(..),
import HsSyn ( HsBinds(..), MonoBinds(..), Match(..), GRHSsAndBinds(..),
GRHS(..), HsExpr(..), HsLit(..), InPat(..), Stmt(..), DoOrListComp(..),
SYN_IE(RecFlag), recursive,
ArithSeqInfo, Sig, HsType, FixityDecl, Fixity, Fake )
import RdrHsSyn ( RdrName(..), varQual, varUnqual, mkOpApp,
SYN_IE(RdrNameMonoBinds), SYN_IE(RdrNameHsExpr), SYN_IE(RdrNamePat)
......@@ -46,9 +47,9 @@ import Name ( getOccString, getOccName, getSrcLoc, occNameString, modAndOcc, Oc
import PrimOp ( PrimOp(..) )
import PrelInfo -- Lots of RdrNames
import SrcLoc ( mkGeneratedSrcLoc )
import SrcLoc ( mkGeneratedSrcLoc, SrcLoc )
import TyCon ( TyCon, tyConDataCons, isEnumerationTyCon, maybeTyConSingleCon )
import Type ( eqTy, isPrimType )
import Type ( eqTy, isPrimType, SYN_IE(Type) )
import TysPrim ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
floatPrimTy, doublePrimTy
)
......@@ -868,7 +869,7 @@ mk_easy_Match loc pats binds expr
= mk_match loc pats expr (mkbind binds)
where
mkbind [] = EmptyBinds
mkbind bs = SingleBind (RecBind (foldr1 AndMonoBinds bs))
mkbind bs = MonoBind (foldr1 AndMonoBinds bs) [] recursive
-- The renamer expects everything in its input to be a
-- "recursive" MonoBinds, and it is its job to sort things out
-- from there.
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment