buildInstanceEnvs
) where
-import Ubiq
+IMP_Ubiq()
import HsSyn ( MonoBinds, Fake, InPat, Sig )
-import RnHsSyn ( RenamedMonoBinds(..), RenamedSig(..),
+import RnHsSyn ( SYN_IE(RenamedMonoBinds), RenamedSig(..),
RenamedInstancePragmas(..) )
import TcMonad hiding ( rnMtoTcM )
-import Inst ( InstanceMapper(..) )
+import Inst ( SYN_IE(InstanceMapper) )
import Bag ( bagToList )
-import Class ( GenClass, GenClassOp, ClassInstEnv(..),
- classBigSig, classOps, classOpLocalType )
+import Class ( GenClass, GenClassOp, SYN_IE(ClassInstEnv),
+ classBigSig, classOps, classOpLocalType,
+ SYN_IE(ClassOp)
+ )
import CoreSyn ( GenCoreExpr(..), mkValLam, mkTyApp )
import Id ( GenId, mkDictFunId, mkConstMethodId, mkSysLocal )
import MatchEnv ( nullMEnv, insertMEnv )
import Name ( getSrcLoc, Name{--O only-} )
import PprType ( GenClass, GenType, GenTyVar )
import Pretty
-import SpecEnv ( SpecEnv(..), nullSpecEnv, addOneToSpecEnv )
+import SpecEnv ( SpecEnv, nullSpecEnv, addOneToSpecEnv )
import SrcLoc ( SrcLoc )
import Type ( mkSigmaTy, mkForAllTys, mkDictTy, mkTyVarTys,
- splitForAllTy, instantiateTy, matchTy, ThetaType(..) )
+ splitForAllTy, instantiateTy, matchTy, SYN_IE(ThetaType) )
import TyVar ( GenTyVar )
import Unique ( Unique )
import Util ( equivClasses, zipWithEqual, panic )
[Id] -- Constant methods (either all or none)
RenamedMonoBinds -- Bindings, b
Bool -- True <=> local instance decl
- (Maybe Module) -- Name of module where this instance defined; Nothing => Prelude
+ Module -- Name of module where this instance defined
SrcLoc -- Source location assoc'd with this instance's defn
[RenamedSig] -- User pragmas recorded for generating specialised instances
\end{code}
\begin{code}
mkInstanceRelatedIds :: Bool
-> SrcLoc
- -> Maybe Module
+ -> Module
-> RenamedInstancePragmas
-> Class
-> [TyVar]
-- MAKE THE CONSTANT-METHOD IDS
-- if there are no type variables involved
- (if not (null inst_decl_theta)
+ (if (null inst_decl_theta)
then
- returnTc []
- else
mapTc mk_const_meth_id class_ops
+ else
+ returnTc []
) `thenTc` \ const_meth_ids ->
returnTc (dfun_id, dfun_theta, const_meth_ids)
addClassInstance
(class_inst_env, op_spec_envs)
- (InstInfo clas inst_tyvars inst_ty inst_decl_theta dfun_theta
+ (InstInfo clas inst_tyvars inst_ty _ _
dfun_id const_meth_ids _ _ _ src_loc _)
=
-- If there are any constant methods, then add them to
-- the SpecEnv of each class op (ie selector)
--
- -- Example. class Foo a where { op :: Baz b => a -> b }
- -- instance Foo (p,q) where { op (x,y) = ... }
+ -- Example. class Foo a where { op :: Baz b => a -> b; ... }
+ -- instance Foo (p,q) where { op (x,y) = ... ; ... }
+ --
+ -- The class decl means that
+ -- op :: forall a. Foo a => forall b. Baz b => a -> b
--
-- The constant method from the instance decl will be:
-- op_Pair :: forall p q b. Baz b => (p,q) -> b
--
-- What we put in op's SpecEnv is
- -- (p,q) b |--> (\d::Foo (p,q) -> op_Pair p q b)
+ -- (p,q) |--> (\d::Foo (p,q) -> op_Pair p q)
--
-- Here, [p,q] are the inst_tyvars, and d is a dict whose only
-- purpose is to cancel with the dict to which op is applied.
| otherwise = zipWithEqual "add_const_meth" add_const_meth op_spec_envs const_meth_ids
add_const_meth (op,spec_env) meth_id
- = (op, case addOneToSpecEnv spec_env (inst_ty : local_tyvar_tys) rhs of
+ = (op, case addOneToSpecEnv spec_env [inst_ty] rhs of
Failed (tys', rhs') -> panic "TcInstDecls:add_const_meth"
Succeeded spec_env' -> spec_env' )
where
- (local_tyvars, _) = splitForAllTy (classOpLocalType op)
- local_tyvar_tys = mkTyVarTys local_tyvars
- rhs = mkValLam [dict] (mkTyApp (mkTyApp (Var meth_id)
- (mkTyVarTys inst_tyvars))
- local_tyvar_tys)
+ rhs = mkValLam [dict] (mkTyApp (Var meth_id) (mkTyVarTys inst_tyvars))
in
returnTc (class_inst_env', op_spec_envs')
}