X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcPat.lhs;h=becc2d6104aa9ac3c62e22eb13a0aec928c245e2;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hp=45aaa5d693f2aa2199cc1723a11e09aab9a438eb;hpb=ae45ff0e9831a0dc862a5d68d03e355d7e323c62;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs index 45aaa5d..becc2d6 100644 --- a/ghc/compiler/typecheck/TcPat.lhs +++ b/ghc/compiler/typecheck/TcPat.lhs @@ -13,17 +13,18 @@ IMP_Ubiq(){-uitous-} import HsSyn ( InPat(..), OutPat(..), HsExpr(..), HsLit(..), Match, HsBinds, Qualifier, PolyType, ArithSeqInfo, Stmt, Fake ) -import RnHsSyn ( RenamedPat(..) ) -import TcHsSyn ( TcPat(..), TcIdOcc(..) ) +import RnHsSyn ( SYN_IE(RenamedPat), RnName{-instance Outputable-} ) +import TcHsSyn ( SYN_IE(TcPat), TcIdOcc(..) ) import TcMonad hiding ( rnMtoTcM ) import Inst ( Inst, OverloadedLit(..), InstOrigin(..), - emptyLIE, plusLIE, plusLIEs, LIE(..), + emptyLIE, plusLIE, plusLIEs, SYN_IE(LIE), newMethod, newOverloadedLit ) import TcEnv ( tcLookupGlobalValue, tcLookupGlobalValueByKey, tcLookupLocalValueOK ) -import TcType ( TcType(..), TcMaybe, newTyVarTy, newTyVarTys, tcInstId ) +import SpecEnv ( SpecEnv ) +import TcType ( SYN_IE(TcType), TcMaybe, newTyVarTy, newTyVarTys, tcInstId ) import Unify ( unifyTauTy, unifyTauTyList, unifyTauTyLists ) import Bag ( Bag ) @@ -32,12 +33,11 @@ import Id ( GenId, idType ) import Kind ( Kind, mkBoxedTypeKind, mkTypeKind ) import Maybes ( maybeToBool ) import PprType ( GenType, GenTyVar ) -import PprStyle--ToDo:rm +--import PprStyle--ToDo:rm import Pretty -import RnHsSyn ( RnName{-instance Outputable-} ) import Type ( splitFunTy, splitRhoTy, splitSigmaTy, mkTyVarTys, getFunTy_maybe, maybeAppDataTyCon, - Type(..), GenType + SYN_IE(Type), GenType ) import TyVar ( GenTyVar ) import TysPrim ( charPrimTy, intPrimTy, floatPrimTy, @@ -45,7 +45,7 @@ import TysPrim ( charPrimTy, intPrimTy, floatPrimTy, ) import TysWiredIn ( charTy, stringTy, mkListTy, mkTupleTy, addrTy ) import Unique ( Unique, eqClassOpKey ) -import Util ( assertPanic, panic{-ToDo:rm-} ) +import Util ( assertPanic, panic ) \end{code} \begin{code} @@ -60,7 +60,7 @@ tcPat :: RenamedPat -> TcM s (TcPat s, LIE s, TcType s) \begin{code} tcPat (VarPatIn name) - = tcLookupLocalValueOK ("tcPat1:"++ppShow 80 (ppr PprDebug name)) name `thenNF_Tc` \ id -> + = tcLookupLocalValueOK ("tcPat1:"{-++ppShow 80 (ppr PprDebug name)-}) name `thenNF_Tc` \ id -> returnTc (VarPat (TcId id), emptyLIE, idType id) tcPat (LazyPatIn pat) @@ -342,7 +342,7 @@ matchConArgTys con arg_tys checkTc (con_arity == no_of_args) (arityErr "Constructor" con_id con_arity no_of_args) `thenTc_` - unifyTauTyLists arg_tys con_args `thenTc_` + unifyTauTyLists con_args arg_tys `thenTc_` returnTc (con_id, con_result) \end{code}