+ match_info match_ty (InstInfo inst_clas _ inst_ty _ _ _ _ _ from_here _ _ _)
+ = from_here && clas == inst_clas &&
+ match_ty inst_ty && is_plain_instance inst_ty
+
+ match_inst_ty = case maybe_tycon of
+ Just tycon -> match_tycon tycon
+ Nothing -> match_fun
+
+ match_tycon tycon inst_ty = case (maybeAppDataTyCon inst_ty) of
+ Just (inst_tc,_,_) -> tycon == inst_tc
+ Nothing -> False
+
+ match_fun inst_ty = isFunType inst_ty
+
+
+is_plain_instance inst_ty
+ = case (maybeAppDataTyCon inst_ty) of
+ Just (_,tys,_) -> all isTyVarTemplateTy tys
+ Nothing -> case maybeUnpackFunTy inst_ty of
+ Just (arg, res) -> isTyVarTemplateTy arg && isTyVarTemplateTy res
+ Nothing -> error "TcInstDecls:is_plain_instance"
+-}
+\end{code}
+
+
+Checking for a decent instance type
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+@scrutiniseInstanceType@ checks the type {\em and} its syntactic constraints:
+it must normally look like: @instance Foo (Tycon a b c ...) ...@
+
+The exceptions to this syntactic checking: (1)~if the @GlasgowExts@
+flag is on, or (2)~the instance is imported (they must have been
+compiled elsewhere). In these cases, we let them go through anyway.
+
+We can also have instances for functions: @instance Foo (a -> b) ...@.
+
+\begin{code}
+scrutiniseInstanceType from_here clas inst_tau
+ -- TYCON CHECK
+ | not (maybeToBool inst_tycon_maybe) || isSynTyCon inst_tycon
+ = failTc (instTypeErr inst_tau)
+
+ -- IMPORTED INSTANCES ARE OK (but see tcInstDecl1)
+ | not from_here
+ = returnTc (inst_tycon,arg_tys)
+
+ -- TYVARS CHECK
+ | not (all isTyVarTy arg_tys ||
+ opt_GlasgowExts)
+ = failTc (instTypeErr inst_tau)
+
+ -- DERIVING CHECK
+ -- It is obviously illegal to have an explicit instance
+ -- for something that we are also planning to `derive'
+ -- Though we can have an explicit instance which is more
+ -- specific than the derived instance
+ | clas `derivedFor` inst_tycon
+ && all isTyVarTy arg_tys
+ = failTc (derivingWhenInstanceExistsErr clas inst_tycon)
+
+ | -- CCALL CHECK
+ -- A user declaration of a CCallable/CReturnable instance
+ -- must be for a "boxed primitive" type.
+ isCcallishClass clas
+ && not (maybeToBool (maybeBoxedPrimType inst_tau)
+ || opt_CompilingGhcInternals) -- this lets us get up to mischief;
+ -- e.g., instance CCallable ()
+ = failTc (nonBoxedPrimCCallErr clas inst_tau)
+
+ | otherwise
+ = returnTc (inst_tycon,arg_tys)
+
+ where
+ (possible_tycon, arg_tys) = splitAppTy inst_tau
+ inst_tycon_maybe = getTyCon_maybe possible_tycon
+ inst_tycon = expectJust "tcInstDecls1:inst_tycon" inst_tycon_maybe
+\end{code}
+
+\begin{code}
+
+instTypeErr ty sty
+ = case ty of
+ SynTy tc _ _ -> ppBesides [ppStr "The type synonym `", ppr sty tc, rest_of_msg]
+ TyVarTy tv -> ppBesides [ppStr "The type variable `", ppr sty tv, rest_of_msg]
+ other -> ppBesides [ppStr "The type `", ppr sty ty, rest_of_msg]
+ where
+ rest_of_msg = ppStr "' cannot be used as an instance type."
+
+derivingWhenInstanceExistsErr clas tycon sty
+ = ppHang (ppBesides [ppStr "Deriving class `", ppr sty clas, ppStr "' type `", ppr sty tycon, ppStr "'"])
+ 4 (ppStr "when an explicit instance exists")
+
+derivingWhenInstanceImportedErr inst_mod clas tycon sty
+ = ppHang (ppBesides [ppStr "Deriving class `", ppr sty clas, ppStr "' type `", ppr sty tycon, ppStr "'"])
+ 4 (ppBesides [ppStr "when an instance declared in module `", pp_mod, ppStr "' has been imported"])
+ where
+ pp_mod = ppBesides [ppStr "module `", ppPStr inst_mod, ppStr "'"]
+
+nonBoxedPrimCCallErr clas inst_ty sty
+ = ppHang (ppStr "Instance isn't for a `boxed-primitive' type")
+ 4 (ppBesides [ ppStr "class `", ppr sty clas, ppStr "' type `",
+ ppr sty inst_ty, ppStr "'"])
+
+omitDefaultMethodWarn clas_op clas_name inst_ty sty
+ = ppCat [ppStr "Warning: Omitted default method for",
+ ppr sty clas_op, ppStr "in instance",
+ ppPStr clas_name, pprParendGenType sty inst_ty]
+
+
+patMonoBindsCtxt pbind sty
+ = ppHang (ppStr "In a pattern binding:")
+ 4 (ppr sty pbind)
+
+methodSigCtxt name ty sty
+ = ppHang (ppBesides [ppStr "When matching the definition of class method `",
+ ppr sty name, ppStr "' to its signature :" ])
+ 4 (ppr sty ty)
+
+bindSigCtxt method_ids sty
+ = ppHang (ppStr "When checking type signatures for: ")
+ 4 (ppInterleave (ppStr ", ") (map (ppr sty) method_ids))
+
+superClassSigCtxt sty
+ = ppStr "When checking superclass constraints on instance declaration"
projects / ghc-hetmet.git / blobdiff