forked from RefactoringTools/HaRe
-
Notifications
You must be signed in to change notification settings - Fork 14
/
GHC-NOTES
444 lines (385 loc) · 18.1 KB
/
GHC-NOTES
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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
Parse tree of
-------------------------------------
module B where
-- Test for refactor of if to case
foo x = if (odd x) then "Odd" else "Even"
foo' x = case (odd x) of
True -> "Odd"
False -> "Even"
main = do
putStrLn $ show $ foo 5
mary = [1,2,3]
------------------------------------
getStuff
tokens=[
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 1, srcSpanSCol = 1, srcSpanECol = 7}),"module"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 1, srcSpanSCol = 8, srcSpanECol = 9}),"B"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 1, srcSpanSCol = 10, srcSpanECol = 15}),"where"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 2, srcSpanSCol = 1, srcSpanECol = 35}),"-- Test for refactor of if to case"),
(RealSrcSpan (SrcSpanPoint {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanCol = 1}),""),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 1, srcSpanECol = 4}),"foo"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 5, srcSpanECol = 6}),"x"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 7, srcSpanECol = 8}),"="),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 9, srcSpanECol = 11}),"if"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 12, srcSpanECol = 13}),"("),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 13, srcSpanECol = 16}),"odd"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 17, srcSpanECol = 18}),"x"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 18, srcSpanECol = 19}),")"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 20, srcSpanECol = 24}),"then"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 25, srcSpanECol = 30}),"\"Odd\""),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 31, srcSpanECol = 35}),"else"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 4, srcSpanSCol = 36, srcSpanECol = 42}),"\"Even\""),
(RealSrcSpan (SrcSpanPoint {srcSpanFile = "./B.hs", srcSpanLine = 6, srcSpanCol = 1}),""),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 6, srcSpanSCol = 1, srcSpanECol = 5}),"foo'"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 6, srcSpanSCol = 6, srcSpanECol = 7}),"x"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 6, srcSpanSCol = 8, srcSpanECol = 9}),"="),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 6, srcSpanSCol = 10, srcSpanECol = 14}),"case"),
(RealSrcSpan (SrcSpanOneLine {srcSpanFile = "./B.hs", srcSpanLine = 6, srcSpanSCol = 15, srcSpanECol = 16}),"("),
...
-------------------------------------
(L {B.hs:1:1}
(HsModule
(Just
(L {B.hs:1:8} {ModuleName: B}))
(Nothing)
[]
[
(L {B.hs:4:1-41}
(ValD
(FunBind
(L {B.hs:4:1-3}
(Unqual {OccName: foo}))
(False)
(MatchGroup
[
(L {B.hs:4:1-41}
(Match
[
(L {B.hs:4:5}
(VarPat
(Unqual {OccName: x})))]
(Nothing)
(GRHSs
[
(L {B.hs:4:9-41}
(GRHS
[]
(L {B.hs:4:9-41}
(HsIf
(Just
(HsLit
(HsString {FastString: "noSyntaxExpr"})))
(L {B.hs:4:12-18}
(HsPar
(L {B.hs:4:13-17}
(HsApp
(L {B.hs:4:13-15}
(HsVar
(Unqual {OccName: odd})))
(L {B.hs:4:17}
(HsVar
(Unqual {OccName: x})))))))
(L {B.hs:4:25-29}
(HsLit
(HsString {FastString: "Odd"})))
(L {B.hs:4:36-41}
(HsLit
(HsString {FastString: "Even"})))))))]
(EmptyLocalBinds))))] {!type placeholder here?!})
(WpHole) {!NameSet placeholder here!}
(Nothing)))),
(L {B.hs:(6,1)-(8,17)}
(ValD
(FunBind
(L {B.hs:6:1-4}
(Unqual {OccName: foo'}))
(False)
(MatchGroup
[
(L {B.hs:(6,1)-(8,17)}
(Match
[
(L {B.hs:6:6}
(VarPat
(Unqual {OccName: x})))]
(Nothing)
(GRHSs
[
(L {B.hs:(6,10)-(8,17)}
(GRHS
[]
(L {B.hs:(6,10)-(8,17)}
(HsCase
(L {B.hs:6:15-21}
(HsPar
(L {B.hs:6:16-20}
(HsApp
(L {B.hs:6:16-18}
(HsVar
(Unqual {OccName: odd})))
(L {B.hs:6:20}
(HsVar
(Unqual {OccName: x})))))))
(MatchGroup
[
(L {B.hs:7:3-15}
(Match
[
(L {B.hs:7:3-6}
(ConPatIn
(L {B.hs:7:3-6}
(Unqual {OccName: True}))
(PrefixCon
[])))]
(Nothing)
(GRHSs
[
(L {B.hs:7:11-15}
(GRHS
[]
(L {B.hs:7:11-15}
(HsLit
(HsString {FastString: "Odd"})))))]
(EmptyLocalBinds)))),
(L {B.hs:8:3-17}
(Match
[
(L {B.hs:8:3-7}
(ConPatIn
(L {B.hs:8:3-7}
(Unqual {OccName: False}))
(PrefixCon
[])))]
(Nothing)
(GRHSs
[
(L {B.hs:8:12-17}
(GRHS
[]
(L {B.hs:8:12-17}
(HsLit
(HsString {FastString: "Even"})))))]
(EmptyLocalBinds))))] {!type placeholder here?!})))))]
(EmptyLocalBinds))))] {!type placeholder here?!})
(WpHole) {!NameSet placeholder here!}
(Nothing)))),
(L {B.hs:(10,1)-(11,25)}
(ValD
(FunBind
(L {B.hs:10:1-4}
(Unqual {OccName: main}))
(False)
(MatchGroup
[
(L {B.hs:(10,1)-(11,25)}
(Match
[]
(Nothing)
(GRHSs
[
(L {B.hs:(10,8)-(11,25)}
(GRHS
[]
(L {B.hs:(10,8)-(11,25)}
(HsDo
(DoExpr)
[
(L {B.hs:11:3-25}
(ExprStmt
(L {B.hs:11:3-25}
(OpApp
(L {B.hs:11:3-17}
(OpApp
(L {B.hs:11:3-10}
(HsVar
(Unqual {OccName: putStrLn})))
(L {B.hs:11:12}
(HsVar
(Unqual {OccName: $}))) {!fixity placeholder here?!}
(L {B.hs:11:14-17}
(HsVar
(Unqual {OccName: show})))))
(L {B.hs:11:19}
(HsVar
(Unqual {OccName: $}))) {!fixity placeholder here?!}
(L {B.hs:11:21-25}
(HsApp
(L {B.hs:11:21-23}
(HsVar
(Unqual {OccName: foo})))
(L {B.hs:11:25}
(HsOverLit
(OverLit
(HsIntegral
(5))
(<interactive>: panic! (the 'impossible' happened)
(GHC version 7.4.1 for i386-unknown-linux):
noRebindableInfo
-- ---------------------------------------------------------------------
Detailed tokens
--------------------
module FreeAndDeclared.Declare where
toplevel :: Integer -> Integer
toplevel x = c * x
c,d :: Integer
c = 7
d = 9
-- Pattern bind
tup :: (Int, Int)
h :: Int
t :: Int
tup@(h,t) = head $ zip [1..10] [3..15]
data D = A | B String | C
unD (B y) = y
-- Infix data constructor, see http://stackoverflow.com/a/6420943/595714
data F = G | (:|) String String
unF (a :| b) = (a,b)
main = do
a <- getChar
putStrLn "foo"
--------------------
[(((1,1),(1,7)),ITmodule,"module"),
(((1,8),(1,31)),ITqconid ("FreeAndDeclared","Declare"),"FreeAndDeclared.Declare"),
(((1,32),(1,37)),ITwhere,"where"),
(((3,1),(3,1)),ITvocurly,""),
(((3,1),(3,9)),ITvarid "toplevel","toplevel"),
(((3,10),(3,12)),ITdcolon,"::"),
(((3,13),(3,20)),ITconid "Integer","Integer"),
(((3,21),(3,23)),ITrarrow,"->"),
(((3,24),(3,31)),ITconid "Integer","Integer"),
(((4,1),(4,1)),ITsemi,""),
(((4,1),(4,9)),ITvarid "toplevel","toplevel"),
(((4,10),(4,11)),ITvarid "x","x"),
(((4,12),(4,13)),ITequal,"="),
(((4,14),(4,15)),ITvarid "c","c"),
(((4,16),(4,17)),ITstar,"*"),
(((4,18),(4,19)),ITvarid "x","x"),
(((6,1),(6,1)),ITsemi,""),
(((6,1),(6,2)),ITvarid "c","c"),
(((6,2),(6,3)),ITcomma,","),
(((6,3),(6,4)),ITvarid "d","d"),
(((6,5),(6,7)),ITdcolon,"::"),
(((6,8),(6,15)),ITconid "Integer","Integer"),
(((7,1),(7,1)),ITsemi,""),
(((7,1),(7,2)),ITvarid "c","c"),
(((7,3),(7,4)),ITequal,"="),
(((7,5),(7,6)),ITinteger 7,"7"),
(((8,1),(8,1)),ITsemi,""),
(((8,1),(8,2)),ITvarid "d","d"),
(((8,3),(8,4)),ITequal,"="),
(((8,5),(8,6)),ITinteger 9,"9"),
(((10,1),(10,16)),ITlineComment "-- Pattern bind","-- Pattern bind"),
(((11,1),(11,1)),ITsemi,""),
(((11,1),(11,4)),ITvarid "tup","tup"),
(((11,5),(11,7)),ITdcolon,"::"),
(((11,8),(11,9)),IToparen,"("),
(((11,9),(11,12)),ITconid "Int","Int"),
(((11,12),(11,13)),ITcomma,","),
(((11,14),(11,17)),ITconid "Int","Int"),
(((11,17),(11,18)),ITcparen,")"),
(((12,1),(12,1)),ITsemi,""),(((12,1),(12,2)),ITvarid "h","h"),(((12,3),(12,5)),ITdcolon,"::"),(((12,6),(12,9)),ITconid "Int","Int"),(((13,1),(13,1)),ITsemi,""),(((13,1),(13,2)),ITvarid "t","t"),(((13,3),(13,5)),ITdcolon,"::"),(((13,6),(13,9)),ITconid "Int","Int"),(((14,1),(14,1)),ITsemi,""),(((14,1),(14,4)),ITvarid "tup","tup"),(((14,4),(14,5)),ITat,"@"),(((14,5),(14,6)),IToparen,"("),(((14,6),(14,7)),ITvarid "h","h"),(((14,7),(14,8)),ITcomma,","),(((14,8),(14,9)),ITvarid "t","t"),(((14,9),(14,10)),ITcparen,")"),(((14,11),(14,12)),ITequal,"="),(((14,13),(14,17)),ITvarid "head","head"),(((14,18),(14,19)),ITvarsym "$","$"),(((14,20),(14,23)),ITvarid "zip","zip"),(((14,24),(14,25)),ITobrack,"["),(((14,25),(14,26)),ITinteger 1,"1"),(((14,26),(14,28)),ITdotdot,".."),(((14,28),(14,30)),ITinteger 10,"10"),(((14,30),(14,31)),ITcbrack,"]"),(((14,32),(14,33)),ITobrack,"["),(((14,33),(14,34)),ITinteger 3,"3"),(((14,34),(14,36)),ITdotdot,".."),(((14,36),(14,38)),ITinteger 15,"15"),(((14,38),(14,39)),ITcbrack,"]"),(((16,1),(16,1)),ITsemi,""),(((16,1),(16,5)),ITdata,"data"),(((16,6),(16,7)),ITconid "D","D"),(((16,8),(16,9)),ITequal,"="),(((16,10),(16,11)),ITconid "A","A"),(((16,12),(16,13)),ITvbar,"|"),(((16,14),(16,15)),ITconid "B","B"),(((16,16),(16,22)),ITconid "String","String"),(((16,23),(16,24)),ITvbar,"|"),(((16,25),(16,26)),ITconid "C","C"),(((18,1),(18,1)),ITsemi,""),(((18,1),(18,4)),ITvarid "unD","unD"),(((18,5),(18,6)),IToparen,"("),(((18,6),(18,7)),ITconid "B","B"),(((18,8),(18,9)),ITvarid "y","y"),(((18,9),(18,10)),ITcparen,")"),(((18,11),(18,12)),ITequal,"="),(((18,13),(18,14)),ITvarid "y","y"),(((20,1),(20,73)),ITlineComment "-- Infix data constructor, see http://stackoverflow.com/a/6420943/595714","-- Infix data constructor, see http://stackoverflow.com/a/6420943/595714"),(((21,1),(21,1)),ITsemi,""),(((21,1),(21,5)),ITdata,"data"),(((21,6),(21,7)),ITconid "F","F"),(((21,8),(21,9)),ITequal,"="),(((21,10),(21,11)),ITconid "G","G"),(((21,12),(21,13)),ITvbar,"|"),(((21,14),(21,15)),IToparen,"("),(((21,15),(21,17)),ITconsym ":|",":|"),(((21,17),(21,18)),ITcparen,")"),(((21,19),(21,25)),ITconid "String","String"),(((21,26),(21,32)),ITconid "String","String"),(((23,1),(23,1)),ITsemi,""),(((23,1),(23,4)),ITvarid "unF","unF"),(((23,5),(23,6)),IToparen,"("),(((23,6),(23,7)),ITvarid "a","a"),(((23,8),(23,10)),ITconsym ":|",":|"),(((23,11),(23,12)),ITvarid "b","b"),(((23,12),(23,13)),ITcparen,")"),(((23,14),(23,15)),ITequal,"="),(((23,16),(23,17)),IToparen,"("),(((23,17),(23,18)),ITvarid "a","a"),(((23,18),(23,19)),ITcomma,","),(((23,19),(23,20)),ITvarid "b","b"),(((23,20),(23,21)),ITcparen,")"),(((25,1),(25,1)),ITsemi,""),(((25,1),(25,5)),ITvarid "main","main"),(((25,6),(25,7)),ITequal,"="),(((25,8),(25,10)),ITdo,"do"),(((26,3),(26,3)),ITvocurly,""),(((26,3),(26,4)),ITvarid "a","a"),(((26,5),(26,7)),ITlarrow,"<-"),(((26,8),(26,15)),ITvarid "getChar","getChar"),(((27,3),(27,3)),ITsemi,""),(((27,3),(27,11)),ITvarid "putStrLn","putStrLn"),(((27,12),(27,17)),ITstring "foo","\"foo\""),(((29,1),(29,1)),ITvccurly,""),(((29,1),(29,1)),ITsemi,"")]
--------------------
GHC Lexer token insertion / layout rules
When in layout mode
If first token of a line is to the left of prior line
- insert ITvccurly
If first token of a line is same as prior
- insert ITsemi
In layout mode
-- Insert ITvocurly if line to the right of prior
-- Insert ITvccurly if line to the left of prior
---------------------
MatchGroup
----------
Although matches only ever occur on a FunBind in the original
http://hackage.haskell.org/packages/archive/haskell-src/1.0.1.4/doc/html/Language-Haskell-Syntax.html#t:HsMatch, in GHC they appear as follows
HsBinds
FunBind
HsExpr
HsLam
HsCase
[original has (HsLambda .. [HsPat] ..)
and (HsCase HsExp [HsAlt])
]
------------------------------------------------
2014-02-06
Scratching through the GHC source, looking for hsVisiblePN options.
Must be in the renamer somewhere.
module TxRnTypes.lhs has a TcGlbEnv structure which is returned as one
of the fields of TypecheckedModule.
-- ----------------------------
data TcGblEnv
= TcGblEnv {
tcg_mod :: Module, -- ^ Module being compiled
tcg_src :: HscSource,
-- ^ What kind of module (regular Haskell, hs-boot, ext-core)
tcg_rdr_env :: GlobalRdrEnv, -- ^ Top level envt; used during renaming
tcg_default :: Maybe [Type],
-- ^ Types used for defaulting. @Nothing@ => no @default@ decl
tcg_fix_env :: FixityEnv, -- ^ Just for things in this module
tcg_field_env :: RecFieldEnv, -- ^ Just for things in this module
tcg_type_env :: TypeEnv,
-- ^ Global type env for the module we are compiling now. All
-- TyCons and Classes (for this module) end up in here right away,
-- along with their derived constructors, selectors.
--
-- (Ids defined in this module start in the local envt, though they
-- move to the global envt during zonking)
tcg_type_env_var :: TcRef TypeEnv,
-- Used only to initialise the interface-file
-- typechecker in initIfaceTcRn, so that it can see stuff
-- bound in this module when dealing with hi-boot recursions
-- Updated at intervals (e.g. after dealing with types and classes)
....
....
-- -------------------------------------
The GlobalRdrEnv has
---------------------
; let bound_names = collectHsValBinders binds'
; envs <- getRdrEnvs
; checkDupAndShadowedNames envs bound_names
-- ---------------------------------------------------------------------
Name and RdrName [2015-01-25]
-----------------------------
The RenamedSource is parameterised with Name, ParsedSource with RdrName.
The ParsedSource is closer to the original, so we want to output it
via ghc-exactprint, and manipulate the ParsedSource AST.
Critical to this is a way to map a RdrName to the Name applied by the
renamer.
Inside the renamer, the following happens for localvars
newLocalBndrRn :: Located RdrName -> RnM Name
-- Used for non-top-level binders. These should
-- never be qualified.
newLocalBndrRn (L loc rdr_name)
| Just name <- isExact_maybe rdr_name
= return name -- This happens in code generated by Template Haskell
-- See Note [Binders in Template Haskell] in Convert.lhs
| otherwise
= do { unless (isUnqual rdr_name)
(addErrAt loc (badQualBndrErr rdr_name))
; uniq <- newUnique
; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
In turn, mkInternalName is
-- | Create a name which is (for now at least) local to the current module and hence
-- does not need a 'Module' to disambiguate it from other 'Name's
mkInternalName :: Unique -> OccName -> SrcSpan -> Name
mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq
, n_sort = Internal
, n_occ = occ
, n_loc = loc }
-- NB: You might worry that after lots of huffing and
-- puffing we might end up with two local names with distinct
-- uniques, but the same OccName. Indeed we can, but that's ok
-- * the insides of the compiler don't care: they use the Unique
-- * when printing for -ddump-xxx you can switch on -dppr-debug to get the
-- uniques if you get confused
-- * for interface files we tidyCore first, which makes
-- the OccNames distinct when they need to be
The thing we care about is the uniq inside the Name. So the only
viable path is to match up the rdrNameOcc and location to the one in
the Name.
This can happen in one of two ways
1. Use the location to find the equivalent Name in the RenamedSource,
and use that
2. Pre-generate a table of Name/Location -> RdrName and look up in that.
This is a later performance question, for now we go with the first.