RdrNameTyClDecl,
RdrNameRuleDecl,
RdrNameRuleBndr,
+ RdrNameDeprecation,
RdrNameHsRecordBinds,
RdrBinding(..),
RdrNameGenPragmas,
RdrNameInstancePragmas,
extractHsTyRdrNames,
- extractHsTyRdrTyVars,
+ extractHsTyRdrTyVars, extractHsTysRdrTyVars,
extractPatsTyVars,
extractRuleBndrsTyVars,
- mkOpApp, mkClassDecl, mkClassOpSig,
+ mkOpApp, mkClassDecl, mkClassOpSig, mkConDecl,
cvBinds,
cvMonoBindsAndSigs,
import HsSyn
import Name ( mkClassTyConOcc, mkClassDataConOcc )
-import OccName ( mkClassTyConOcc, mkClassDataConOcc,
+import OccName ( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc,
mkSuperDictSelOcc, mkDefaultMethodOcc
)
import RdrName ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc )
type RdrNameClassOpSig = Sig RdrName
type RdrNameConDecl = ConDecl RdrName
type RdrNameConDetails = ConDetails RdrName
-type RdrNameContext = Context RdrName
+type RdrNameContext = HsContext RdrName
type RdrNameHsDecl = HsDecl RdrName RdrNamePat
type RdrNameSpecDataSig = SpecDataSig RdrName
type RdrNameDefaultDecl = DefaultDecl RdrName
type RdrNameTyClDecl = TyClDecl RdrName RdrNamePat
type RdrNameRuleBndr = RuleBndr RdrName
type RdrNameRuleDecl = RuleDecl RdrName RdrNamePat
+type RdrNameDeprecation = Deprecation RdrName
type RdrNameHsRecordBinds = HsRecordBinds RdrName RdrNamePat
extractHsTyRdrTyVars :: RdrNameHsType -> [RdrName]
extractHsTyRdrTyVars ty = filter isRdrTyVar (extractHsTyRdrNames ty)
+extractHsTysRdrTyVars :: [RdrNameHsType] -> [RdrName]
+extractHsTysRdrTyVars tys = filter isRdrTyVar (nub (extract_tys tys []))
+
extractRuleBndrsTyVars :: [RuleBndr RdrName] -> [RdrName]
extractRuleBndrsTyVars bndrs = filter isRdrTyVar (nub (foldr go [] bndrs))
where
go (RuleBndr _) acc = acc
go (RuleBndrSig _ ty) acc = extract_ty ty acc
-extractHsCtxtRdrNames :: Context RdrName -> [RdrName]
+extractHsCtxtRdrNames :: HsContext RdrName -> [RdrName]
extractHsCtxtRdrNames ty = nub (extract_ctxt ty [])
-extract_ctxt ctxt acc = foldr extract_ass acc ctxt
- where
- extract_ass (cls, tys) acc = foldr extract_ty (cls : acc) tys
+extract_ctxt ctxt acc = foldr extract_pred acc ctxt
+
+extract_pred (HsPClass cls tys) acc = foldr extract_ty (cls : acc) tys
+extract_pred (HsPIParam n ty) acc = extract_ty ty acc
+
+extract_tys tys acc = foldr extract_ty acc tys
extract_ty (MonoTyApp ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
extract_ty (MonoListTy ty) acc = extract_ty ty acc
extract_ty (MonoTupleTy tys _) acc = foldr extract_ty acc tys
extract_ty (MonoFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
+extract_ty (MonoIParamTy n ty) acc = extract_ty ty acc
extract_ty (MonoDictTy cls tys) acc = foldr extract_ty (cls : acc) tys
extract_ty (MonoUsgTy usg ty) acc = extract_ty ty acc
extract_ty (MonoUsgForAllTy uv ty) acc = extract_ty ty acc
name of the class itself. This saves recording the names in the interface
file (which would be equally good).
-Similarly for mkClassOpSig and default-method names.
+Similarly for mkConDecl, mkClassOpSig and default-method names.
\begin{code}
-mkClassDecl cxt cname tyvars sigs mbinds prags loc
- = ClassDecl cxt cname tyvars sigs mbinds prags tname dname sc_sel_names loc
+mkClassDecl cxt cname tyvars fds sigs mbinds prags loc
+ = ClassDecl cxt cname tyvars fds sigs mbinds prags tname dname dwname sc_sel_names loc
where
- cls_occ = rdrNameOcc cname
- dname = mkRdrUnqual (mkClassDataConOcc cls_occ)
- tname = mkRdrUnqual (mkClassTyConOcc cls_occ)
+ cls_occ = rdrNameOcc cname
+ data_occ = mkClassDataConOcc cls_occ
+ dname = mkRdrUnqual data_occ
+ dwname = mkRdrUnqual (mkWorkerOcc data_occ)
+ tname = mkRdrUnqual (mkClassTyConOcc cls_occ)
sc_sel_names = [ mkRdrUnqual (mkSuperDictSelOcc n cls_occ)
| n <- [1..length cxt]]
-- We number off the superclass selectors, 1, 2, 3 etc so that we
-- superclasses both called C!)
mkClassOpSig has_default_method op ty loc
- | not has_default_method = ClassOpSig op Nothing ty loc
- | otherwise = ClassOpSig op (Just dm_rn) ty loc
+ = ClassOpSig op dm_rn has_default_method ty loc
where
dm_rn = mkRdrUnqual (mkDefaultMethodOcc (rdrNameOcc op))
+
+mkConDecl cname ex_vars cxt details loc
+ = ConDecl cname wkr_name ex_vars cxt details loc
+ where
+ wkr_name = mkRdrUnqual (mkWorkerOcc (rdrNameOcc cname))
\end{code}
A useful function for building @OpApps@. The operator is always a variable,
cvInstDeclSig sig = sig
-cvClassOpSig (Sig var poly_ty src_loc) = ClassOpSig var Nothing poly_ty src_loc
+cvClassOpSig (Sig var poly_ty src_loc) = ClassOpSig var (panic "cvClassOpSig:dm_name")
+ (panic "cvClassOpSig:dm_present")
+ poly_ty src_loc
cvClassOpSig sig = sig
\end{code}