Parser.y.pp 102 KB
Newer Older
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
1
--                                                              -*-haskell-*-
2
3
4
5
6
7
8
9
10
-- ---------------------------------------------------------------------------
-- (c) The University of Glasgow 1997-2003
---
-- The GHC grammar.
--
-- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
-- ---------------------------------------------------------------------------

{
11
{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
12
{-# OPTIONS -Wwarn -w #-}
13
14
15
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
16
--     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
17
18
-- for details

19
module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
20
                parseHeader ) where
21
22
23

import HsSyn
import RdrHsSyn
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
24
import HscTypes         ( IsBootInterface, WarningTxt(..) )
25
26
import Lexer
import RdrName
27
import TcEvidence       ( emptyTcEvBinds )
dreixel's avatar
dreixel committed
28
import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
29
import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
30
                          unboxedUnitTyCon, unboxedUnitDataCon,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
31
32
                          listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
import Type             ( funTyCon )
33
import ForeignCall
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
34
35
import OccName          ( varName, dataName, tcClsName, tvName )
import DataCon          ( DataCon, dataConName )
Ian Lynagh's avatar
Ian Lynagh committed
36
import SrcLoc
37
import Module
dreixel's avatar
dreixel committed
38
import Kind             ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
39
import Class            ( FunDep )
40
import BasicTypes
41
import DynFlags
42
import OrdList
43
import HaddockUtils
44
import BooleanFormula   ( BooleanFormula, mkAnd, mkOr, mkTrue, mkVar )
45
46

import FastString
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
47
import Maybes           ( orElse )
48
import Outputable
49

50
import Control.Monad    ( unless, liftM )
Simon Marlow's avatar
Simon Marlow committed
51
import GHC.Exts
52
53
import Data.Char
import Control.Monad    ( mplus )
54
55
56
}

{-
57
-----------------------------------------------------------------------------
Gabor Greif's avatar
Gabor Greif committed
58
59
60
61
62
63
64
12 October 2012

Conflicts: 43 shift/reduce
           1 reduce/reduce

-----------------------------------------------------------------------------
24 February 2006
65
66
67
68
69
70
71
72
73

Conflicts: 33 shift/reduce
           1 reduce/reduce

The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
would think the two should never occur in the same context.

  -=chak

74
75
76
77
78
79
80
81
82
83
84
-----------------------------------------------------------------------------
31 December 2006

Conflicts: 34 shift/reduce
           1 reduce/reduce

The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
would think the two should never occur in the same context.

  -=chak

85
86
87
88
89
90
91
92
93
94
95
-----------------------------------------------------------------------------
6 December 2006

Conflicts: 32 shift/reduce
           1 reduce/reduce

The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
would think the two should never occur in the same context.

  -=chak

96
97
98
99
100
101
102
103
104
105
106
-----------------------------------------------------------------------------
26 July 2006

Conflicts: 37 shift/reduce
           1 reduce/reduce

The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
would think the two should never occur in the same context.

  -=chak

107
-----------------------------------------------------------------------------
108
Conflicts: 38 shift/reduce (1.25)
109

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
110
111
112
10 for abiguity in 'if x then y else z + 1'             [State 178]
        (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
        10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
113

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
114
115
1 for ambiguity in 'if x then y else z :: T'            [State 178]
        (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
116

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
117
118
119
4 for ambiguity in 'if x then y else z -< e'            [State 178]
        (shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
        There are four such operators: -<, >-, -<<, >>-
120
121


chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
122
123
124
125
2 for ambiguity in 'case v of { x :: T -> T ... } '     [States 11, 253]
        Which of these two is intended?
          case v of
            (x::T) -> T         -- Rhs is T
126
    or
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
127
128
          case v of
            (x::T -> T) -> ..   -- Rhs is ...
ross's avatar
ross committed
129

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
130
10 for ambiguity in 'e :: a `b` c'.  Does this mean     [States 11, 253]
131
        (e::a) `b` c, or
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
132
        (e :: (a `b` c))
133
    As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases
134
    Same duplication between states 11 and 253 as the previous case
135

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
136
137
138
139
1 for ambiguity in 'let ?x ...'                         [State 329]
        the parser can't tell whether the ?x is the lhs of a normal binding or
        an implicit binding.  Fortunately resolving as shift gives it the only
        sensible meaning, namely the lhs of an implicit binding.
140

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
141
142
143
144
1 for ambiguity in '{-# RULES "name" [ ... #-}          [State 382]
        we don't know whether the '[' starts the activation or not: it
        might be the start of the declaration with the activation being
        empty.  --SDM 1/4/2002
145

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
146
147
148
149
150
151
152
1 for ambiguity in '{-# RULES "name" forall = ... #-}'  [State 474]
        since 'forall' is a valid variable name, we don't know whether
        to treat a forall on the input as the beginning of a quantifier
        or the beginning of the rule itself.  Resolving to shift means
        it's always treated as a quantifier, hence the above is disallowed.
        This saves explicitly defining a grammar for the rule lhs that
        doesn't include 'forall'.
153

154
155
1 for ambiguity when the source file starts with "-- | doc". We need another
  token of lookahead to determine if a top declaration or the 'module' keyword
156
  follows. Shift parses as if the 'module' keyword follows.
157

158
159
160
161
162
163
164
165
166
167
-- ---------------------------------------------------------------------------
-- Adding location info

This is done in a stylised way using the three macros below, L0, L1
and LL.  Each of these macros can be thought of as having type

   L0, L1, LL :: a -> Located a

They each add a SrcSpan to their argument.

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
168
   L0   adds 'noSrcSpan', used for empty productions
169
     -- This doesn't seem to work anymore -=chak
170
171

   L1   for a production with a single token on the lhs.  Grabs the SrcSpan
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
172
        from that token.
173
174
175
176
177
178
179
180
181

   LL   for a production with >1 token on the lhs.  Makes up a SrcSpan from
        the first and last tokens.

These suffice for the majority of cases.  However, we must be
especially careful with empty productions: LL won't work if the first
or last token on the lhs can represent an empty span.  In these cases,
we have to calculate the span using more of the tokens from the lhs, eg.

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
182
183
184
        | 'newtype' tycl_hdr '=' newconstr deriving
                { L (comb3 $1 $4 $5)
                    (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204

We provide comb3 and comb4 functions which are useful in such cases.

Be careful: there's no checking that you actually got this right, the
only symptom will be that the SrcSpans of your syntax will be
incorrect.

/*
 * We must expand these macros *before* running Happy, which is why this file is
 * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
 */
#define L0   L noSrcSpan
#define L1   sL (getLoc $1)
#define LL   sL (comb2 $1 $>)

-- -----------------------------------------------------------------------------

-}

%token
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
205
206
 '_'            { L _ ITunderscore }            -- Haskell keywords
 'as'           { L _ ITas }
207
208
209
 'case'         { L _ ITcase }
 'class'        { L _ ITclass }
 'data'         { L _ ITdata }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
 'default'      { L _ ITdefault }
 'deriving'     { L _ ITderiving }
 'do'           { L _ ITdo }
 'else'         { L _ ITelse }
 'hiding'       { L _ IThiding }
 'if'           { L _ ITif }
 'import'       { L _ ITimport }
 'in'           { L _ ITin }
 'infix'        { L _ ITinfix }
 'infixl'       { L _ ITinfixl }
 'infixr'       { L _ ITinfixr }
 'instance'     { L _ ITinstance }
 'let'          { L _ ITlet }
 'module'       { L _ ITmodule }
 'newtype'      { L _ ITnewtype }
 'of'           { L _ ITof }
 'qualified'    { L _ ITqualified }
 'then'         { L _ ITthen }
 'type'         { L _ ITtype }
 'where'        { L _ ITwhere }

 'forall'       { L _ ITforall }                -- GHC extension keywords
 'foreign'      { L _ ITforeign }
 'export'       { L _ ITexport }
234
 'label'        { L _ ITlabel }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
235
236
 'dynamic'      { L _ ITdynamic }
 'safe'         { L _ ITsafe }
237
 'interruptible' { L _ ITinterruptible }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
238
239
240
 'unsafe'       { L _ ITunsafe }
 'mdo'          { L _ ITmdo }
 'family'       { L _ ITfamily }
241
 'role'         { L _ ITrole }
242
243
 'stdcall'      { L _ ITstdcallconv }
 'ccall'        { L _ ITccallconv }
244
 'capi'         { L _ ITcapiconv }
245
 'prim'         { L _ ITprimcallconv }
thoughtpolice's avatar
thoughtpolice committed
246
 'javascript'   { L _ ITjavascriptcallconv }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
247
248
 'proc'         { L _ ITproc }          -- for arrow notation extension
 'rec'          { L _ ITrec }           -- for arrow notation extension
249
250
251
 'group'    { L _ ITgroup }     -- for list transform extension
 'by'       { L _ ITby }        -- for list transform extension
 'using'    { L _ ITusing }     -- for list transform extension
252

253
254
 '{-# INLINE'             { L _ (ITinline_prag _ _) }
 '{-# SPECIALISE'         { L _ ITspec_prag }
255
 '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
256
257
258
 '{-# SOURCE'                                   { L _ ITsource_prag }
 '{-# RULES'                                    { L _ ITrules_prag }
 '{-# CORE'                                     { L _ ITcore_prag }              -- hdaume: annotated core
259
260
261
262
263
 '{-# SCC'                { L _ ITscc_prag }
 '{-# GENERATED'          { L _ ITgenerated_prag }
 '{-# DEPRECATED'         { L _ ITdeprecated_prag }
 '{-# WARNING'            { L _ ITwarning_prag }
 '{-# UNPACK'             { L _ ITunpack_prag }
264
 '{-# NOUNPACK'           { L _ ITnounpack_prag }
265
 '{-# ANN'                { L _ ITann_prag }
266
267
 '{-# VECTORISE'          { L _ ITvect_prag }
 '{-# VECTORISE_SCALAR'   { L _ ITvect_scalar_prag }
268
 '{-# NOVECTORISE'        { L _ ITnovect_prag }
269
 '{-# MINIMAL'            { L _ ITminimal_prag }
270
 '{-# CTYPE'              { L _ ITctype }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
271
272
273
274
275
276
277
 '#-}'                                          { L _ ITclose_prag }

 '..'           { L _ ITdotdot }                        -- reserved symbols
 ':'            { L _ ITcolon }
 '::'           { L _ ITdcolon }
 '='            { L _ ITequal }
 '\\'           { L _ ITlam }
278
 'lcase'        { L _ ITlcase }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
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
 '|'            { L _ ITvbar }
 '<-'           { L _ ITlarrow }
 '->'           { L _ ITrarrow }
 '@'            { L _ ITat }
 '~'            { L _ ITtilde }
 '~#'           { L _ ITtildehsh }
 '=>'           { L _ ITdarrow }
 '-'            { L _ ITminus }
 '!'            { L _ ITbang }
 '*'            { L _ ITstar }
 '-<'           { L _ ITlarrowtail }            -- for arrow notation
 '>-'           { L _ ITrarrowtail }            -- for arrow notation
 '-<<'          { L _ ITLarrowtail }            -- for arrow notation
 '>>-'          { L _ ITRarrowtail }            -- for arrow notation
 '.'            { L _ ITdot }

 '{'            { L _ ITocurly }                        -- special symbols
 '}'            { L _ ITccurly }
 vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
 vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
 '['            { L _ ITobrack }
 ']'            { L _ ITcbrack }
 '[:'           { L _ ITopabrack }
 ':]'           { L _ ITcpabrack }
 '('            { L _ IToparen }
 ')'            { L _ ITcparen }
 '(#'           { L _ IToubxparen }
 '#)'           { L _ ITcubxparen }
 '(|'           { L _ IToparenbar }
 '|)'           { L _ ITcparenbar }
 ';'            { L _ ITsemi }
 ','            { L _ ITcomma }
 '`'            { L _ ITbackquote }
dreixel's avatar
dreixel committed
312
 SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
313
314
315
316
317
318
319
320
321

 VARID          { L _ (ITvarid    _) }          -- identifiers
 CONID          { L _ (ITconid    _) }
 VARSYM         { L _ (ITvarsym   _) }
 CONSYM         { L _ (ITconsym   _) }
 QVARID         { L _ (ITqvarid   _) }
 QCONID         { L _ (ITqconid   _) }
 QVARSYM        { L _ (ITqvarsym  _) }
 QCONSYM        { L _ (ITqconsym  _) }
322
323
 PREFIXQVARSYM  { L _ (ITprefixqvarsym  _) }
 PREFIXQCONSYM  { L _ (ITprefixqconsym  _) }
324

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
325
326
327
328
329
330
 IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension

 CHAR           { L _ (ITchar     _) }
 STRING         { L _ (ITstring   _) }
 INTEGER        { L _ (ITinteger  _) }
 RATIONAL       { L _ (ITrational _) }
331

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
332
333
334
335
336
337
338
339
340
341
342
 PRIMCHAR       { L _ (ITprimchar   _) }
 PRIMSTRING     { L _ (ITprimstring _) }
 PRIMINTEGER    { L _ (ITprimint    _) }
 PRIMWORD       { L _ (ITprimword  _) }
 PRIMFLOAT      { L _ (ITprimfloat  _) }
 PRIMDOUBLE     { L _ (ITprimdouble _) }

 DOCNEXT        { L _ (ITdocCommentNext _) }
 DOCPREV        { L _ (ITdocCommentPrev _) }
 DOCNAMED       { L _ (ITdocCommentNamed _) }
 DOCSECTION     { L _ (ITdocSection _ _) }
343

344
345
346
347
348
-- Template Haskell
'[|'            { L _ ITopenExpQuote  }
'[p|'           { L _ ITopenPatQuote  }
'[t|'           { L _ ITopenTypQuote  }
'[d|'           { L _ ITopenDecQuote  }
349
'|]'            { L _ ITcloseQuote    }
350
351
'[||'           { L _ ITopenTExpQuote   }
'||]'           { L _ ITcloseTExpQuote  }
352
TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
353
'$('            { L _ ITparenEscape   }     -- $( exp )
354
355
TH_ID_TY_SPLICE { L _ (ITidTyEscape _)  }   -- $$x
'$$('           { L _ ITparenTyEscape   }   -- $$( exp )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
356
357
TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
358
TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
359
360
361
362
363
364

%monad { P } { >>= } { return }
%lexer { lexer } { L _ ITeof }
%name parseModule module
%name parseStmt   maybe_stmt
%name parseIdentifier  identifier
365
%name parseType ctype
366
%partial parseHeader header
367
%tokentype { (Located Token) }
368
369
%%

370
371
372
-----------------------------------------------------------------------------
-- Identifiers; one of the entry points
identifier :: { Located RdrName }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
373
374
375
376
        : qvar                          { $1 }
        | qcon                          { $1 }
        | qvarop                        { $1 }
        | qconop                        { $1 }
377
    | '(' '->' ')'      { LL $ getRdrName funTyCon }
378

379
380
381
382
383
384
385
386
387
388
-----------------------------------------------------------------------------
-- Module Header

-- The place for module deprecation is really too restrictive, but if it
-- was allowed at its natural place just before 'module', we get an ugly
-- s/r conflict with the second alternative. Another solution would be the
-- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
-- either, and DEPRECATED is only expected to be used by people who really
-- know what they are doing. :-)

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
389
390
391
392
module  :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 $1
393
                          ) )}
394
        | body2
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
395
396
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule Nothing Nothing
397
398
                          (fst $1) (snd $1) Nothing Nothing
                          )) }
