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 TysWiredIn ( tupleTyCon, listTyCon, charTyCon )
13 import Name ( Name, getName, isTyVarName )
15 import BasicTypes ( Boxity )
21 type RenamedArithSeqInfo = ArithSeqInfo Name RenamedPat
22 type RenamedClassOpSig = Sig Name
23 type RenamedConDecl = ConDecl Name
24 type RenamedContext = HsContext Name
25 type RenamedHsDecl = HsDecl Name RenamedPat
26 type RenamedRuleDecl = RuleDecl Name RenamedPat
27 type RenamedTyClDecl = TyClDecl Name RenamedPat
28 type RenamedDefaultDecl = DefaultDecl Name
29 type RenamedForeignDecl = ForeignDecl Name
30 type RenamedGRHS = GRHS Name RenamedPat
31 type RenamedGRHSs = GRHSs Name RenamedPat
32 type RenamedHsBinds = HsBinds Name RenamedPat
33 type RenamedHsExpr = HsExpr Name RenamedPat
34 type RenamedHsModule = HsModule Name RenamedPat
35 type RenamedInstDecl = InstDecl Name RenamedPat
36 type RenamedMatch = Match Name RenamedPat
37 type RenamedMonoBinds = MonoBinds Name RenamedPat
38 type RenamedPat = InPat Name
39 type RenamedHsType = HsType Name
40 type RenamedHsPred = HsPred Name
41 type RenamedRecordBinds = HsRecordBinds Name RenamedPat
42 type RenamedSig = Sig Name
43 type RenamedStmt = Stmt Name RenamedPat
44 type RenamedFixitySig = FixitySig Name
45 type RenamedDeprecation = DeprecDecl Name
46 type RenamedHsOverLit = HsOverLit Name
47 type RenamedIfaceSig = IfaceSig Name
50 %************************************************************************
52 \subsection{Free variables}
54 %************************************************************************
56 These free-variable finders returns tycons and classes too.
59 charTyCon_name, listTyCon_name :: Name
60 charTyCon_name = getName charTyCon
61 listTyCon_name = getName listTyCon
63 tupleTyCon_name :: Boxity -> Int -> Name
64 tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
66 extractHsTyVars :: RenamedHsType -> NameSet
67 extractHsTyVars x = filterNameSet isTyVarName (extractHsTyNames x)
69 extractHsTyNames :: RenamedHsType -> NameSet
73 get (HsAppTy ty1 ty2) = get ty1 `unionNameSets` get ty2
74 get (HsListTy ty) = unitNameSet listTyCon_name `unionNameSets` get ty
75 get (HsTupleTy (HsTupCon n _) tys) = unitNameSet n
76 `unionNameSets` extractHsTyNames_s tys
77 get (HsFunTy ty1 ty2) = get ty1 `unionNameSets` get ty2
78 get (HsPredTy p) = extractHsPredTyNames p
79 get (HsUsgForAllTy uv ty) = get ty
80 get (HsUsgTy u ty) = get ty
81 get (HsOpTy ty1 tycon ty2) = get ty1 `unionNameSets` get ty2 `unionNameSets`
83 get (HsNumTy n) = emptyNameSet
84 get (HsTyVar tv) = unitNameSet tv
85 get (HsForAllTy (Just tvs)
86 ctxt ty) = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
88 mkNameSet (hsTyVarNames tvs)
89 get ty@(HsForAllTy Nothing _ _) = pprPanic "extractHsTyNames" (ppr ty)
91 extractHsTyNames_s :: [RenamedHsType] -> NameSet
92 extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
94 extractHsCtxtTyNames :: RenamedContext -> NameSet
95 extractHsCtxtTyNames ctxt = foldr (unionNameSets . extractHsPredTyNames) emptyNameSet ctxt
97 -- You don't import or export implicit parameters,
98 -- so don't mention the IP names
99 extractHsPredTyNames (HsPClass cls tys)
100 = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
101 extractHsPredTyNames (HsPIParam n ty)
102 = extractHsTyNames ty
106 %************************************************************************
108 \subsection{A few functions on generic defintions
110 %************************************************************************
112 These functions on generics are defined over RenamedMatches, which is
113 why they are here and not in HsMatches.
116 maybeGenericMatch :: RenamedMatch -> Maybe (RenamedHsType, RenamedMatch)
117 -- Tells whether a Match is for a generic definition
118 -- and extract the type from a generic match and put it at the front
120 maybeGenericMatch (Match tvs (TypePatIn ty : pats) sig_ty grhss)
121 = Just (ty, Match tvs pats sig_ty grhss)
123 maybeGenericMatch other_match = Nothing