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