399

400
maybedocheader :: { Maybe LHsDocString }
401
        : moduleheader            { $1 }
402
        | {- empty -}             { Nothing }
403
404

missing_module_keyword :: { () }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
405
        : {- empty -}                           {% pushCurrentContext }
406

Ian Lynagh's avatar
Ian Lynagh committed
407
maybemodwarning :: { Maybe WarningTxt }
408
409
    : '{-# DEPRECATED' strings '#-}' { Just (DeprecatedTxt $ unLoc $2) }
    | '{-# WARNING' strings '#-}'    { Just (WarningTxt $ unLoc $2) }
Ian Lynagh's avatar
Ian Lynagh committed
410
    |  {- empty -}                  { Nothing }
411

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
412
413
414
body    :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
        :  '{'            top '}'               { $2 }
        |      vocurly    top close             { $2 }
415

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
416
417
418
body2   :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
        :  '{' top '}'                          { $2 }
        |  missing_module_keyword top close     { $2 }
419

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
420
421
422
423
top     :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
        : importdecls                           { (reverse $1,[]) }
        | importdecls ';' cvtopdecls            { (reverse $1,$3) }
        | cvtopdecls                            { ([],$1) }
424
425

cvtopdecls :: { [LHsDecl RdrName] }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
426
        : topdecls                              { cvTopDecls $1 }
