projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2000-07-04 20:01:00 by panne]
[ghc-hetmet.git]
/
ghc
/
compiler
/
typecheck
/
TcInstUtil.lhs
diff --git
a/ghc/compiler/typecheck/TcInstUtil.lhs
b/ghc/compiler/typecheck/TcInstUtil.lhs
index
bf196bb
..
e3221a8
100644
(file)
--- a/
ghc/compiler/typecheck/TcInstUtil.lhs
+++ b/
ghc/compiler/typecheck/TcInstUtil.lhs
@@
-21,13
+21,13
@@
import TcMonad
import Inst ( InstanceMapper )
import Bag ( bagToList, Bag )
import Inst ( InstanceMapper )
import Bag ( bagToList, Bag )
-import Class ( ClassInstEnv, Class )
-import Var ( TyVar, Id )
-import SpecEnv ( emptySpecEnv, addToSpecEnv )
+import Class ( Class )
+import Var ( TyVar, Id, idName )
+import InstEnv ( InstEnv, emptyInstEnv, addToInstEnv )
import Maybes ( MaybeErr(..), mkLookupFunDef )
import Maybes ( MaybeErr(..), mkLookupFunDef )
-import Name ( getSrcLoc )
+import Name ( getSrcLoc, nameModule, isLocallyDefined )
import SrcLoc ( SrcLoc )
import SrcLoc ( SrcLoc )
-import Type ( ThetaType, Type )
+import Type ( ThetaType, Type, ClassContext )
import PprType ( pprConstraint )
import Class ( classTyCon )
import DataCon ( DataCon )
import PprType ( pprConstraint )
import Class ( classTyCon )
import DataCon ( DataCon )
@@
-45,7
+45,7
@@
data InstInfo
Class -- Class, k
[TyVar] -- Type variables, tvs
[Type] -- The types at which the class is being instantiated
Class -- Class, k
[TyVar] -- Type variables, tvs
[Type] -- The types at which the class is being instantiated
- ThetaType -- inst_decl_theta: the original context, c, from the
+ ClassContext -- inst_decl_theta: the original context, c, from the
-- instance declaration. It constrains (some of)
-- the TyVars above
Id -- The dfun id
-- instance declaration. It constrains (some of)
-- the TyVars above
Id -- The dfun id
@@
-89,18
+89,18
@@
buildInstanceEnvs info
in
mapNF_Tc buildInstanceEnv info_by_class `thenNF_Tc` \ inst_env_entries ->
let
in
mapNF_Tc buildInstanceEnv info_by_class `thenNF_Tc` \ inst_env_entries ->
let
- class_lookup_fn = mkLookupFunDef (==) inst_env_entries emptySpecEnv
+ class_lookup_fn = mkLookupFunDef (==) inst_env_entries emptyInstEnv
in
returnNF_Tc class_lookup_fn
\end{code}
\begin{code}
buildInstanceEnv :: [InstInfo] -- Non-empty, and all for same class
in
returnNF_Tc class_lookup_fn
\end{code}
\begin{code}
buildInstanceEnv :: [InstInfo] -- Non-empty, and all for same class
- -> NF_TcM s (Class, ClassInstEnv)
+ -> NF_TcM s (Class, InstEnv)
buildInstanceEnv inst_infos@((InstInfo clas _ _ _ _ _ _ _) : _)
= foldrNF_Tc addClassInstance
buildInstanceEnv inst_infos@((InstInfo clas _ _ _ _ _ _ _) : _)
= foldrNF_Tc addClassInstance
- emptySpecEnv
+ emptyInstEnv
inst_infos `thenNF_Tc` \ class_inst_env ->
returnNF_Tc (clas, class_inst_env)
\end{code}
inst_infos `thenNF_Tc` \ class_inst_env ->
returnNF_Tc (clas, class_inst_env)
\end{code}
@@
-112,18
+112,18
@@
about any overlap with an existing instance.
\begin{code}
addClassInstance
:: InstInfo
\begin{code}
addClassInstance
:: InstInfo
- -> ClassInstEnv
- -> NF_TcM s ClassInstEnv
+ -> InstEnv
+ -> NF_TcM s InstEnv
addClassInstance
(InstInfo clas inst_tyvars inst_tys _
dfun_id _ src_loc _)
class_inst_env
= -- Add the instance to the class's instance environment
addClassInstance
(InstInfo clas inst_tyvars inst_tys _
dfun_id _ src_loc _)
class_inst_env
= -- Add the instance to the class's instance environment
- case addToSpecEnv opt_AllowOverlappingInstances
+ case addToInstEnv opt_AllowOverlappingInstances
class_inst_env inst_tyvars inst_tys dfun_id of
class_inst_env inst_tyvars inst_tys dfun_id of
- Failed (ty', dfun_id') -> addErrTc (dupInstErr clas (inst_tys, src_loc)
- (ty', getSrcLoc dfun_id'))
+ Failed (tys', dfun_id') -> addErrTc (dupInstErr clas (inst_tys, dfun_id)
+ (tys', dfun_id'))
`thenNF_Tc_`
returnNF_Tc class_inst_env
`thenNF_Tc_`
returnNF_Tc class_inst_env
@@
-131,10
+131,13
@@
addClassInstance
\end{code}
\begin{code}
\end{code}
\begin{code}
-dupInstErr clas info1@(tys1, locn1) info2@(tys2, locn2)
+dupInstErr clas info1@(tys1, dfun1) info2@(tys2, dfun2)
-- Overlapping/duplicate instances for given class; msg could be more glamourous
= hang (ptext SLIT("Duplicate or overlapping instance declarations"))
4 (sep [ptext SLIT("for") <+> quotes (pprConstraint clas tys1),
-- Overlapping/duplicate instances for given class; msg could be more glamourous
= hang (ptext SLIT("Duplicate or overlapping instance declarations"))
4 (sep [ptext SLIT("for") <+> quotes (pprConstraint clas tys1),
- nest 4 (sep [ptext SLIT("at") <+> ppr locn1,
- ptext SLIT("and") <+> ppr locn2])])
+ nest 4 (sep [ppr_loc dfun1, ptext SLIT("and") <+> ppr_loc dfun2])])
+ where
+ ppr_loc dfun
+ | isLocallyDefined dfun = ptext SLIT("defined at") <+> ppr (getSrcLoc dfun)
+ | otherwise = ptext SLIT("imported from module") <+> quotes (ppr (nameModule (idName dfun)))
\end{code}
\end{code}