2 % (c) The AQUA Project, Glasgow University, 1996-1998
4 \section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
9 charTyCon_name, listTyCon_name, parrTyCon_name, tupleTyCon_name,
10 extractHsTyVars, extractHsTyNames, extractHsTyNames_s,
11 extractFunDepNames, extractHsCtxtTyNames, extractHsPredTyNames,
14 hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs
17 #include "HsVersions.h"
20 import Class ( FunDep )
21 import TysWiredIn ( tupleTyCon, listTyCon, parrTyCon, hetMetCodeTypeTyCon, charTyCon )
22 import Name ( Name, getName, isTyVarName )
24 import BasicTypes ( Boxity )
28 %************************************************************************
30 \subsection{Free variables}
32 %************************************************************************
34 These free-variable finders returns tycons and classes too.
37 charTyCon_name, listTyCon_name, parrTyCon_name :: Name
38 charTyCon_name = getName charTyCon
39 listTyCon_name = getName listTyCon
40 parrTyCon_name = getName parrTyCon
41 hetMetCodeTypeTyCon_name :: Name
42 hetMetCodeTypeTyCon_name = getName hetMetCodeTypeTyCon
44 tupleTyCon_name :: Boxity -> Int -> Name
45 tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
47 extractHsTyVars :: LHsType Name -> NameSet
48 extractHsTyVars x = filterNameSet isTyVarName (extractHsTyNames x)
50 extractFunDepNames :: FunDep Name -> NameSet
51 extractFunDepNames (ns1, ns2) = mkNameSet ns1 `unionNameSets` mkNameSet ns2
53 extractHsTyNames :: LHsType Name -> NameSet
57 getl (L _ ty) = get ty
59 get (HsAppTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2
60 get (HsListTy ty) = unitNameSet listTyCon_name `unionNameSets` getl ty
61 get (HsPArrTy ty) = unitNameSet parrTyCon_name `unionNameSets` getl ty
62 get (HsModalBoxType ecn ty) = (unitNameSet ecn)
64 (unitNameSet hetMetCodeTypeTyCon_name)
67 get (HsKappaTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2
68 get (HsTupleTy _ tys) = extractHsTyNames_s tys
69 get (HsFunTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2
70 get (HsPredTy p) = extractHsPredTyNames p
71 get (HsOpTy ty1 op ty2) = getl ty1 `unionNameSets` getl ty2 `unionNameSets` unitNameSet (unLoc op)
72 get (HsParTy ty) = getl ty
73 get (HsBangTy _ ty) = getl ty
74 get (HsRecTy flds) = extractHsTyNames_s (map cd_fld_type flds)
75 get (HsTyVar tv) = unitNameSet tv
76 get (HsSpliceTy _ fvs _) = fvs
77 get (HsQuasiQuoteTy {}) = emptyNameSet
78 get (HsKindSig ty _) = getl ty
80 ctxt ty) = (extractHsCtxtTyNames ctxt
81 `unionNameSets` getl ty)
83 mkNameSet (hsLTyVarNames tvs)
84 get (HsDocTy ty _) = getl ty
85 get (HsCoreTy {}) = emptyNameSet -- This probably isn't quite right
86 -- but I don't think it matters
88 extractHsTyNames_s :: [LHsType Name] -> NameSet
89 extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
91 extractHsCtxtTyNames :: LHsContext Name -> NameSet
92 extractHsCtxtTyNames (L _ ctxt)
93 = foldr (unionNameSets . extractHsPredTyNames . unLoc) emptyNameSet ctxt
95 -- You don't import or export implicit parameters,
96 -- so don't mention the IP names
97 extractHsPredTyNames :: HsPred Name -> NameSet
98 extractHsPredTyNames (HsClassP cls tys)
99 = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
100 extractHsPredTyNames (HsEqualP ty1 ty2)
101 = extractHsTyNames ty1 `unionNameSets` extractHsTyNames ty2
102 extractHsPredTyNames (HsIParam _ ty)
103 = extractHsTyNames ty
107 %************************************************************************
109 \subsection{Free variables of declarations}
111 %************************************************************************
113 Return the Names that must be in scope if we are to use this declaration.
114 In all cases this is set up for interface-file declarations:
115 - for class decls we ignore the bindings
116 - for instance decls likewise, plus the pragmas
117 - for rule decls, we ignore HsRules
118 - for data decls, we ignore derivings
120 *** See "THE NAMING STORY" in HsDecls ****
124 hsSigsFVs :: [LSig Name] -> FreeVars
125 hsSigsFVs sigs = plusFVs (map (hsSigFVs.unLoc) sigs)
127 hsSigFVs :: Sig Name -> FreeVars
128 hsSigFVs (TypeSig _ ty) = extractHsTyNames ty
129 hsSigFVs (GenericSig _ ty) = extractHsTyNames ty
130 hsSigFVs (SpecInstSig ty) = extractHsTyNames ty
131 hsSigFVs (SpecSig _ ty _) = extractHsTyNames ty
132 hsSigFVs _ = emptyFVs
135 conDeclFVs :: LConDecl Name -> FreeVars
136 conDeclFVs (L _ (ConDecl { con_qvars = tyvars, con_cxt = context,
137 con_details = details, con_res = res_ty}))
138 = delFVs (map hsLTyVarName tyvars) $
139 extractHsCtxtTyNames context `plusFV`
140 conDetailsFVs details `plusFV`
143 conResTyFVs :: ResType Name -> FreeVars
144 conResTyFVs ResTyH98 = emptyFVs
145 conResTyFVs (ResTyGADT ty) = extractHsTyNames ty
147 conDetailsFVs :: HsConDeclDetails Name -> FreeVars
148 conDetailsFVs details = plusFVs (map bangTyFVs (hsConDeclArgTys details))
150 bangTyFVs :: LHsType Name -> FreeVars
151 bangTyFVs bty = extractHsTyNames (getBangType bty)