diff options
| author | simonpj@microsoft.com <unknown> | 2006-12-01 03:42:07 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2006-12-01 03:42:07 +0000 |
| commit | ea2d0a53ff4ca7e6331d09225ad84ec9c9efe6d8 (patch) | |
| tree | 5574a8d8d38a40e90734f528e0f0023ce84bd028 | |
| parent | ebafc217f9c3f932965c0581f4dbc8f19a26b37e (diff) | |
| download | haskell-ea2d0a53ff4ca7e6331d09225ad84ec9c9efe6d8.tar.gz | |
q
| -rw-r--r-- | compiler/typecheck/Inst.lhs | 4 | ||||
| -rw-r--r-- | compiler/typecheck/TcSimplify.lhs | 5 |
2 files changed, 4 insertions, 5 deletions
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs index ffb010491d..c34bf6d240 100644 --- a/compiler/typecheck/Inst.lhs +++ b/compiler/typecheck/Inst.lhs @@ -110,7 +110,8 @@ instType imp@(ImplicInst {}) = mkImplicTy (tci_tyvars imp) (tci_given imp) (tci_wanted imp) mkImplicTy tvs givens wanteds -- The type of an implication constraint - = -- pprTrace "mkImplicTy" (ppr givens) $ + = ASSERT( all isDict givens ) + -- pprTrace "mkImplicTy" (ppr givens) $ mkForAllTys tvs $ mkPhiTy (map dictPred givens) $ if isSingleton wanteds then @@ -330,6 +331,7 @@ mkPredName uniq loc pred_ty occ = case pred_ty of ClassP cls tys -> mkDictOcc (getOccName cls) IParam ip ty -> getOccName (ipNameName ip) + EqPred _ _ -> pprPanic "mkPredName" (ppr pred_ty) \end{code} %************************************************************************ diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 2347d37854..cbcabe91b1 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -1236,7 +1236,7 @@ tcSimplifyRestricted doc top_lvl bndrs tau_tvs wanteds returnM (varSetElems qtvs, binds) else let - (non_ips, bad_ips) = partition isClassDict irreds + (bad_ips, non_ips) = partition isIPDict irreds in addTopIPErrs bndrs bad_ips `thenM_` extendLIEs non_ips `thenM_` @@ -1992,9 +1992,6 @@ extractResults (Avails _ avails) wanteds Just (Rhs rhs ws') -> go (add_given avails w) new_binds irreds (ws' ++ ws) where new_binds = addBind binds w rhs - where - w_span = instSpan w - w_id = instToId w add_given avails w = extendAvailEnv avails w (Given (instToId w)) |