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,
19 #include "HsVersions.h"
22 import Class ( FunDep )
23 import TysWiredIn ( tupleTyCon, listTyCon, parrTyCon, hetMetCodeTypeTyCon, charTyCon )
24 import Name ( Name, getName, isTyVarName )
26 import BasicTypes ( Boxity )
27 import SrcLoc ( Located(..), unLoc )
30 %************************************************************************
32 \subsection{Free variables}
34 %************************************************************************
36 These free-variable finders returns tycons and classes too.
39 charTyCon_name, listTyCon_name, parrTyCon_name :: Name
40 charTyCon_name = getName charTyCon
41 listTyCon_name = getName listTyCon
42 parrTyCon_name = getName parrTyCon
43 hetMetCodeTypeTyCon_name :: Name
44 hetMetCodeTypeTyCon_name = getName hetMetCodeTypeTyCon
46 tupleTyCon_name :: Boxity -> Int -> Name
47 tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
49 extractHsTyVars :: LHsType Name -> NameSet
50 extractHsTyVars x = filterNameSet isTyVarName (extractHsTyNames x)
52 extractFunDepNames :: FunDep Name -> NameSet
53 extractFunDepNames (ns1, ns2) = mkNameSet ns1 `unionNameSets` mkNameSet ns2
55 extractHsTyNames :: LHsType Name -> NameSet
59 getl (L _ ty) = get ty
61 get (HsAppTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2
62 get (HsListTy ty) = unitNameSet listTyCon_name `unionNameSets` getl ty
63 get (HsPArrTy ty) = unitNameSet parrTyCon_name `unionNameSets` getl ty
64 get (HsModalBoxType ecn ty) = (unitNameSet ecn) `unionNameSets` (unitNameSet hetMetCodeTypeTyCon_name) `unionNameSets` (getl ty)
65 get (HsTupleTy _ tys) = extractHsTyNames_s tys
66 get (HsFunTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2
67 get (HsPredTy p) = extractHsPredTyNames p
68 get (HsOpTy ty1 op ty2) = getl ty1 `unionNameSets` getl ty2 `unionNameSets` unitNameSet (unLoc op)
69 get (HsParTy ty) = getl ty
70 get (HsBangTy _ ty) = getl ty
71 get (HsRecTy flds) = extractHsTyNames_s (map cd_fld_type flds)
72 get (HsNumTy _) = emptyNameSet
73 get (HsTyVar tv) = unitNameSet tv
74 get (HsSpliceTy _ fvs _) = fvs
75 get (HsQuasiQuoteTy {}) = emptyNameSet
76 get (HsKindSig ty _) = getl ty
78 ctxt ty) = (extractHsCtxtTyNames ctxt
79 `unionNameSets` getl ty)
81 mkNameSet (hsLTyVarNames tvs)
82 get (HsDocTy ty _) = getl ty
83 get (HsCoreTy {}) = emptyNameSet -- This probably isn't quite right
84 -- but I don't think it matters
86 extractHsTyNames_s :: [LHsType Name] -> NameSet
87 extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
89 extractHsCtxtTyNames :: LHsContext Name -> NameSet
90 extractHsCtxtTyNames (L _ ctxt)
91 = foldr (unionNameSets . extractHsPredTyNames . unLoc) emptyNameSet ctxt
93 -- You don't import or export implicit parameters,
94 -- so don't mention the IP names
95 extractHsPredTyNames :: HsPred Name -> NameSet
96 extractHsPredTyNames (HsClassP cls tys)
97 = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
98 extractHsPredTyNames (HsEqualP ty1 ty2)
99 = extractHsTyNames ty1 `unionNameSets` extractHsTyNames ty2
100 extractHsPredTyNames (HsIParam _ ty)
101 = extractHsTyNames ty
105 %************************************************************************
107 \subsection{Free variables of declarations}
109 %************************************************************************
111 Return the Names that must be in scope if we are to use this declaration.
112 In all cases this is set up for interface-file declarations:
113 - for class decls we ignore the bindings
114 - for instance decls likewise, plus the pragmas
115 - for rule decls, we ignore HsRules
116 - for data decls, we ignore derivings
118 *** See "THE NAMING STORY" in HsDecls ****
122 hsSigsFVs :: [LSig Name] -> FreeVars
123 hsSigsFVs sigs = plusFVs (map (hsSigFVs.unLoc) sigs)
125 hsSigFVs :: Sig Name -> FreeVars
126 hsSigFVs (TypeSig _ ty) = extractHsTyNames ty
127 hsSigFVs (SpecInstSig ty) = extractHsTyNames ty
128 hsSigFVs (SpecSig _ ty _) = extractHsTyNames ty
129 hsSigFVs _ = emptyFVs
132 conDeclFVs :: LConDecl Name -> FreeVars
133 conDeclFVs (L _ (ConDecl { con_qvars = tyvars, con_cxt = context,
134 con_details = details, con_res = res_ty}))
135 = delFVs (map hsLTyVarName tyvars) $
136 extractHsCtxtTyNames context `plusFV`
137 conDetailsFVs details `plusFV`
140 conResTyFVs :: ResType Name -> FreeVars
141 conResTyFVs ResTyH98 = emptyFVs
142 conResTyFVs (ResTyGADT ty) = extractHsTyNames ty
144 conDetailsFVs :: HsConDeclDetails Name -> FreeVars
145 conDetailsFVs details = plusFVs (map bangTyFVs (hsConDeclArgTys details))
147 bangTyFVs :: LHsType Name -> FreeVars
148 bangTyFVs bty = extractHsTyNames (getBangType bty)
152 %************************************************************************
154 \subsection{A few functions on generic defintions
156 %************************************************************************
158 These functions on generics are defined over Matches Name, which is
159 why they are here and not in HsMatches.
162 maybeGenericMatch :: LMatch Name -> Maybe (HsType Name, LMatch Name)
163 -- Tells whether a Match is for a generic definition
164 -- and extract the type from a generic match and put it at the front
166 maybeGenericMatch (L loc (Match (L _ (TypePat (L _ ty)) : pats) sig_ty grhss))
167 = Just (ty, L loc (Match pats sig_ty grhss))
169 maybeGenericMatch _ = Nothing