[project @ 1997-01-17 00:32:23 by simonpj]
[ghc-hetmet.git] / ghc / compiler / reader / RdrHsSyn.lhs
1 %
2 % (c) The AQUA Project, Glasgow University, 1996
3 %
4 \section[RdrHsSyn]{Specialisations of the @HsSyn@ syntax for the reader}
5
6 (Well, really, for specialisations involving @RdrName@s, even if
7 they are used somewhat later on in the compiler...)
8
9 \begin{code}
10 #include "HsVersions.h"
11
12 module RdrHsSyn (
13         SYN_IE(RdrNameArithSeqInfo),
14         SYN_IE(RdrNameBangType),
15         SYN_IE(RdrNameBind),
16         SYN_IE(RdrNameClassDecl),
17         SYN_IE(RdrNameClassOpSig),
18         SYN_IE(RdrNameConDecl),
19         SYN_IE(RdrNameContext),
20         SYN_IE(RdrNameSpecDataSig),
21         SYN_IE(RdrNameDefaultDecl),
22         SYN_IE(RdrNameFixityDecl),
23         SYN_IE(RdrNameGRHS),
24         SYN_IE(RdrNameGRHSsAndBinds),
25         SYN_IE(RdrNameHsBinds),
26         SYN_IE(RdrNameHsDecl),
27         SYN_IE(RdrNameHsExpr),
28         SYN_IE(RdrNameHsModule),
29         SYN_IE(RdrNameIE),
30         SYN_IE(RdrNameImportDecl),
31         SYN_IE(RdrNameInstDecl),
32         SYN_IE(RdrNameMatch),
33         SYN_IE(RdrNameMonoBinds),
34         SYN_IE(RdrNamePat),
35         SYN_IE(RdrNameHsType),
36         SYN_IE(RdrNameQual),
37         SYN_IE(RdrNameSig),
38         SYN_IE(RdrNameSpecInstSig),
39         SYN_IE(RdrNameStmt),
40         SYN_IE(RdrNameTyDecl),
41
42         SYN_IE(RdrNameClassOpPragmas),
43         SYN_IE(RdrNameClassPragmas),
44         SYN_IE(RdrNameDataPragmas),
45         SYN_IE(RdrNameGenPragmas),
46         SYN_IE(RdrNameInstancePragmas),
47         SYN_IE(RdrNameCoreExpr),
48         extractHsTyVars,
49
50         RdrName(..),
51         qual, varQual, tcQual, varUnqual,
52         dummyRdrVarName, dummyRdrTcName,
53         isUnqual, isQual,
54         showRdr, rdrNameOcc,
55         cmpRdr
56
57     ) where
58
59 IMP_Ubiq()
60
61 import HsSyn
62 import Lex
63 import PrelMods         ( pRELUDE )
64 import Name             ( ExportFlag(..), Module(..), pprModule,
65                           OccName(..), pprOccName )
66 import Pretty           
67 import PprStyle         ( PprStyle(..) )
68 import Util             ( cmpPString, panic, thenCmp )
69 \end{code}
70
71 \begin{code}
72 type RdrNameArithSeqInfo        = ArithSeqInfo          Fake Fake RdrName RdrNamePat
73 type RdrNameBangType            = BangType              RdrName
74 type RdrNameBind                = Bind                  Fake Fake RdrName RdrNamePat
75 type RdrNameClassDecl           = ClassDecl             Fake Fake RdrName RdrNamePat
76 type RdrNameClassOpSig          = Sig                   RdrName
77 type RdrNameConDecl             = ConDecl               RdrName
78 type RdrNameContext             = Context               RdrName
79 type RdrNameHsDecl              = HsDecl                Fake Fake RdrName RdrNamePat
80 type RdrNameSpecDataSig         = SpecDataSig           RdrName
81 type RdrNameDefaultDecl         = DefaultDecl           RdrName
82 type RdrNameFixityDecl          = FixityDecl            RdrName
83 type RdrNameGRHS                = GRHS                  Fake Fake RdrName RdrNamePat
84 type RdrNameGRHSsAndBinds       = GRHSsAndBinds         Fake Fake RdrName RdrNamePat
85 type RdrNameHsBinds             = HsBinds               Fake Fake RdrName RdrNamePat
86 type RdrNameHsExpr              = HsExpr                Fake Fake RdrName RdrNamePat
87 type RdrNameHsModule            = HsModule              Fake Fake RdrName RdrNamePat
88 type RdrNameIE                  = IE                    RdrName
89 type RdrNameImportDecl          = ImportDecl            RdrName
90 type RdrNameInstDecl            = InstDecl              Fake Fake RdrName RdrNamePat
91 type RdrNameMatch               = Match                 Fake Fake RdrName RdrNamePat
92 type RdrNameMonoBinds           = MonoBinds             Fake Fake RdrName RdrNamePat
93 type RdrNamePat                 = InPat                 RdrName
94 type RdrNameHsType              = HsType                RdrName
95 type RdrNameQual                = Qualifier             Fake Fake RdrName RdrNamePat
96 type RdrNameSig                 = Sig                   RdrName
97 type RdrNameSpecInstSig         = SpecInstSig           RdrName
98 type RdrNameStmt                = Stmt                  Fake Fake RdrName RdrNamePat
99 type RdrNameTyDecl              = TyDecl                RdrName
100
101 type RdrNameClassOpPragmas      = ClassOpPragmas        RdrName
102 type RdrNameClassPragmas        = ClassPragmas          RdrName
103 type RdrNameDataPragmas         = DataPragmas           RdrName
104 type RdrNameGenPragmas          = GenPragmas            RdrName
105 type RdrNameInstancePragmas     = InstancePragmas       RdrName
106 type RdrNameCoreExpr            = GenCoreExpr           RdrName RdrName RdrName RdrName 
107 \end{code}
108
109 @extractHsTyVars@ looks just for things that could be type variables.
110 It's used when making the for-alls explicit.
111
112 \begin{code}
113 extractHsTyVars :: HsType RdrName -> [RdrName]
114 extractHsTyVars ty
115   = get ty []
116   where
117     get (MonoTyApp ty1 ty2)      acc = get ty1 (get ty2 acc)
118     get (MonoListTy tc ty)       acc = get ty acc
119     get (MonoTupleTy tc tys)     acc = foldr get acc tys
120     get (MonoFunTy ty1 ty2)      acc = get ty1 (get ty2 acc)
121     get (MonoDictTy cls ty)      acc = get ty acc
122     get (MonoTyVar tv)           acc = insert tv acc
123     get (HsPreForAllTy ctxt ty)  acc = foldr (get . snd) (get ty acc) ctxt
124     get (HsForAllTy tvs ctxt ty) acc = filter (`notElem` locals) $
125                                        foldr (get . snd) (get ty acc) ctxt
126                                      where
127                                        locals = map getTyVarName tvs
128
129     insert (Qual _ _)         acc = acc
130     insert (Unqual (TCOcc _)) acc = acc
131     insert other              acc | other `elem` acc = acc
132                                   | otherwise        = other : acc
133 \end{code}
134
135    
136 %************************************************************************
137 %*                                                                      *
138 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
139 %*                                                                      *
140 %************************************************************************
141
142 \begin{code}
143 data RdrName
144   = Unqual OccName
145   | Qual   Module OccName
146
147 qual     (m,n) = Qual m n
148 tcQual   (m,n) = Qual m (TCOcc n)
149 varQual  (m,n) = Qual m (VarOcc n)
150
151         -- This guy is used by the reader when HsSyn has a slot for
152         -- an implicit name that's going to be filled in by
153         -- the renamer.  We can't just put "error..." because
154         -- we sometimes want to print out stuff after reading but
155         -- before renaming
156 dummyRdrVarName = Unqual (VarOcc SLIT("V-DUMMY"))
157 dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
158
159 varUnqual n = Unqual (VarOcc n)
160
161 isUnqual (Unqual _) = True
162 isUnqual (Qual _ _) = False
163
164 isQual (Unqual _) = False
165 isQual (Qual _ _) = True
166
167 cmpRdr (Unqual  n1) (Unqual  n2) = n1 `cmp` n2
168 cmpRdr (Unqual  n1) (Qual m2 n2) = LT_
169 cmpRdr (Qual m1 n1) (Unqual  n2) = GT_
170 cmpRdr (Qual m1 n1) (Qual m2 n2) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
171                                    -- always compare module-names *second*
172
173 rdrNameOcc :: RdrName -> OccName
174 rdrNameOcc (Unqual occ) = occ
175 rdrNameOcc (Qual _ occ) = occ
176
177 instance Text RdrName where -- debugging
178     showsPrec _ rn = showString (ppShow 80 (ppr PprDebug rn))
179
180 instance Eq RdrName where
181     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
182     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
183
184 instance Ord RdrName where
185     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
186     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
187     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
188     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
189
190 instance Ord3 RdrName where
191     cmp = cmpRdr
192
193 instance Outputable RdrName where
194     ppr sty (Unqual n) = pprOccName sty n
195     ppr sty (Qual m n) = ppBesides [pprModule sty m, ppStr ".", pprOccName sty n]
196
197 instance NamedThing RdrName where               -- Just so that pretty-printing of expressions works
198     getOccName = rdrNameOcc
199     getName = panic "no getName for RdrNames"
200
201 showRdr sty rdr = ppShow 100 (ppr sty rdr)
202 \end{code}
203