Typechecking class declarations
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TcClassDcl ( tcClassSigs, tcClassDecl2,
getGenericInstances,
MethodSpec, tcMethodBind, mkMethodBind,
import BasicTypes
import Bag
import FastString
+
+import Control.Monad
\end{code}
rho_ty = ASSERT( length tyvars == length inst_tys )
substTyWith tyvars inst_tys rho
(preds,tau) = tcSplitPhiTy rho_ty
- first_pred = head preds
+ first_pred = ASSERT( not (null preds)) head preds
in
-- The first predicate should be of form (C a b)
-- where C is the class in question
getSrcSpanM `thenM` \ loc ->
let
real_tau = mkPhiTy (tail preds) tau
- meth_id = mkUserLocal (getOccName sel_id) uniq real_tau
- (srcSpanStart loc) --TODO
+ meth_id = mkUserLocal (getOccName sel_id) uniq real_tau loc
in
returnM (Nothing, meth_id)
-- case we require that the instance decl is for a single-parameter
-- type class with type variable arguments:
-- instance (...) => C (T a b)
- clas_tyvar = head (classTyVars clas)
+ clas_tyvar = ASSERT (not (null (classTyVars clas))) head (classTyVars clas)
Just tycon = maybe_tycon
maybe_tycon = case inst_tys of
[ty] -> case tcSplitTyConApp_maybe ty of
-- The renamer just puts the selector ID as the binder in the method binding
-- but we must use the method name; so we substitute it here. Crude but simple.
find_bind sel_name meth_name binds
- = foldlBag seqMaybe Nothing (mapBag f binds)
+ = foldlBag mplus Nothing (mapBag f binds)
where
f (L loc1 bind@(FunBind { fun_id = L loc2 op_name })) | op_name == sel_name
= Just (L loc1 (bind { fun_id = L loc2 meth_name }))
-- Make the dictionary function.
getSrcSpanM `thenM` \ span ->
getOverlapFlag `thenM` \ overlap_flag ->
- newDFunName clas [inst_ty] (srcSpanStart span) `thenM` \ dfun_name ->
+ newDFunName clas [inst_ty] span `thenM` \ dfun_name ->
let
inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
dfun_id = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
else "data type" ++ maybeInst
| isFamilyDecl decl = "family"
- maybeInst | isFamInstDecl decl = " family"
+ maybeInst | isFamInstDecl decl = " instance"
| otherwise = ""
ctxt = hsep [ptext SLIT("In the"), text thing,