projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Comments and layout only
[ghc-hetmet.git]
/
compiler
/
typecheck
/
Inst.lhs
diff --git
a/compiler/typecheck/Inst.lhs
b/compiler/typecheck/Inst.lhs
index
2fc44dd
..
c34bf6d
100644
(file)
--- a/
compiler/typecheck/Inst.lhs
+++ b/
compiler/typecheck/Inst.lhs
@@
-24,7
+24,7
@@
module Inst (
tyVarsOfInst, tyVarsOfInsts, tyVarsOfLIE,
ipNamesOfInst, ipNamesOfInsts, fdPredsOfInst, fdPredsOfInsts,
tyVarsOfInst, tyVarsOfInsts, tyVarsOfLIE,
ipNamesOfInst, ipNamesOfInsts, fdPredsOfInst, fdPredsOfInsts,
- instLoc, getDictClassTys, dictPred,
+ getDictClassTys, dictPred,
lookupSimpleInst, LookupInstResult(..), lookupPred,
tcExtendLocalInstEnv, tcGetInstEnvs, getOverlapFlag,
lookupSimpleInst, LookupInstResult(..), lookupPred,
tcExtendLocalInstEnv, tcGetInstEnvs, getOverlapFlag,
@@
-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
(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
mkForAllTys tvs $
mkPhiTy (map dictPred givens) $
if isSingleton wanteds then
@@
-118,8
+119,6
@@
mkImplicTy tvs givens wanteds -- The type of an implication constraint
else
mkTupleTy Boxed (length wanteds) (map instType wanteds)
else
mkTupleTy Boxed (length wanteds) (map instType wanteds)
-instLoc inst = tci_loc inst
-
dictPred (Dict {tci_pred = pred}) = pred
dictPred inst = pprPanic "dictPred" (ppr inst)
dictPred (Dict {tci_pred = pred}) = pred
dictPred inst = pprPanic "dictPred" (ppr inst)
@@
-332,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)
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}
%************************************************************************
\end{code}
%************************************************************************
@@
-665,7
+665,7
@@
lookupSimpleInst :: Inst -> TcM LookupInstResult
-- the LIE. Instead, any Insts needed by the lookup are returned in
-- the LookupInstResult, where they can be further processed by tcSimplify
-- the LIE. Instead, any Insts needed by the lookup are returned in
-- the LookupInstResult, where they can be further processed by tcSimplify
---------------------- Impliciations ------------------------
+--------------------- Implications ------------------------
lookupSimpleInst (ImplicInst {}) = return NoInstance
--------------------- Methods ------------------------
lookupSimpleInst (ImplicInst {}) = return NoInstance
--------------------- Methods ------------------------
@@
-785,7
+785,7
@@
lookupPred pred@(ClassP clas tys)
; return Nothing }
}}
; return Nothing }
}}
-lookupPred ip_pred = return Nothing
+lookupPred ip_pred = return Nothing -- Implicit parameters
record_dfun_usage dfun_id
= do { hsc_env <- getTopEnv
record_dfun_usage dfun_id
= do { hsc_env <- getTopEnv