2 % (c) The AQUA Project, Glasgow University, 1996-1998
4 \section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
9 #include "HsVersions.h"
12 import Class ( FunDep )
13 import TysWiredIn ( tupleTyCon, listTyCon, parrTyCon, charTyCon )
14 import Name ( Name, getName, isTyVarName )
16 import BasicTypes ( Boxity )
18 import SrcLoc ( Located(..), unLoc )
21 %************************************************************************
23 \subsection{Free variables}
25 %************************************************************************
27 These free-variable finders returns tycons and classes too.
30 charTyCon_name, listTyCon_name, parrTyCon_name :: Name
31 charTyCon_name = getName charTyCon
32 listTyCon_name = getName listTyCon
33 parrTyCon_name = getName parrTyCon
35 tupleTyCon_name :: Boxity -> Int -> Name
36 tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
38 extractHsTyVars :: LHsType Name -> NameSet
39 extractHsTyVars x = filterNameSet isTyVarName (extractHsTyNames x)
41 extractFunDepNames :: FunDep Name -> NameSet
42 extractFunDepNames (ns1, ns2) = mkNameSet ns1 `unionNameSets` mkNameSet ns2
44 extractHsTyNames :: LHsType Name -> NameSet
48 getl (L _ ty) = get ty
50 get (HsAppTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2
51 get (HsListTy ty) = unitNameSet listTyCon_name `unionNameSets` getl ty
52 get (HsPArrTy ty) = unitNameSet parrTyCon_name `unionNameSets` getl ty
53 get (HsTupleTy con tys) = extractHsTyNames_s tys
54 get (HsFunTy ty1 ty2) = getl ty1 `unionNameSets` getl ty2
55 get (HsPredTy p) = extractHsPredTyNames p
56 get (HsOpTy ty1 op ty2) = getl ty1 `unionNameSets` getl ty2 `unionNameSets` unitNameSet (unLoc op)
57 get (HsParTy ty) = getl ty
58 get (HsBangTy _ ty) = getl ty
59 get (HsNumTy n) = emptyNameSet
60 get (HsTyVar tv) = unitNameSet tv
61 get (HsSpliceTy _) = emptyNameSet -- Type splices mention no type variables
62 get (HsKindSig ty k) = getl ty
64 ctxt ty) = (extractHsCtxtTyNames ctxt
65 `unionNameSets` getl ty)
67 mkNameSet (hsLTyVarNames tvs)
69 extractHsTyNames_s :: [LHsType Name] -> NameSet
70 extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
72 extractHsCtxtTyNames :: LHsContext Name -> NameSet
73 extractHsCtxtTyNames (L _ ctxt)
74 = foldr (unionNameSets . extractHsPredTyNames . unLoc) emptyNameSet ctxt
76 -- You don't import or export implicit parameters,
77 -- so don't mention the IP names
78 extractHsPredTyNames (HsClassP cls tys)
79 = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
80 extractHsPredTyNames (HsIParam n ty)
85 %************************************************************************
87 \subsection{Free variables of declarations}
89 %************************************************************************
91 Return the Names that must be in scope if we are to use this declaration.
92 In all cases this is set up for interface-file declarations:
93 - for class decls we ignore the bindings
94 - for instance decls likewise, plus the pragmas
95 - for rule decls, we ignore HsRules
96 - for data decls, we ignore derivings
98 *** See "THE NAMING STORY" in HsDecls ****
102 hsSigsFVs :: [LSig Name] -> FreeVars
103 hsSigsFVs sigs = plusFVs (map (hsSigFVs.unLoc) sigs)
105 hsSigFVs (Sig v ty) = extractHsTyNames ty
106 hsSigFVs (SpecInstSig ty) = extractHsTyNames ty
107 hsSigFVs (SpecSig v ty) = extractHsTyNames ty
108 hsSigFVs other = emptyFVs
111 conDeclFVs (L _ (ConDecl _ tyvars context details))
112 = delFVs (map hsLTyVarName tyvars) $
113 extractHsCtxtTyNames context `plusFV`
114 conDetailsFVs details
116 conDeclFVs (L _ (GadtDecl _ ty))
117 = extractHsTyNames ty
119 conDetailsFVs (PrefixCon btys) = plusFVs (map bangTyFVs btys)
120 conDetailsFVs (InfixCon bty1 bty2) = bangTyFVs bty1 `plusFV` bangTyFVs bty2
121 conDetailsFVs (RecCon flds) = plusFVs [bangTyFVs bty | (_, bty) <- flds]
123 bangTyFVs bty = extractHsTyNames (getBangType bty)
127 %************************************************************************
129 \subsection{A few functions on generic defintions
131 %************************************************************************
133 These functions on generics are defined over Matches Name, which is
134 why they are here and not in HsMatches.
137 maybeGenericMatch :: LMatch Name -> Maybe (HsType Name, LMatch Name)
138 -- Tells whether a Match is for a generic definition
139 -- and extract the type from a generic match and put it at the front
141 maybeGenericMatch (L loc (Match (L _ (TypePat (L _ ty)) : pats) sig_ty grhss))
142 = Just (ty, L loc (Match pats sig_ty grhss))
144 maybeGenericMatch other_match = Nothing