projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Inline implication constraints
[ghc-hetmet.git]
/
compiler
/
typecheck
/
Inst.lhs
diff --git
a/compiler/typecheck/Inst.lhs
b/compiler/typecheck/Inst.lhs
index
9c152e1
..
d75a7cd
100644
(file)
--- a/
compiler/typecheck/Inst.lhs
+++ b/
compiler/typecheck/Inst.lhs
@@
-52,8
+52,7
@@
module Inst (
eitherEqInst, mkEqInst, mkEqInsts, mkWantedEqInst,
finalizeEqInst, writeWantedCoercion,
eqInstType, updateEqInstCoercion,
eitherEqInst, mkEqInst, mkEqInsts, mkWantedEqInst,
finalizeEqInst, writeWantedCoercion,
eqInstType, updateEqInstCoercion,
- eqInstCoercion,
- eqInstLeftTy, eqInstRightTy
+ eqInstCoercion, eqInstTys
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
@@
-99,6
+98,8
@@
import Outputable
import Data.List
import TypeRep
import Class
import Data.List
import TypeRep
import Class
+
+import Control.Monad ( liftM )
\end{code}
\end{code}
@@
-139,7
+140,7
@@
instType imp@(ImplicInst {}) = mkImplicTy (tci_tyvars imp) (tci_given imp)
instType (EqInst {tci_left = ty1, tci_right = ty2}) = mkPredTy (EqPred ty1 ty2)
mkImplicTy tvs givens wanteds -- The type of an implication constraint
instType (EqInst {tci_left = ty1, tci_right = ty2}) = mkPredTy (EqPred ty1 ty2)
mkImplicTy tvs givens wanteds -- The type of an implication constraint
- = ASSERT( all isDict givens )
+ = ASSERT( all isAbstractableInst givens )
-- pprTrace "mkImplicTy" (ppr givens) $
-- See [Equational Constraints in Implication Constraints]
let dict_wanteds = filter (not . isEqInst) wanteds
-- pprTrace "mkImplicTy" (ppr givens) $
-- See [Equational Constraints in Implication Constraints]
let dict_wanteds = filter (not . isEqInst) wanteds
@@
-555,11
+556,11
@@
zonkInst implic@(ImplicInst {})
zonkInst eqinst@(EqInst {tci_left = ty1, tci_right = ty2})
= do { co' <- eitherEqInst eqinst
zonkInst eqinst@(EqInst {tci_left = ty1, tci_right = ty2})
= do { co' <- eitherEqInst eqinst
- (\covar -> return (mkWantedCo covar))
- (\co -> zonkTcType co >>= \coercion -> return (mkGivenCo coercion))
+ (\covar -> return (mkWantedCo covar))
+ (\co -> liftM mkGivenCo $ zonkTcType co)
; ty1' <- zonkTcType ty1
; ty2' <- zonkTcType ty2
; ty1' <- zonkTcType ty1
; ty2' <- zonkTcType ty2
- ; return (eqinst {tci_co = co',tci_left=ty1',tci_right=ty2})
+ ; return (eqinst {tci_co = co', tci_left= ty1', tci_right = ty2' })
}
zonkInsts insts = mappM zonkInst insts
}
zonkInsts insts = mappM zonkInst insts
@@
-776,7
+777,7
@@
lookupSimpleInst (Method {tci_oid = id, tci_tys = tys, tci_theta = theta, tci_lo
-- [Same shortcut as in newOverloadedLit, but we
-- may have done some unification by now]
-- [Same shortcut as in newOverloadedLit, but we
-- may have done some unification by now]
-lookupSimpleInst (LitInst {tci_lit = HsIntegral i from_integer_name, tci_ty = ty, tci_loc = loc})
+lookupSimpleInst (LitInst {tci_lit = HsIntegral i from_integer_name _, tci_ty = ty, tci_loc = loc})
| Just expr <- shortCutIntLit i ty
= returnM (GenInst [] (noLoc expr))
| otherwise
| Just expr <- shortCutIntLit i ty
= returnM (GenInst [] (noLoc expr))
| otherwise
@@
-788,7
+789,7
@@
lookupSimpleInst (LitInst {tci_lit = HsIntegral i from_integer_name, tci_ty = ty
(mkHsApp (L (instLocSpan loc)
(HsVar (instToId method_inst))) integer_lit))
(mkHsApp (L (instLocSpan loc)
(HsVar (instToId method_inst))) integer_lit))
-lookupSimpleInst (LitInst {tci_lit = HsFractional f from_rat_name, tci_ty = ty, tci_loc = loc})
+lookupSimpleInst (LitInst {tci_lit = HsFractional f from_rat_name _, tci_ty = ty, tci_loc = loc})
| Just expr <- shortCutFracLit f ty
= returnM (GenInst [] (noLoc expr))
| Just expr <- shortCutFracLit f ty
= returnM (GenInst [] (noLoc expr))
@@
-800,7
+801,7
@@
lookupSimpleInst (LitInst {tci_lit = HsFractional f from_rat_name, tci_ty = ty,
returnM (GenInst [method_inst] (mkHsApp (L (instLocSpan loc)
(HsVar (instToId method_inst))) rat_lit))
returnM (GenInst [method_inst] (mkHsApp (L (instLocSpan loc)
(HsVar (instToId method_inst))) rat_lit))
-lookupSimpleInst (LitInst {tci_lit = HsIsString s from_string_name, tci_ty = ty, tci_loc = loc})
+lookupSimpleInst (LitInst {tci_lit = HsIsString s from_string_name _, tci_ty = ty, tci_loc = loc})
| Just expr <- shortCutStringLit s ty
= returnM (GenInst [] (noLoc expr))
| otherwise
| Just expr <- shortCutStringLit s ty
= returnM (GenInst [] (noLoc expr))
| otherwise
@@
-1050,9
+1051,8
@@
eqInstType inst = eitherEqInst inst mkTyVarTy id
eqInstCoercion :: Inst -> Either TcTyVar Coercion
eqInstCoercion = tci_co
eqInstCoercion :: Inst -> Either TcTyVar Coercion
eqInstCoercion = tci_co
-eqInstLeftTy, eqInstRightTy :: Inst -> TcType
-eqInstLeftTy = tci_left
-eqInstRightTy = tci_right
+eqInstTys :: Inst -> (TcType, TcType)
+eqInstTys inst = (tci_left inst, tci_right inst)
updateEqInstCoercion :: (Either TcTyVar Coercion -> Either TcTyVar Coercion) -> Inst -> Inst
updateEqInstCoercion f inst = inst {tci_co = f $ tci_co inst}
updateEqInstCoercion :: (Either TcTyVar Coercion -> Either TcTyVar Coercion) -> Inst -> Inst
updateEqInstCoercion f inst = inst {tci_co = f $ tci_co inst}