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