InPat(..), HsBinds(..), GRHSs(..),
HsExpr(..), HsLit(..), HsType(..), pprClassAssertion,
unguardedRHS, andMonoBinds, andMonoBindList, getTyVarName,
- isClassDecl
+ isClassDecl, isClassOpSig
)
import HsPragmas ( ClassPragmas(..) )
import BasicTypes ( NewOrData(..), TopLevelFlag(..), RecFlag(..), StrictnessMark(..) )
-- The net effect is to mutate the class kind
tcExtendTopTyVarScope kind tyvar_names $ \ _ _ ->
tcContext context `thenTc_`
- mapTc kc_sig class_sigs `thenTc_`
+ mapTc kc_sig the_class_sigs `thenTc_`
returnTc ()
where
+ the_class_sigs = filter isClassOpSig class_sigs
+
kc_sig (ClassOpSig _ _ op_ty loc) = tcAddSrcLoc loc (tcHsType op_ty)
\end{code}
-- traceTc (text "tcClassCtxt done" <+> ppr class_name) `thenTc_`
-- CHECK THE CLASS SIGNATURES,
- mapTc (tcClassSig rec_env rec_class tyvars) class_sigs
+ mapTc (tcClassSig rec_env rec_class tyvars)
+ (filter isClassOpSig class_sigs)
`thenTc` \ sig_stuff ->
-- MAKE THE CLASS OBJECT ITSELF
----------------------------------------------------
get_sigs sigs
- = unionManyUniqSets (map get_sig sigs)
+ = unionManyUniqSets (mapMaybe get_sig sigs)
where
- get_sig (ClassOpSig _ _ ty _) = get_ty ty
- get_sig other = panic "TcTyClsDecls:get_sig"
+ get_sig (ClassOpSig _ _ ty _) = Just (get_ty ty)
+ get_sig (FixSig _) = Nothing
+ get_sig other = panic "TcTyClsDecls:get_sig"
----------------------------------------------------
set_name name = unitUniqSet (getUnique name)