e2369bb77668e5740fc42e922d026fa5fc79a21a
[ghc.git] / compiler / rename / RnHsSyn.lhs
1 %
2 % (c) The AQUA Project, Glasgow University, 1996-1998
3 %
4 \section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
5
6 \begin{code}
7 {-# OPTIONS -fno-warn-tabs #-}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and
10 -- detab the module (please do the detabbing in a separate patch). See
11 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
12 -- for details
13
14 module RnHsSyn(
15         -- Names
16         charTyCon_name, listTyCon_name, parrTyCon_name, tupleTyCon_name,
17         extractHsTyVars, extractHsTyNames, extractHsTyNames_s,
18         extractFunDepNames, extractHsCtxtTyNames,
19         extractHsTyVarBndrNames, extractHsTyVarBndrNames_s,
20
21         -- Free variables
22         hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs
23   ) where
24
25 #include "HsVersions.h"
26
27 import HsSyn
28 import Class            ( FunDep )
29 import TysWiredIn       ( tupleTyCon, listTyCon, parrTyCon, charTyCon )
30 import Name             ( Name, getName, isTyVarName )
31 import NameSet
32 import BasicTypes       ( TupleSort )
33 import SrcLoc
34 import Panic            ( panic )
35 \end{code}
36
37 %************************************************************************
38 %*                                                                      *
39 \subsection{Free variables}
40 %*                                                                      *
41 %************************************************************************
42
43 These free-variable finders returns tycons and classes too.
44
45 \begin{code}
46 charTyCon_name, listTyCon_name, parrTyCon_name :: Name
47 charTyCon_name    = getName charTyCon
48 listTyCon_name    = getName listTyCon
49 parrTyCon_name    = getName parrTyCon
50
51 tupleTyCon_name :: TupleSort -> Int -> Name
52 tupleTyCon_name sort n = getName (tupleTyCon sort n)
53
54 extractHsTyVars :: LHsType Name -> NameSet
55 extractHsTyVars x = filterNameSet isTyVarName (extractHsTyNames x)
56
57 extractFunDepNames :: FunDep Name -> NameSet
58 extractFunDepNames (ns1, ns2) = mkNameSet ns1 `unionNameSets` mkNameSet ns2
59
60 extractHsTyNames   :: LHsType Name -> NameSet
61 -- Also extract names in kinds.
62 extractHsTyNames ty
63   = getl ty
64   where
65     getl (L _ ty) = get ty
66
67     get (HsAppTy ty1 ty2)      = getl ty1 `unionNameSets` getl ty2
68     get (HsListTy ty)          = unitNameSet listTyCon_name `unionNameSets` getl ty
69     get (HsPArrTy ty)          = unitNameSet parrTyCon_name `unionNameSets` getl ty
70     get (HsTupleTy _ tys)      = extractHsTyNames_s tys
71     get (HsFunTy ty1 ty2)      = getl ty1 `unionNameSets` getl ty2
72     get (HsIParamTy _ ty)      = getl ty
73     get (HsEqTy ty1 ty2)       = getl ty1 `unionNameSets` getl ty2
74     get (HsOpTy ty1 (_, op) ty2) = getl ty1 `unionNameSets` getl ty2 `unionNameSets` unitNameSet (unLoc op)
75     get (HsParTy ty)           = getl ty
76     get (HsBangTy _ ty)        = getl ty
77     get (HsRecTy flds)         = extractHsTyNames_s (map cd_fld_type flds)
78     get (HsTyVar tv)           = unitNameSet tv
79     get (HsSpliceTy _ fvs _)   = fvs
80     get (HsQuasiQuoteTy {})    = emptyNameSet
81     get (HsKindSig ty ki)      = getl ty `unionNameSets` getl ki
82     get (HsForAllTy _ tvs
83                     ctxt ty)   = extractHsTyVarBndrNames_s tvs
84                                  (extractHsCtxtTyNames ctxt
85                                   `unionNameSets` getl ty)
86     get (HsDocTy ty _)         = getl ty
87     get (HsCoreTy {})          = emptyNameSet   -- This probably isn't quite right
88                                                 -- but I don't think it matters
89     get (HsExplicitListTy _ tys) = extractHsTyNames_s tys
90     get (HsExplicitTupleTy _ tys) = extractHsTyNames_s tys
91     get (HsWrapTy {})          = panic "extractHsTyNames"
92
93 extractHsTyNames_s  :: [LHsType Name] -> NameSet
94 extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
95
96 extractHsCtxtTyNames :: LHsContext Name -> NameSet
97 extractHsCtxtTyNames (L _ ctxt)
98   = foldr (unionNameSets . extractHsTyNames) emptyNameSet ctxt
99
100 extractHsTyVarBndrNames :: LHsTyVarBndr Name -> NameSet
101 extractHsTyVarBndrNames (L _ (UserTyVar _ _)) = emptyNameSet
102 extractHsTyVarBndrNames (L _ (KindedTyVar _ ki _)) = extractHsTyNames ki
103
104 extractHsTyVarBndrNames_s :: [LHsTyVarBndr Name] -> NameSet -> NameSet
105 -- Update the name set 'body' by adding the names in the binders
106 -- kinds and handling scoping.
107 extractHsTyVarBndrNames_s [] body = body
108 extractHsTyVarBndrNames_s (b:bs) body =
109   (extractHsTyVarBndrNames_s bs body `delFromNameSet` hsTyVarName (unLoc b))
110   `unionNameSets` extractHsTyVarBndrNames b
111 \end{code}
112
113
114 %************************************************************************
115 %*                                                                      *
116 \subsection{Free variables of declarations}
117 %*                                                                      *
118 %************************************************************************
119
120 Return the Names that must be in scope if we are to use this declaration.
121 In all cases this is set up for interface-file declarations:
122         - for class decls we ignore the bindings
123         - for instance decls likewise, plus the pragmas
124         - for rule decls, we ignore HsRules
125         - for data decls, we ignore derivings
126
127         *** See "THE NAMING STORY" in HsDecls ****
128
129 \begin{code}
130 ----------------
131 hsSigsFVs :: [LSig Name] -> FreeVars
132 hsSigsFVs sigs = plusFVs (map (hsSigFVs.unLoc) sigs)
133
134 hsSigFVs :: Sig Name -> FreeVars
135 hsSigFVs (TypeSig _ ty)    = extractHsTyNames ty
136 hsSigFVs (GenericSig _ ty) = extractHsTyNames ty
137 hsSigFVs (SpecInstSig ty)  = extractHsTyNames ty
138 hsSigFVs (SpecSig _ ty _)  = extractHsTyNames ty
139 hsSigFVs _                 = emptyFVs
140
141 ----------------
142 conDeclFVs :: LConDecl Name -> FreeVars
143 conDeclFVs (L _ (ConDecl { con_qvars = tyvars, con_cxt = context,
144                            con_details = details, con_res = res_ty}))
145   = extractHsTyVarBndrNames_s tyvars $
146     extractHsCtxtTyNames context  `plusFV`
147     conDetailsFVs details         `plusFV`
148     conResTyFVs res_ty
149
150 conResTyFVs :: ResType Name -> FreeVars
151 conResTyFVs ResTyH98       = emptyFVs
152 conResTyFVs (ResTyGADT ty) = extractHsTyNames ty
153
154 conDetailsFVs :: HsConDeclDetails Name -> FreeVars
155 conDetailsFVs details = plusFVs (map bangTyFVs (hsConDeclArgTys details))
156
157 bangTyFVs :: LHsType Name -> FreeVars
158 bangTyFVs bty = extractHsTyNames (getBangType bty)
159 \end{code}