427

428
429
430
-----------------------------------------------------------------------------
-- Module declaration & imports only

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
431
432
433
434
header  :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule (Just $3) $5 $7 [] $4 $1
435
                          ))}
436
        | header_body2
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
437
                {% fileSrcSpan >>= \ loc ->
438
                   return (L loc (HsModule Nothing Nothing $1 [] Nothing
439
                          Nothing)) }
440
441

header_body :: { [LImportDecl RdrName] }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
442
        :  '{'            importdecls           { $2 }
443
444
445
446
447
        |      vocurly    importdecls           { $2 }

header_body2 :: { [LImportDecl RdrName] }
        :  '{' importdecls                      { $2 }
        |  missing_module_keyword importdecls   { $2 }
448

449
450
451
452
-----------------------------------------------------------------------------
-- The Export List

maybeexports :: { Maybe [LIE RdrName] }
453
        :  '(' exportlist ')'                   { Just (fromOL $2) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
454
        |  {- empty -}                          { Nothing }
455

456
457
exportlist :: { OrdList (LIE RdrName) }
        : expdoclist ',' expdoclist             { $1 `appOL` $3 }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
458
        | exportlist1                           { $1 }
459

460
461
462
exportlist1 :: { OrdList (LIE RdrName) }
        : expdoclist export expdoclist ',' exportlist1 { $1 `appOL` $2 `appOL` $3 `appOL` $5 }
        | expdoclist export expdoclist                 { $1 `appOL` $2 `appOL` $3 }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
463
        | expdoclist                                   { $1 }
464

465
466
467
expdoclist :: { OrdList (LIE RdrName) }
        : exp_doc expdoclist                           { $1 `appOL` $2 }
        | {- empty -}                                  { nilOL }
468

469
470
471
472
exp_doc :: { OrdList (LIE RdrName) }
        : docsection    { unitOL (L1 (case (unLoc $1) of (n, doc) -> IEGroup n doc)) }
        | docnamed      { unitOL (L1 (IEDocNamed ((fst . unLoc) $1))) }
        | docnext       { unitOL (L1 (IEDoc (unLoc $1))) }
473
474


475
476
   -- No longer allow things like [] and (,,,) to be exported
   -- They are built in syntax, always available
477
478
479
480
export  :: { OrdList (LIE RdrName) }
        : qcname_ext export_subspec     { unitOL (LL (mkModuleImpExp (unLoc $1)
                                                                     (unLoc $2))) }
        |  'module' modid               { unitOL (LL (IEModuleContents (unLoc $2))) }
481

482
483
484
485
export_subspec :: { Located ImpExpSubSpec }
        : {- empty -}                   { L0 ImpExpAbs }
        | '(' '..' ')'                  { LL ImpExpAll }
        | '(' ')'                       { LL (ImpExpList []) }
486
        | '(' qcnames ')'               { LL (ImpExpList (reverse $2)) }
487

488
qcnames :: { [RdrName] }     -- A reversed list
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
489
490
        :  qcnames ',' qcname_ext       { unLoc $3 : $1 }
        |  qcname_ext                   { [unLoc $1]  }
491

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
492
493
494
qcname_ext :: { Located RdrName }       -- Variable or data constructor
                                        -- or tagged type constructor
        :  qcname                       { $1 }
495
        |  'type' qcname                {% mkTypeImpExp (LL (unLoc $2)) }
496
497

-- Cannot pull into qcname_ext, as qcname is also used in expression.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
498
499
500
qcname  :: { Located RdrName }  -- Variable or data constructor
        :  qvar                         { $1 }
        |  qcon                         { $1 }
501
502
503
504
505
506
507
508

-----------------------------------------------------------------------------
-- Import Declarations

-- import decls can be *empty*, or even just a string of semicolons
-- whereas topdecls must contain at least one topdecl.

importdecls :: { [LImportDecl RdrName] }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
509
510
511
512
        : importdecls ';' importdecl            { $3 : $1 }
        | importdecls ';'                       { $1 }
        | importdecl                            { [ $1 ] }
        | {- empty -}                           { [] }
513
514

importdecl :: { LImportDecl RdrName }
515
        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
516
                { L (comb4 $1 $6 $7 $8) $
517
518
519
520
                  ImportDecl { ideclName = $6, ideclPkgQual = $5
                             , ideclSource = $2, ideclSafe = $3
                             , ideclQualified = $4, ideclImplicit = False
                             , ideclAs = unLoc $7, ideclHiding = unLoc $8 } }
521
522

maybe_src :: { IsBootInterface }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
523
524
        : '{-# SOURCE' '#-}'                    { True }
        | {- empty -}                           { False }
525

526
maybe_safe :: { Bool }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
527
528
        : 'safe'                                { True }
        | {- empty -}                           { False }
529

530
531
532
533
maybe_pkg :: { Maybe FastString }
        : STRING                                { Just (getSTRING $1) }
        | {- empty -}                           { Nothing }

534
optqualified :: { Bool }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
535
536
        : 'qualified'                           { True  }
        | {- empty -}                           { False }
537

Simon Marlow's avatar
Simon Marlow committed
538
maybeas :: { Located (Maybe ModuleName) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
539
540
        : 'as' modid                            { LL (Just (unLoc $2)) }
        | {- empty -}                           { noLoc Nothing }
541
542

maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
543
544
        : impspec                               { L1 (Just (unLoc $1)) }
        | {- empty -}                           { noLoc Nothing }
545
546

impspec :: { Located (Bool, [LIE RdrName]) }
547
548
        :  '(' exportlist ')'                   { LL (False, fromOL $2) }
        |  'hiding' '(' exportlist ')'          { LL (True,  fromOL $3) }
549
550
551
552

-----------------------------------------------------------------------------
-- Fixity Declarations

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
553
554
555
prec    :: { Int }
        : {- empty -}           { 9 }
        | INTEGER               {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
556

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
557
558
559
560
infix   :: { Located FixityDirection }
        : 'infix'                               { L1 InfixN  }
        | 'infixl'                              { L1 InfixL  }
        | 'infixr'                              { L1 InfixR }
561

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
562
563
564
ops     :: { Located [Located RdrName] }
        : ops ',' op                            { LL ($3 : unLoc $1) }
        | op                                    { L1 [$1] }
565
566
567
568

-----------------------------------------------------------------------------
-- Top-Level Declarations

569
topdecls :: { OrdList (LHsDecl RdrName) }
570
571
572
        : topdecls ';' topdecl                  { $1 `appOL` $3 }
        | topdecls ';'                          { $1 }
        | topdecl                               { $1 }
573

574
topdecl :: { OrdList (LHsDecl RdrName) }
575
576
        : cl_decl                               { unitOL (L1 (TyClD (unLoc $1))) }
        | ty_decl                               { unitOL (L1 (TyClD (unLoc $1))) }
577
        | inst_decl                             { unitOL (L1 (InstD (unLoc $1))) }
578
        | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
579
        | role_annot                            { unitOL (L1 (RoleAnnotD (unLoc $1))) }
580
581
        | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
        | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
582
583
        | '{-# DEPRECATED' deprecations '#-}'   { $2 }
        | '{-# WARNING' warnings '#-}'          { $2 }
584
        | '{-# RULES' rules '#-}'               { $2 }
585
        | '{-# VECTORISE' qvar '=' exp '#-}'    { unitOL $ LL $ VectD (HsVect       $2 $4) }
586
        | '{-# NOVECTORISE' qvar '#-}'          { unitOL $ LL $ VectD (HsNoVect     $2) }
587
588
        | '{-# VECTORISE' 'type' gtycon '#-}'
                                                { unitOL $ LL $
589
                                                    VectD (HsVectTypeIn False $3 Nothing) }
590
591
        | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
                                                { unitOL $ LL $
592
                                                    VectD (HsVectTypeIn True $3 Nothing) }
593
594
        | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
                                                { unitOL $ LL $
595
                                                    VectD (HsVectTypeIn False $3 (Just $5)) }
596
597
        | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
                                                { unitOL $ LL $
598
                                                    VectD (HsVectTypeIn True $3 (Just $5)) }
599
        | '{-# VECTORISE' 'class' gtycon '#-}'  { unitOL $ LL $ VectD (HsVectClassIn $3) }
600
        | annotation { unitOL $1 }
601
        | decl_no_th                            { unLoc $1 }
602
603
604

        -- Template Haskell Extension
        -- The $(..) form is one possible form of infixexp
605
        -- but we treat an arbitrary expression just as if
606
        -- it had a $(..) wrapped around it
607
        | infixexp                              { unitOL (LL $ mkSpliceDecl $1) }
608

609
610
611
-- Type classes
--
cl_decl :: { LTyClDecl RdrName }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
612
        : 'class' tycl_hdr fds where_cls        {% mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 $4 }
613

614
-- Type declarations (toplevel)
615
616
--
ty_decl :: { LTyClDecl RdrName }
617
           -- ordinary type synonyms
618
        : 'type' type '=' ctypedoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
619
620
621
622
623
624
                -- Note ctype, not sigtype, on the right of '='
                -- We allow an explicit for-all but we don't insert one
                -- in   type Foo a = (b,b)
                -- Instead we just say b is out of scope
                --
                -- Note the use of type for the head; this allows
625
                -- infix type constructors to be declared
626
                {% mkTySynonym (comb2 $1 $4) $2 $4 }
627
628

           -- type family declarations
629
        | 'type' 'family' type opt_kind_sig where_type_family
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
630
631
                -- Note the use of type for the head; this allows
                -- infix type constructors to be declared
632
                {% do { L loc decl <- mkFamDecl (comb4 $1 $3 $4 $5) (unLoc $5) $3 (unLoc $4)
633
                      ; return (L loc (FamDecl decl)) } }
634

635
          -- ordinary data type or newtype declaration
636
        | data_or_newtype capi_ctype tycl_hdr constrs deriving
637
                {% mkTyData (comb4 $1 $3 $4 $5) (unLoc $1) $2 $3
638
                            Nothing (reverse (unLoc $4)) (unLoc $5) }
639
                                   -- We need the location on tycl_hdr in case
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
640
                                   -- constrs and deriving are both empty
641

642
          -- ordinary GADT declaration
643
        | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
644
645
                 gadt_constrlist
                 deriving
646
                {% mkTyData (comb4 $1 $3 $5 $6) (unLoc $1) $2 $3
647
                            (unLoc $4) (unLoc $5) (unLoc $6) }
648
                                   -- We need the location on tycl_hdr in case
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
649
                                   -- constrs and deriving are both empty
650

651
          -- data/newtype family
652
        | 'data' 'family' type opt_kind_sig
653
654
                {% do { L loc decl <- mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (unLoc $4)
                      ; return (L loc (FamDecl decl)) } }
655

656
657
inst_decl :: { LInstDecl RdrName }
        : 'instance' inst_type where_inst
658
659
660
661
662
                 { let (binds, sigs, _, ats, adts, _) = cvBindsAndSigs (unLoc $3) in
                   let cid = ClsInstDecl { cid_poly_ty = $2, cid_binds = binds
                                         , cid_sigs = sigs, cid_tyfam_insts = ats
                                         , cid_datafam_insts = adts }
                   in L (comb3 $1 $2 $3) (ClsInstD { cid_inst = cid }) }
663
664

           -- type instance declarations
665
666
667
668
        | 'type' 'instance' ty_fam_inst_eqn
                {% do { L loc tfi <- mkTyFamInst (comb2 $1 $3) $3
                      ; return (L loc (TyFamInstD { tfid_inst = tfi })) } }

669
          -- data/newtype instance declaration
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
670
        | data_or_newtype 'instance' tycl_hdr constrs deriving
671
                {% do { L loc d <- mkFamInstData (comb4 $1 $3 $4 $5) (unLoc $1) Nothing $3
672
                                      Nothing (reverse (unLoc $4)) (unLoc $5)
673
                      ; return (L loc (DataFamInstD { dfid_inst = d })) } }
674

675
          -- GADT instance declaration
676
        | data_or_newtype 'instance' tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
677
678
                 gadt_constrlist
                 deriving
679
                {% do { L loc d <- mkFamInstData (comb4 $1 $3 $5 $6) (unLoc $1) Nothing $3
680
                                            (unLoc $4) (unLoc $5) (unLoc $6)
681
                      ; return (L loc (DataFamInstD { dfid_inst = d })) } }
682

683
684
685
686
687
688
-- Closed type families

where_type_family :: { Located (FamilyInfo RdrName) }
        : {- empty -}                      { noLoc OpenTypeFamily }
        | 'where' ty_fam_inst_eqn_list
               { LL (ClosedTypeFamily (reverse (unLoc $2))) }
689
690
691
692

ty_fam_inst_eqn_list :: { Located [LTyFamInstEqn RdrName] }
        :     '{' ty_fam_inst_eqns '}'     { LL (unLoc $2) }
        | vocurly ty_fam_inst_eqns close   { $2 }
693
694
        |     '{' '..' '}'                 { LL [] }
        | vocurly '..' close               { let L loc _ = $2 in L loc [] }
695
696

ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
697
        : ty_fam_inst_eqns ';' ty_fam_inst_eqn   { LL ($3 : unLoc $1) }
698
699
700
701
702
703
704
        | ty_fam_inst_eqns ';'                   { LL (unLoc $1) }
        | ty_fam_inst_eqn                        { LL [$1] }

ty_fam_inst_eqn :: { LTyFamInstEqn RdrName }
        : type '=' ctype
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
705
706
              {% do { eqn <- mkTyFamInstEqn $1 $3
                    ; return (LL eqn) } }
707

708
-- Associated type family declarations
709
710
711
712
713
714
--
-- * They have a different syntax than on the toplevel (no family special
--   identifier).
--
-- * They also need to be separate from instances; otherwise, data family
--   declarations without a kind signature cause parsing conflicts with empty
715
--   data declarations.
716
--
717
718
at_decl_cls :: { LHsDecl RdrName }
           -- family declarations
719
        : 'type' type opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
720
                -- Note the use of type for the head; this allows
721
                -- infix type constructors to be declared.
722
                {% do { L loc decl <- mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily $2 (unLoc $3)
723
                      ; return (L loc (TyClD (FamDecl decl))) } }
724
725

        | 'data' type opt_kind_sig
726
727
                {% do { L loc decl <- mkFamDecl (comb3 $1 $2 $3) DataFamily $2 (unLoc $3)
                      ; return (L loc (TyClD (FamDecl decl))) } }
728

729
           -- default type instance
730
        | 'type' ty_fam_inst_eqn
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
731
732
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
733
734
                {% do { L loc tfi <- mkTyFamInst (comb2 $1 $2) $2
                      ; return (L loc (InstD (TyFamInstD { tfid_inst = tfi }))) } }
735
736

-- Associated type instances
737
--
738
at_decl_inst :: { LTyFamInstDecl RdrName }
739
           -- type instance declarations
740
        : 'type' ty_fam_inst_eqn
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
741
742
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
743
                {% mkTyFamInst (comb2 $1 $2) $2 }
744

745
adt_decl_inst :: { LDataFamInstDecl RdrName }
746
        -- data/newtype instance declaration
747
        : data_or_newtype capi_ctype tycl_hdr constrs deriving
748
                {% mkFamInstData (comb4 $1 $3 $4 $5) (unLoc $1) $2 $3
749
                                 Nothing (reverse (unLoc $4)) (unLoc $5) }
750
751

        -- GADT instance declaration
752
        | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
753
754
                 gadt_constrlist
                 deriving
755
                {% mkFamInstData (comb4 $1 $3 $5 $6) (unLoc $1) $2 $3
756
                                 (unLoc $4) (unLoc $5) (unLoc $6) }
757

758
data_or_newtype :: { Located NewOrData }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
759
760
        : 'data'        { L1 DataType }
        | 'newtype'     { L1 NewType }
761

762
opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
763
        :                               { noLoc Nothing }
764
        | '::' kind                     { LL (Just $2) }
765

766
-- tycl_hdr parses the header of a class or data type decl,
767
-- which takes the form
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
768
769
770
771
--      T a b
--      Eq a => T a
--      (Eq a, Ord b) => T a b
--      T Int [a]                       -- for associated types
772
-- Rather a lot of inlining here, else we get reduce/reduce errors
773
tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
774
775
        : context '=>' type             { LL (Just $1, $3) }
        | type                          { L1 (Nothing, $1) }
776

777
capi_ctype :: { Maybe CType }
778
779
capi_ctype : '{-# CTYPE' STRING STRING '#-}' { Just (CType (Just (Header (getSTRING $2))) (getSTRING $3)) }
           | '{-# CTYPE'        STRING '#-}' { Just (CType Nothing                        (getSTRING $2)) }
780
           |                                 { Nothing }
781

782
783
784
785
786
-----------------------------------------------------------------------------
-- Stand-alone deriving

-- Glasgow extension: stand-alone deriving declarations
stand_alone_deriving :: { LDerivDecl RdrName }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
787
        : 'deriving' 'instance' inst_type { LL (DerivDecl $3) }
788

789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
-----------------------------------------------------------------------------
-- Role annotations

role_annot :: { LRoleAnnotDecl RdrName }
role_annot : 'type' 'role' oqtycon maybe_roles
              {% mkRoleAnnotDecl (comb3 $1 $3 $4) $3 (reverse (unLoc $4)) }

-- Reversed!
maybe_roles :: { Located [Located (Maybe FastString)] }
maybe_roles : {- empty -}    { noLoc [] }
            | roles          { $1 }

roles :: { Located [Located (Maybe FastString)] }
roles : role             { LL [$1] }
      | roles role       { LL $ $2 : unLoc $1 }

-- read it in as a varid for better error messages
role :: { Located (Maybe FastString) }
role : VARID             { L1 $ Just $ getVARID $1 }
     | '_'               { L1 Nothing }

810
811
812
-----------------------------------------------------------------------------
-- Nested declarations

813
-- Declaration in class bodies
814
--
815
decl_cls  :: { Located (OrdList (LHsDecl RdrName)) }
816
decl_cls  : at_decl_cls                 { LL (unitOL $1) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
817
          | decl                        { $1 }
818

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
819
          -- A 'default' signature used with the generic-programming extension
820
821
822
823
          | 'default' infixexp '::' sigtypedoc
                    {% do { (TypeSig l ty) <- checkValSig $2 $4
                          ; return (LL $ unitOL (LL $ SigD (GenericSig l ty))) } }

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
824
825
826
827
828
decls_cls :: { Located (OrdList (LHsDecl RdrName)) }    -- Reversed
          : decls_cls ';' decl_cls      { LL (unLoc $1 `appOL` unLoc $3) }
          | decls_cls ';'               { LL (unLoc $1) }
          | decl_cls                    { $1 }
          | {- empty -}                 { noLoc nilOL }
829
830


831
decllist_cls
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
832
833
834
        :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
        : '{'         decls_cls '}'     { LL (unLoc $2) }
        |     vocurly decls_cls close   { $2 }
835

836
-- Class body
837
--
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
838
839
840
841
842
where_cls :: { Located (OrdList (LHsDecl RdrName)) }    -- Reversed
                                -- No implicit parameters
                                -- May have type declarations
        : 'where' decllist_cls          { LL (unLoc $2) }
        | {- empty -}                   { noLoc nilOL }
843
844
845
846

-- Declarations in instance bodies
--
decl_inst  :: { Located (OrdList (LHsDecl RdrName)) }
847
848
decl_inst  : at_decl_inst               { LL (unitOL (L1 (InstD (TyFamInstD { tfid_inst = unLoc $1 })))) }
           | adt_decl_inst              { LL (unitOL (L1 (InstD (DataFamInstD { dfid_inst = unLoc $1 })))) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
849
           | decl                       { $1 }
850

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
851
852
853
854
855
decls_inst :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
           : decls_inst ';' decl_inst   { LL (unLoc $1 `appOL` unLoc $3) }
           | decls_inst ';'             { LL (unLoc $1) }
           | decl_inst                  { $1 }
           | {- empty -}                { noLoc nilOL }
856

857
decllist_inst
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
858
859
860
        :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
        : '{'         decls_inst '}'    { LL (unLoc $2) }
        |     vocurly decls_inst close  { $2 }
861
862
863

-- Instance body
--
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
864
865
866
867
868
where_inst :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
                                -- No implicit parameters
                                -- May have type declarations
        : 'where' decllist_inst         { LL (unLoc $2) }
        | {- empty -}                   { noLoc nilOL }
869

870
871
-- Declarations in binding groups other than classes and instances
--
872
decls   :: { Located (OrdList (LHsDecl RdrName)) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
873
        : decls ';' decl                { let { this = unLoc $3;
Ian Lynagh's avatar
Ian Lynagh committed
874
                                    rest = unLoc $1;
Ian Lynagh's avatar
Ian Lynagh committed
875
                                    these = rest `appOL` this }
Ian Lynagh's avatar
Ian Lynagh committed
876
877
                              in rest `seq` this `seq` these `seq`
                                    LL these }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
878
879
880
        | decls ';'                     { LL (unLoc $1) }
        | decl                          { $1 }
        | {- empty -}                   { noLoc nilOL }
881

882
decllist :: { Located (OrdList (LHsDecl RdrName)) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
883
884
        : '{'            decls '}'      { LL (unLoc $2) }
        |     vocurly    decls close    { $2 }
885

886
887
-- Binding groups other than those of class and instance declarations
--
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
888
889
890
891
892
binds   ::  { Located (HsLocalBinds RdrName) }          -- May have implicit parameters
                                                -- No type declarations
        : decllist                      { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
        | '{'            dbinds '}'     { LL (HsIPBinds (IPBinds (unLoc $2) emptyTcEvBinds)) }
        |     vocurly    dbinds close   { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyTcEvBinds)) }
893

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
894
895
896
897
wherebinds :: { Located (HsLocalBinds RdrName) }        -- May have implicit parameters
                                                -- No type declarations
        : 'where' binds                 { LL (unLoc $2) }
        | {- empty -}                   { noLoc emptyLocalBinds }
898
899
900
901
902


-----------------------------------------------------------------------------
-- Transformation Rules

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
903
904
905
906
907
rules   :: { OrdList (LHsDecl RdrName) }
        :  rules ';' rule                       { $1 `snocOL` $3 }
        |  rules ';'                            { $1 }
        |  rule                                 { unitOL $1 }
        |  {- empty -}                          { nilOL }
908

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
909
rule    :: { LHsDecl RdrName }
910
        : STRING rule_activation rule_forall infixexp '=' exp
911
912
             { LL $ RuleD (HsRule (getSTRING $1)
                                  ($2 `orElse` AlwaysActive)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
913
                                  $3 $4 placeHolderNames $6 placeHolderNames) }
914

915
-- Rules can be specified to be NeverActive, unlike inline/specialize pragmas
916
rule_activation :: { Maybe Activation }
917
        : {- empty -}                           { Nothing }
918
        | rule_explicit_activation              { Just $1 }
919

920
rule_explicit_activation :: { Activation }  -- In brackets
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
921
922
        : '[' INTEGER ']'               { ActiveAfter  (fromInteger (getINTEGER $2)) }
        | '[' '~' INTEGER ']'           { ActiveBefore (fromInteger (getINTEGER $3)) }
ian@well-typed.com's avatar
Detab    
ian@well-typed.com committed
923
        | '[' '~' ']'                   { NeverActive }
924
925

rule_forall :: { [RuleBndr RdrName] }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
926
927
        : 'forall' rule_var_list '.'            { $2 }
        | {- empty -}                           { [] }
928
929

rule_var_list :: { [RuleBndr RdrName] }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
930
931
        : rule_var                              { [$1] }
        | rule_var rule_var_list                { $1 : $2 }
932
933

rule_var :: { RuleBndr RdrName }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
934
        : varid                                 { RuleBndr $1 }
935
        | '(' varid '::' ctype ')'              { RuleBndrSig $2 (mkHsWithBndrs $4) }
936
937

-----------------------------------------------------------------------------
Ian Lynagh's avatar
Ian Lynagh committed
938
939
940
-- Warnings and deprecations (c.f. rules)

warnings :: { OrdList (LHsDecl RdrName) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
941
942
943
944
        : warnings ';' warning          { $1 `appOL` $3 }
        | warnings ';'                  { $1 }
        | warning                               { $1 }
        | {- empty -}                           { nilOL }
Ian Lynagh's avatar
Ian Lynagh committed
945
946
947

-- SUP: TEMPORARY HACK, not checking for `module Foo'
warning :: { OrdList (LHsDecl RdrName) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
948
949
950
        : namelist strings
                { toOL [ LL $ WarningD (Warning n (WarningTxt $ unLoc $2))
                       | n <- unLoc $1 ] }
951

952
deprecations :: { OrdList (LHsDecl RdrName) }