-get_binders decls = (bagToList tyvars, bagToList tycons, bagToList classes)
- where
- (tyvars, tycons, classes) = foldBag union3 get_binders1
- (emptyBag,emptyBag,emptyBag)
- decls
-
- union3 (a1,a2,a3) (b1,b2,b3)
- = (a1 `unionBags` b1, a2 `unionBags` b2, a3 `unionBags` b3)
-
-get_binders1 (TyD (TyData _ name tyvars _ _ _ _))
- = (listToBag tyvars, unitBag (name,Nothing), emptyBag)
-get_binders1 (TyD (TyNew _ name tyvars _ _ _ _))
- = (listToBag tyvars, unitBag (name,Nothing), emptyBag)
-get_binders1 (TyD (TySynonym name tyvars _ _))
- = (listToBag tyvars, unitBag (name, Just (length tyvars)), emptyBag)
-get_binders1 (ClD (ClassDecl _ name tyvar sigs _ _ _))
- = (unitBag tyvar `unionBags` sigs_tvs sigs,
- emptyBag, unitBag name)
-
-sigs_tvs sigs = unionManyBags (map sig_tvs sigs)
+----------------------------------------------------
+get_cons cons = unionManyUniqSets (map get_con cons)
+
+----------------------------------------------------
+get_con (ConDecl _ _ _ ctxt details _)
+ = get_ctxt ctxt `unionUniqSets` get_con_details details
+
+----------------------------------------------------
+get_con_details (VanillaCon btys) = unionManyUniqSets (map get_bty btys)
+get_con_details (InfixCon bty1 bty2) = unionUniqSets (get_bty bty1) (get_bty bty2)
+get_con_details (NewCon ty _) = get_ty ty
+get_con_details (RecCon nbtys) = unionManyUniqSets (map (get_bty.snd) nbtys)
+
+----------------------------------------------------
+get_bty (Banged ty) = get_ty ty
+get_bty (Unbanged ty) = get_ty ty
+get_bty (Unpacked ty) = get_ty ty
+
+----------------------------------------------------
+get_ty (HsTyVar name) | isTvOcc (nameOccName name) = emptyUniqSet
+ | otherwise = set_name name
+get_ty (HsAppTy ty1 ty2) = unionUniqSets (get_ty ty1) (get_ty ty2)
+get_ty (HsFunTy ty1 ty2) = unionUniqSets (get_ty ty1) (get_ty ty2)
+get_ty (HsListTy ty) = set_name listTyCon_name `unionUniqSets` get_ty ty
+get_ty (HsTupleTy (HsTupCon n _) tys) = set_name n `unionUniqSets` get_tys tys
+get_ty (HsUsgTy _ ty) = get_ty ty
+get_ty (HsUsgForAllTy _ ty) = get_ty ty
+get_ty (HsForAllTy _ ctxt mty) = get_ctxt ctxt `unionUniqSets` get_ty mty
+get_ty (HsPredTy (HsPClass name _)) = set_name name
+get_ty (HsPredTy (HsPIParam _ _)) = emptyUniqSet -- I think
+
+----------------------------------------------------
+get_tys tys = unionManyUniqSets (map get_ty tys)
+
+----------------------------------------------------
+get_sigs sigs
+ = unionManyUniqSets (map get_sig sigs)