diff options
| author | simonpj@microsoft.com <unknown> | 2010-10-08 13:57:47 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2010-10-08 13:57:47 +0000 |
| commit | 5231445e104fa0227978909b47066ed1f012d325 (patch) | |
| tree | 3a655637387e9009ca229589114bb40ba7145173 /compiler | |
| parent | debb7b80e707c343a3a7d8993ffab19b83e5c52b (diff) | |
| download | haskell-5231445e104fa0227978909b47066ed1f012d325.tar.gz | |
Fix Trac #4360: omitted case in combineCtLoc
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/typecheck/TcInteract.lhs | 9 | ||||
| -rw-r--r-- | compiler/typecheck/TcSMonad.lhs | 15 |
2 files changed, 9 insertions, 15 deletions
diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index f0edcc97f4..0d93dd3881 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -999,14 +999,7 @@ doInteractWithInert -- Fall-through case for all other situations doInteractWithInert _ workItem = noInteraction workItem --------------------------------------------- -combineCtLoc :: CtFlavor -> CtFlavor -> WantedLoc --- Precondition: At least one of them should be wanted -combineCtLoc (Wanted loc) _ = loc -combineCtLoc _ (Wanted loc) = loc -combineCtLoc _ _ = panic "Expected one of wanted constraints (BUG)" - - +------------------------- -- Equational Rewriting rewriteDict :: (CoVar, TcTyVar, Xi) -> (DictId, CtFlavor, Class, [Xi]) -> TcS CanonicalCt rewriteDict (cv,tv,xi) (dv,gw,cl,xis) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index b105f8de72..26f52d9fa4 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -10,7 +10,7 @@ module TcSMonad ( makeGivens, makeSolved, CtFlavor (..), isWanted, isGiven, isDerived, canRewrite, - joinFlavors, mkGivenFlavor, + combineCtLoc, mkGivenFlavor, TcS, runTcS, failTcS, panicTcS, traceTcS, traceTcS0, -- Basic functionality tryTcS, nestImplicTcS, wrapErrTcS, wrapWarnTcS, @@ -298,12 +298,13 @@ canRewrite (Derived {}) (Derived {}) = True canRewrite (Wanted {}) (Wanted {}) = True canRewrite _ _ = False -joinFlavors :: CtFlavor -> CtFlavor -> CtFlavor -joinFlavors (Wanted loc) _ = Wanted loc -joinFlavors _ (Wanted loc) = Wanted loc -joinFlavors (Derived loc) _ = Derived loc -joinFlavors _ (Derived loc) = Derived loc -joinFlavors (Given loc) _ = Given loc +combineCtLoc :: CtFlavor -> CtFlavor -> WantedLoc +-- Precondition: At least one of them should be wanted +combineCtLoc (Wanted loc) _ = loc +combineCtLoc _ (Wanted loc) = loc +combineCtLoc (Derived loc) _ = loc +combineCtLoc _ (Derived loc) = loc +combineCtLoc _ _ = panic "combineCtLoc: both given" mkGivenFlavor :: CtFlavor -> SkolemInfo -> CtFlavor mkGivenFlavor (Wanted loc) sk = Given (setCtLocOrigin loc sk) |