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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
%
% (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,
extractHsTyVarBndrNames, extractHsTyVarBndrNames_s,
-- 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
import Panic ( panic )
\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
-- Also extract names in kinds.
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 ki) = getl ty `unionNameSets` getl ki
get (HsForAllTy _ tvs
ctxt ty) = extractHsTyVarBndrNames_s tvs
(extractHsCtxtTyNames ctxt
`unionNameSets` getl ty)
get (HsDocTy ty _) = getl ty
get (HsCoreTy {}) = emptyNameSet -- This probably isn't quite right
-- but I don't think it matters
get (HsExplicitListTy _ tys) = extractHsTyNames_s tys
get (HsExplicitTupleTy _ tys) = extractHsTyNames_s tys
get (HsWrapTy {}) = panic "extractHsTyNames"
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
extractHsTyVarBndrNames :: LHsTyVarBndr Name -> NameSet
extractHsTyVarBndrNames (L _ (UserTyVar _ _)) = emptyNameSet
extractHsTyVarBndrNames (L _ (KindedTyVar _ ki _)) = extractHsTyNames ki
extractHsTyVarBndrNames_s :: [LHsTyVarBndr Name] -> NameSet -> NameSet
-- Update the name set 'body' by adding the names in the binders
-- kinds and handling scoping.
extractHsTyVarBndrNames_s [] body = body
extractHsTyVarBndrNames_s (b:bs) body =
(extractHsTyVarBndrNames_s bs body `delFromNameSet` hsTyVarName (unLoc b))
`unionNameSets` extractHsTyVarBndrNames b
\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}))
= extractHsTyVarBndrNames_s 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}
|
