Removed deprecated syntax for GADT constuctors.
[ghc.git] / compiler / parser / Parser.y
1 --                                                              -*-haskell-*-
2 -- ---------------------------------------------------------------------------
3 -- (c) The University of Glasgow 1997-2003
4 ---
5 -- The GHC grammar.
6 --
7 -- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
8 -- ---------------------------------------------------------------------------
9
10 {
11 -- | This module provides the generated Happy parser for Haskell. It exports
12 -- a number of parsers which may be used in any library that uses the GHC API.
13 -- A common usage pattern is to initialize the parser state with a given string
14 -- and then parse that string:
15 --
16 -- @
17 --     runParser :: DynFlags -> String -> P a -> ParseResult a
18 --     runParser flags str parser = unP parser parseState
19 --     where
20 --       filename = "\<interactive\>"
21 --       location = mkRealSrcLoc (mkFastString filename) 1 1
22 --       buffer = stringToStringBuffer str
23 --       parseState = mkPState flags buffer location
24 -- @
25 module Parser (parseModule, parseImport, parseStatement,
26                parseDeclaration, parseExpression, parsePattern,
27                parseTypeSignature,
28                parseStmt, parseIdentifier,
29                parseType, parseHeader) where
30
31 -- base
32 import Control.Monad    ( unless, liftM )
33 import GHC.Exts
34 import Data.Char
35 import Control.Monad    ( mplus )
36
37 -- compiler/hsSyn
38 import HsSyn
39
40 -- compiler/main
41 import HscTypes         ( IsBootInterface, WarningTxt(..) )
42 import DynFlags
43
44 -- compiler/utils
45 import OrdList
46 import BooleanFormula   ( BooleanFormula(..), mkTrue )
47 import FastString
48 import Maybes           ( orElse )
49 import Outputable
50
51 -- compiler/basicTypes
52 import RdrName
53 import OccName          ( varName, dataName, tcClsName, tvName, startsWithUnderscore )
54 import DataCon          ( DataCon, dataConName )
55 import SrcLoc
56 import Module
57 import BasicTypes
58
59 -- compiler/types
60 import Type             ( funTyCon )
61 import Kind             ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind )
62 import Class            ( FunDep )
63
64 -- compiler/parser
65 import RdrHsSyn
66 import Lexer
67 import HaddockUtils
68 import ApiAnnotation
69
70 -- compiler/typecheck
71 import TcEvidence       ( emptyTcEvBinds )
72
73 -- compiler/prelude
74 import ForeignCall
75 import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
76 import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
77                           unboxedUnitTyCon, unboxedUnitDataCon,
78                           listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
79
80 -- compiler/utils
81 import Util             ( looksLikePackageName )
82
83 }
84
85 {- Last updated: 31 Jul 2015
86
87 Conflicts: 47 shift/reduce
88
89 If you modify this parser and add a conflict, please update this comment.
90 You can learn more about the conflicts by passing 'happy' the -i flag:
91
92     happy -agc --strict compiler/parser/Parser.y -idetailed-info
93
94 How is this section formatted? Look up the state the conflict is
95 reported at, and copy the list of applicable rules (at the top).  Mark
96 *** for the rule that is the conflicting reduction (that is, the
97 interpretation which is NOT taken).  NB: Happy doesn't print a rule in a
98 state if it is empty, but you should include it in the list (you can
99 look these up in the Grammar section of the info file).
100
101 Obviously the state numbers are not stable across modifications to the parser,
102 the idea is to reproduce enough information on each conflict so you can figure
103 out what happened if the states were renumbered.  Try not to gratuitously move
104 productions around in this file.  It's probably less important to keep
105 the rule annotations up-to-date.
106
107 -------------------------------------------------------------------------------
108
109 state 0 contains 1 shift/reduce conflicts.
110
111     Conflicts: DOCNEXT (empty missing_module_keyword reduces)
112
113 Ambiguity when the source file starts with "-- | doc". We need another
114 token of lookahead to determine if a top declaration or the 'module' keyword
115 follows. Shift parses as if the 'module' keyword follows.
116
117 -------------------------------------------------------------------------------
118
119 state 46 contains 2 shift/reduce conflicts.
120
121     *** strict_mark -> unpackedness .                       (rule 268)
122         strict_mark -> unpackedness . strictness            (rule 269)
123
124     Conflicts: '~' '!'
125
126 -------------------------------------------------------------------------------
127
128 state 50 contains 11 shift/reduce conflicts.
129
130         context -> btype .                                  (rule 282)
131     *** type -> btype .                                     (rule 283)
132         type -> btype . qtyconop type                       (rule 284)
133         type -> btype . tyvarop type                        (rule 285)
134         type -> btype . '->' ctype                          (rule 286)
135         type -> btype . SIMPLEQUOTE qconop type             (rule 287)
136         type -> btype . SIMPLEQUOTE varop type              (rule 288)
137         btype -> btype . atype                              (rule 299)
138
139     Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
140
141 Example of ambiguity: 'e :: a `b` c';  does this mean
142     (e::a) `b` c, or
143     (e :: (a `b` c))
144
145 The case for '->' involves view patterns rather than type operators:
146     'case v of { x :: T -> T ... } '
147     Which of these two is intended?
148           case v of
149             (x::T) -> T         -- Rhs is T
150     or
151           case v of
152             (x::T -> T) -> ..   -- Rhs is ...
153
154 -------------------------------------------------------------------------------
155
156 state 119 contains 15 shift/reduce conflicts.
157
158         exp -> infixexp . '::' sigtype                      (rule 416)
159         exp -> infixexp . '-<' exp                          (rule 417)
160         exp -> infixexp . '>-' exp                          (rule 418)
161         exp -> infixexp . '-<<' exp                         (rule 419)
162         exp -> infixexp . '>>-' exp                         (rule 420)
163     *** exp -> infixexp .                                   (rule 421)
164         infixexp -> infixexp . qop exp10                    (rule 423)
165
166     Conflicts: ':' '::' '-' '!' '*' '-<' '>-' '-<<' '>>-'
167                '.' '`' VARSYM CONSYM QVARSYM QCONSYM
168
169 Examples of ambiguity:
170     'if x then y else z -< e'
171     'if x then y else z :: T'
172     'if x then y else z + 1' (NB: '+' is in VARSYM)
173
174 Shift parses as (per longest-parse rule):
175     'if x then y else (z -< T)'
176     'if x then y else (z :: T)'
177     'if x then y else (z + 1)'
178
179 -------------------------------------------------------------------------------
180
181 state 279 contains 1 shift/reduce conflicts.
182
183         rule -> STRING . rule_activation rule_forall infixexp '=' exp    (rule 215)
184
185     Conflict: '[' (empty rule_activation reduces)
186
187 We don't know whether the '[' starts the activation or not: it
188 might be the start of the declaration with the activation being
189 empty.  --SDM 1/4/2002
190
191 Example ambiguity:
192     '{-# RULE [0] f = ... #-}'
193
194 We parse this as having a [0] rule activation for rewriting 'f', rather
195 a rule instructing how to rewrite the expression '[0] f'.
196
197 -------------------------------------------------------------------------------
198
199 state 288 contains 11 shift/reduce conflicts.
200
201     *** type -> btype .                                     (rule 283)
202         type -> btype . qtyconop type                       (rule 284)
203         type -> btype . tyvarop type                        (rule 285)
204         type -> btype . '->' ctype                          (rule 286)
205         type -> btype . SIMPLEQUOTE qconop type             (rule 287)
206         type -> btype . SIMPLEQUOTE varop type              (rule 288)
207         btype -> btype . atype                              (rule 299)
208
209     Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
210
211 Same as State 50, but minus the context productions.
212
213 -------------------------------------------------------------------------------
214
215 state 324 contains 1 shift/reduce conflicts.
216
217         tup_exprs -> commas . tup_tail                      (rule 505)
218         sysdcon_nolist -> '(' commas . ')'                  (rule 616)
219         commas -> commas . ','                              (rule 734)
220
221     Conflict: ')' (empty tup_tail reduces)
222
223 A tuple section with NO free variables '(,,)' is indistinguishable
224 from the Haskell98 data constructor for a tuple.  Shift resolves in
225 favor of sysdcon, which is good because a tuple section will get rejected
226 if -XTupleSections is not specified.
227
228 -------------------------------------------------------------------------------
229
230 state 376 contains 1 shift/reduce conflicts.
231
232         tup_exprs -> commas . tup_tail                      (rule 505)
233         sysdcon_nolist -> '(#' commas . '#)'                (rule 618)
234         commas -> commas . ','                              (rule 734)
235
236     Conflict: '#)' (empty tup_tail reduces)
237
238 Same as State 324 for unboxed tuples.
239
240 -------------------------------------------------------------------------------
241
242 state 404 contains 1 shift/reduce conflicts.
243
244         exp10 -> 'let' binds . 'in' exp                     (rule 425)
245         exp10 -> 'let' binds . 'in' error                   (rule 440)
246         exp10 -> 'let' binds . error                        (rule 441)
247     *** qual -> 'let' binds .                               (rule 579)
248
249     Conflict: error
250
251 TODO: Why?
252
253 -------------------------------------------------------------------------------
254
255 state 633 contains 1 shift/reduce conflicts.
256
257     *** aexp2 -> ipvar .                                    (rule 466)
258         dbind -> ipvar . '=' exp                            (rule 590)
259
260     Conflict: '='
261
262 Example ambiguity: 'let ?x ...'
263
264 The parser can't tell whether the ?x is the lhs of a normal binding or
265 an implicit binding.  Fortunately, resolving as shift gives it the only
266 sensible meaning, namely the lhs of an implicit binding.
267
268 -------------------------------------------------------------------------------
269
270 state 699 contains 1 shift/reduce conflicts.
271
272         rule -> STRING rule_activation . rule_forall infixexp '=' exp    (rule 215)
273
274     Conflict: 'forall' (empty rule_forall reduces)
275
276 Example ambiguity: '{-# RULES "name" forall = ... #-}'
277
278 'forall' is a valid variable name---we don't know whether
279 to treat a forall on the input as the beginning of a quantifier
280 or the beginning of the rule itself.  Resolving to shift means
281 it's always treated as a quantifier, hence the above is disallowed.
282 This saves explicitly defining a grammar for the rule lhs that
283 doesn't include 'forall'.
284
285 -------------------------------------------------------------------------------
286
287 state 950 contains 1 shift/reduce conflicts.
288
289         transformqual -> 'then' 'group' . 'using' exp       (rule 528)
290         transformqual -> 'then' 'group' . 'by' exp 'using' exp    (rule 529)
291     *** special_id -> 'group' .                             (rule 711)
292
293     Conflict: 'by'
294
295
296 -------------------------------------------------------------------------------
297 -- API Annotations
298 --
299
300 A lot of the productions are now cluttered with calls to
301 aa,am,ams,amms etc.
302
303 These are helper functions to make sure that the locations of the
304 various keywords such as do / let / in are captured for use by tools
305 that want to do source to source conversions, such as refactorers or
306 structured editors.
307
308 The helper functions are defined at the bottom of this file.
309
310 See
311   https://ghc.haskell.org/trac/ghc/wiki/ApiAnnotations and
312   https://ghc.haskell.org/trac/ghc/wiki/GhcAstAnnotations
313 for some background.
314
315 -- -----------------------------------------------------------------------------
316
317 -}
318
319 %token
320  '_'            { L _ ITunderscore }            -- Haskell keywords
321  'as'           { L _ ITas }
322  'case'         { L _ ITcase }
323  'class'        { L _ ITclass }
324  'data'         { L _ ITdata }
325  'default'      { L _ ITdefault }
326  'deriving'     { L _ ITderiving }
327  'do'           { L _ ITdo }
328  'else'         { L _ ITelse }
329  'hiding'       { L _ IThiding }
330  'if'           { L _ ITif }
331  'import'       { L _ ITimport }
332  'in'           { L _ ITin }
333  'infix'        { L _ ITinfix }
334  'infixl'       { L _ ITinfixl }
335  'infixr'       { L _ ITinfixr }
336  'instance'     { L _ ITinstance }
337  'let'          { L _ ITlet }
338  'module'       { L _ ITmodule }
339  'newtype'      { L _ ITnewtype }
340  'of'           { L _ ITof }
341  'qualified'    { L _ ITqualified }
342  'then'         { L _ ITthen }
343  'type'         { L _ ITtype }
344  'where'        { L _ ITwhere }
345
346  'forall'       { L _ ITforall }                -- GHC extension keywords
347  'foreign'      { L _ ITforeign }
348  'export'       { L _ ITexport }
349  'label'        { L _ ITlabel }
350  'dynamic'      { L _ ITdynamic }
351  'safe'         { L _ ITsafe }
352  'interruptible' { L _ ITinterruptible }
353  'unsafe'       { L _ ITunsafe }
354  'mdo'          { L _ ITmdo }
355  'family'       { L _ ITfamily }
356  'role'         { L _ ITrole }
357  'stdcall'      { L _ ITstdcallconv }
358  'ccall'        { L _ ITccallconv }
359  'capi'         { L _ ITcapiconv }
360  'prim'         { L _ ITprimcallconv }
361  'javascript'   { L _ ITjavascriptcallconv }
362  'proc'         { L _ ITproc }          -- for arrow notation extension
363  'rec'          { L _ ITrec }           -- for arrow notation extension
364  'group'    { L _ ITgroup }     -- for list transform extension
365  'by'       { L _ ITby }        -- for list transform extension
366  'using'    { L _ ITusing }     -- for list transform extension
367  'pattern'      { L _ ITpattern } -- for pattern synonyms
368  'static'       { L _ ITstatic }  -- for static pointers extension
369
370  '{-# INLINE'             { L _ (ITinline_prag _ _ _) }
371  '{-# SPECIALISE'         { L _ (ITspec_prag _) }
372  '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _ _) }
373  '{-# SOURCE'             { L _ (ITsource_prag _) }
374  '{-# RULES'              { L _ (ITrules_prag _) }
375  '{-# CORE'               { L _ (ITcore_prag _) }      -- hdaume: annotated core
376  '{-# SCC'                { L _ (ITscc_prag _)}
377  '{-# GENERATED'          { L _ (ITgenerated_prag _) }
378  '{-# DEPRECATED'         { L _ (ITdeprecated_prag _) }
379  '{-# WARNING'            { L _ (ITwarning_prag _) }
380  '{-# UNPACK'             { L _ (ITunpack_prag _) }
381  '{-# NOUNPACK'           { L _ (ITnounpack_prag _) }
382  '{-# ANN'                { L _ (ITann_prag _) }
383  '{-# VECTORISE'          { L _ (ITvect_prag _) }
384  '{-# VECTORISE_SCALAR'   { L _ (ITvect_scalar_prag _) }
385  '{-# NOVECTORISE'        { L _ (ITnovect_prag _) }
386  '{-# MINIMAL'            { L _ (ITminimal_prag _) }
387  '{-# CTYPE'              { L _ (ITctype _) }
388  '{-# OVERLAPPING'        { L _ (IToverlapping_prag _) }
389  '{-# OVERLAPPABLE'       { L _ (IToverlappable_prag _) }
390  '{-# OVERLAPS'           { L _ (IToverlaps_prag _) }
391  '{-# INCOHERENT'         { L _ (ITincoherent_prag _) }
392  '#-}'                    { L _ ITclose_prag }
393
394  '..'           { L _ ITdotdot }                        -- reserved symbols
395  ':'            { L _ ITcolon }
396  '::'           { L _ ITdcolon }
397  '='            { L _ ITequal }
398  '\\'           { L _ ITlam }
399  'lcase'        { L _ ITlcase }
400  '|'            { L _ ITvbar }
401  '<-'           { L _ ITlarrow }
402  '->'           { L _ ITrarrow }
403  '@'            { L _ ITat }
404  '~'            { L _ ITtilde }
405  '~#'           { L _ ITtildehsh }
406  '=>'           { L _ ITdarrow }
407  '-'            { L _ ITminus }
408  '!'            { L _ ITbang }
409  '*'            { L _ ITstar }
410  '-<'           { L _ ITlarrowtail }            -- for arrow notation
411  '>-'           { L _ ITrarrowtail }            -- for arrow notation
412  '-<<'          { L _ ITLarrowtail }            -- for arrow notation
413  '>>-'          { L _ ITRarrowtail }            -- for arrow notation
414  '.'            { L _ ITdot }
415
416  '{'            { L _ ITocurly }                        -- special symbols
417  '}'            { L _ ITccurly }
418  vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
419  vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
420  '['            { L _ ITobrack }
421  ']'            { L _ ITcbrack }
422  '[:'           { L _ ITopabrack }
423  ':]'           { L _ ITcpabrack }
424  '('            { L _ IToparen }
425  ')'            { L _ ITcparen }
426  '(#'           { L _ IToubxparen }
427  '#)'           { L _ ITcubxparen }
428  '(|'           { L _ IToparenbar }
429  '|)'           { L _ ITcparenbar }
430  ';'            { L _ ITsemi }
431  ','            { L _ ITcomma }
432  '`'            { L _ ITbackquote }
433  SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x
434
435  VARID          { L _ (ITvarid    _) }          -- identifiers
436  CONID          { L _ (ITconid    _) }
437  VARSYM         { L _ (ITvarsym   _) }
438  CONSYM         { L _ (ITconsym   _) }
439  QVARID         { L _ (ITqvarid   _) }
440  QCONID         { L _ (ITqconid   _) }
441  QVARSYM        { L _ (ITqvarsym  _) }
442  QCONSYM        { L _ (ITqconsym  _) }
443
444  IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
445
446  CHAR           { L _ (ITchar   _ _) }
447  STRING         { L _ (ITstring _ _) }
448  INTEGER        { L _ (ITinteger _ _) }
449  RATIONAL       { L _ (ITrational _) }
450
451  PRIMCHAR       { L _ (ITprimchar   _ _) }
452  PRIMSTRING     { L _ (ITprimstring _ _) }
453  PRIMINTEGER    { L _ (ITprimint    _ _) }
454  PRIMWORD       { L _ (ITprimword   _ _) }
455  PRIMFLOAT      { L _ (ITprimfloat  _) }
456  PRIMDOUBLE     { L _ (ITprimdouble _) }
457
458  DOCNEXT        { L _ (ITdocCommentNext _) }
459  DOCPREV        { L _ (ITdocCommentPrev _) }
460  DOCNAMED       { L _ (ITdocCommentNamed _) }
461  DOCSECTION     { L _ (ITdocSection _ _) }
462
463 -- Template Haskell
464 '[|'            { L _ ITopenExpQuote  }
465 '[p|'           { L _ ITopenPatQuote  }
466 '[t|'           { L _ ITopenTypQuote  }
467 '[d|'           { L _ ITopenDecQuote  }
468 '|]'            { L _ ITcloseQuote    }
469 '[||'           { L _ ITopenTExpQuote   }
470 '||]'           { L _ ITcloseTExpQuote  }
471 TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
472 '$('            { L _ ITparenEscape   }     -- $( exp )
473 TH_ID_TY_SPLICE { L _ (ITidTyEscape _)  }   -- $$x
474 '$$('           { L _ ITparenTyEscape   }   -- $$( exp )
475 TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
476 TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
477 TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
478
479 %monad { P } { >>= } { return }
480 %lexer { (lexer True) } { L _ ITeof }
481 %tokentype { (Located Token) }
482
483 -- Exported parsers
484 %name parseModule module
485 %name parseImport importdecl
486 %name parseStatement stmt
487 %name parseDeclaration topdecl
488 %name parseExpression exp
489 %name parsePattern pat
490 %name parseTypeSignature sigdecl
491 %name parseStmt   maybe_stmt
492 %name parseIdentifier  identifier
493 %name parseType ctype
494 %partial parseHeader header
495 %%
496
497 -----------------------------------------------------------------------------
498 -- Identifiers; one of the entry points
499 identifier :: { Located RdrName }
500         : qvar                          { $1 }
501         | qcon                          { $1 }
502         | qvarop                        { $1 }
503         | qconop                        { $1 }
504     | '(' '->' ')'      {% ams (sLL $1 $> $ getRdrName funTyCon)
505                                [mj AnnOpenP $1,mj AnnRarrow $2,mj AnnCloseP $3] }
506
507 -----------------------------------------------------------------------------
508 -- Module Header
509
510 -- The place for module deprecation is really too restrictive, but if it
511 -- was allowed at its natural place just before 'module', we get an ugly
512 -- s/r conflict with the second alternative. Another solution would be the
513 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
514 -- either, and DEPRECATED is only expected to be used by people who really
515 -- know what they are doing. :-)
516
517 module :: { Located (HsModule RdrName) }
518        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
519              {% fileSrcSpan >>= \ loc ->
520                 ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
521                               (snd $ snd $7) $4 $1)
522                     )
523                     ([mj AnnModule $2, mj AnnWhere $6] ++ fst $7) }
524         | body2
525                 {% fileSrcSpan >>= \ loc ->
526                    ams (L loc (HsModule Nothing Nothing
527                                (fst $ snd $1) (snd $ snd $1) Nothing Nothing))
528                        (fst $1) }
529
530 maybedocheader :: { Maybe LHsDocString }
531         : moduleheader            { $1 }
532         | {- empty -}             { Nothing }
533
534 missing_module_keyword :: { () }
535         : {- empty -}                           {% pushCurrentContext }
536
537 maybemodwarning :: { Maybe (Located WarningTxt) }
538     : '{-# DEPRECATED' strings '#-}'
539                       {% ajs (Just (sLL $1 $> $ DeprecatedTxt (sL1 $1 (getDEPRECATED_PRAGs $1)) (snd $ unLoc $2)))
540                              (mo $1:mc $3: (fst $ unLoc $2)) }
541     | '{-# WARNING' strings '#-}'
542                          {% ajs (Just (sLL $1 $> $ WarningTxt (sL1 $1 (getWARNING_PRAGs $1)) (snd $ unLoc $2)))
543                                 (mo $1:mc $3 : (fst $ unLoc $2)) }
544     |  {- empty -}                  { Nothing }
545
546 body    :: { ([AddAnn]
547              ,([LImportDecl RdrName], [LHsDecl RdrName])) }
548         :  '{'            top '}'      { (moc $1:mcc $3:(fst $2)
549                                          , snd $2) }
550         |      vocurly    top close    { (fst $2, snd $2) }
551
552 body2   :: { ([AddAnn]
553              ,([LImportDecl RdrName], [LHsDecl RdrName])) }
554         :  '{' top '}'                          { (moc $1:mcc $3
555                                                    :(fst $2), snd $2) }
556         |  missing_module_keyword top close     { ([],snd $2) }
557
558 top     :: { ([AddAnn]
559              ,([LImportDecl RdrName], [LHsDecl RdrName])) }
560         : importdecls                   { (fst $1
561                                           ,(reverse $ snd $1,[]))}
562         | importdecls ';' cvtopdecls    {% if null (snd $1)
563                                              then return ((mj AnnSemi $2:(fst $1))
564                                                          ,(reverse $ snd $1,$3))
565                                              else do
566                                               { addAnnotation (gl $ head $ snd $1)
567                                                               AnnSemi (gl $2)
568                                               ; return (fst $1
569                                                        ,(reverse $ snd $1,$3)) }}
570         | cvtopdecls                    { ([],([],$1)) }
571
572 cvtopdecls :: { [LHsDecl RdrName] }
573         : topdecls                              { cvTopDecls $1 }
574
575 -----------------------------------------------------------------------------
576 -- Module declaration & imports only
577
578 header  :: { Located (HsModule RdrName) }
579         : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
580                 {% fileSrcSpan >>= \ loc ->
581                    ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
582                           )) [mj AnnModule $2,mj AnnWhere $6] }
583         | header_body2
584                 {% fileSrcSpan >>= \ loc ->
585                    return (L loc (HsModule Nothing Nothing $1 [] Nothing
586                           Nothing)) }
587
588 header_body :: { [LImportDecl RdrName] }
589         :  '{'            importdecls           { snd $2 }
590         |      vocurly    importdecls           { snd $2 }
591
592 header_body2 :: { [LImportDecl RdrName] }
593         :  '{' importdecls                      { snd $2 }
594         |  missing_module_keyword importdecls   { snd $2 }
595
596 -----------------------------------------------------------------------------
597 -- The Export List
598
599 maybeexports :: { (Maybe (Located [LIE RdrName])) }
600         :  '(' exportlist ')'       {% ams (sLL $1 $> ()) [mop $1,mcp $3] >>
601                                        return (Just (sLL $1 $> (fromOL $2))) }
602         |  {- empty -}              { Nothing }
603
604 exportlist :: { OrdList (LIE RdrName) }
605         : expdoclist ',' expdoclist   {% addAnnotation (oll $1) AnnComma (gl $2)
606                                          >> return ($1 `appOL` $3) }
607         | exportlist1                 { $1 }
608
609 exportlist1 :: { OrdList (LIE RdrName) }
610         : expdoclist export expdoclist ',' exportlist1
611                           {% (addAnnotation (oll ($1 `appOL` $2 `appOL` $3))
612                                             AnnComma (gl $4) ) >>
613                               return ($1 `appOL` $2 `appOL` $3 `appOL` $5) }
614         | expdoclist export expdoclist             { $1 `appOL` $2 `appOL` $3 }
615         | expdoclist                               { $1 }
616
617 expdoclist :: { OrdList (LIE RdrName) }
618         : exp_doc expdoclist                           { $1 `appOL` $2 }
619         | {- empty -}                                  { nilOL }
620
621 exp_doc :: { OrdList (LIE RdrName) }
622         : docsection    { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup n doc)) }
623         | docnamed      { unitOL (sL1 $1 (IEDocNamed ((fst . unLoc) $1))) }
624         | docnext       { unitOL (sL1 $1 (IEDoc (unLoc $1))) }
625
626
627    -- No longer allow things like [] and (,,,) to be exported
628    -- They are built in syntax, always available
629 export  :: { OrdList (LIE RdrName) }
630         : qcname_ext export_subspec  {% amsu (sLL $1 $> (mkModuleImpExp $1
631                                                     (snd $ unLoc $2)))
632                                              (fst $ unLoc $2) }
633         |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents $2))
634                                              [mj AnnModule $1] }
635         |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar $2))
636                                              [mj AnnPattern $1] }
637
638 export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
639         : {- empty -}             { sL0 ([],ImpExpAbs) }
640         | '(' '..' ')'            { sLL $1 $> ([mop $1,mcp $3,mj AnnDotdot $2]
641                                        , ImpExpAll) }
642         | '(' ')'                 { sLL $1 $> ([mop $1,mcp $2],ImpExpList []) }
643         | '(' qcnames ')'         { sLL $1 $> ([mop $1,mcp $3],ImpExpList (reverse $2)) }
644
645 qcnames :: { [Located RdrName] }     -- A reversed list
646         :  qcnames ',' qcname_ext       {% (aa (head $1) (AnnComma, $2)) >>
647                                            return ($3  : $1) }
648         |  qcname_ext                   { [$1]  }
649
650 qcname_ext :: { Located RdrName }       -- Variable or data constructor
651                                         -- or tagged type constructor
652         :  qcname                   { $1 }
653         |  'type' oqtycon           {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
654                                             [mj AnnType $1,mj AnnVal $2] }
655
656 qcname  :: { Located RdrName }  -- Variable or type constructor
657         :  qvar                 { $1 }
658         |  oqtycon_no_varcon    { $1 } -- see Note [Type constructors in export list]
659
660 -----------------------------------------------------------------------------
661 -- Import Declarations
662
663 -- import decls can be *empty*, or even just a string of semicolons
664 -- whereas topdecls must contain at least one topdecl.
665
666 importdecls :: { ([AddAnn],[LImportDecl RdrName]) }
667         : importdecls ';' importdecl
668                                 {% if null (snd $1)
669                                      then return (mj AnnSemi $2:fst $1,$3 : snd $1)
670                                      else do
671                                       { addAnnotation (gl $ head $ snd $1)
672                                                       AnnSemi (gl $2)
673                                       ; return (fst $1,$3 : snd $1) } }
674         | importdecls ';'       {% if null (snd $1)
675                                      then return ((mj AnnSemi $2:fst $1),snd $1)
676                                      else do
677                                        { addAnnotation (gl $ head $ snd $1)
678                                                        AnnSemi (gl $2)
679                                        ; return $1} }
680         | importdecl             { ([],[$1]) }
681         | {- empty -}            { ([],[]) }
682
683 importdecl :: { LImportDecl RdrName }
684         : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
685                 {% ams (L (comb4 $1 $6 (snd $7) $8) $
686                   ImportDecl { ideclSourceSrc = snd $ fst $2
687                              , ideclName = $6, ideclPkgQual = snd $5
688                              , ideclSource = snd $2, ideclSafe = snd $3
689                              , ideclQualified = snd $4, ideclImplicit = False
690                              , ideclAs = unLoc (snd $7)
691                              , ideclHiding = unLoc $8 })
692                    ((mj AnnImport $1 : (fst $ fst $2) ++ fst $3 ++ fst $4
693                                     ++ fst $5 ++ fst $7)) }
694
695 maybe_src :: { (([AddAnn],Maybe SourceText),IsBootInterface) }
696         : '{-# SOURCE' '#-}'        { (([mo $1,mc $2],Just (getSOURCE_PRAGs $1))
697                                       ,True) }
698         | {- empty -}               { (([],Nothing),False) }
699
700 maybe_safe :: { ([AddAnn],Bool) }
701         : 'safe'                                { ([mj AnnSafe $1],True) }
702         | {- empty -}                           { ([],False) }
703
704 maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
705         : STRING  {% let pkgFS = getSTRING $1 in
706                      if looksLikePackageName (unpackFS pkgFS)
707                         then return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS))
708                         else parseErrorSDoc (getLoc $1) $ vcat [
709                              text "parse error" <> colon <+> quotes (ppr pkgFS),
710                              text "Version number or non-alphanumeric" <+>
711                              text "character in package name"] }
712         | {- empty -}                           { ([],Nothing) }
713
714 optqualified :: { ([AddAnn],Bool) }
715         : 'qualified'                           { ([mj AnnQualified $1],True)  }
716         | {- empty -}                           { ([],False) }
717
718 maybeas :: { ([AddAnn],Located (Maybe ModuleName)) }
719         : 'as' modid                           { ([mj AnnAs $1,mj AnnVal $2]
720                                                  ,sLL $1 $> (Just (unLoc $2))) }
721         | {- empty -}                          { ([],noLoc Nothing) }
722
723 maybeimpspec :: { Located (Maybe (Bool, Located [LIE RdrName])) }
724         : impspec                  { L (gl $1) (Just (unLoc $1)) }
725         | {- empty -}              { noLoc Nothing }
726
727 impspec :: { Located (Bool, Located [LIE RdrName]) }
728         :  '(' exportlist ')'               {% ams (sLL $1 $> (False,
729                                                       sLL $1 $> $ fromOL $2))
730                                                    [mop $1,mcp $3] }
731         |  'hiding' '(' exportlist ')'      {% ams (sLL $1 $> (True,
732                                                       sLL $1 $> $ fromOL $3))
733                                                [mj AnnHiding $1,mop $2,mcp $4] }
734
735 -----------------------------------------------------------------------------
736 -- Fixity Declarations
737
738 prec    :: { Located Int }
739         : {- empty -}           { noLoc 9 }
740         | INTEGER
741                  {% checkPrecP (sL1 $1 (fromInteger (getINTEGER $1))) }
742
743 infix   :: { Located FixityDirection }
744         : 'infix'                               { sL1 $1 InfixN  }
745         | 'infixl'                              { sL1 $1 InfixL  }
746         | 'infixr'                              { sL1 $1 InfixR }
747
748 ops     :: { Located (OrdList (Located RdrName)) }
749         : ops ',' op       {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
750                               return (sLL $1 $> ((unLoc $1) `appOL` unitOL $3))}
751         | op               { sL1 $1 (unitOL $1) }
752
753 -----------------------------------------------------------------------------
754 -- Top-Level Declarations
755
756 topdecls :: { OrdList (LHsDecl RdrName) }
757         : topdecls ';' topdecl        {% addAnnotation (oll $1) AnnSemi (gl $2)
758                                          >> return ($1 `appOL` unitOL $3) }
759         | topdecls ';'                {% addAnnotation (oll $1) AnnSemi (gl $2)
760                                          >> return $1 }
761         | topdecl                     { unitOL $1 }
762
763 topdecl :: { LHsDecl RdrName }
764         : cl_decl                               { sL1 $1 (TyClD (unLoc $1)) }
765         | ty_decl                               { sL1 $1 (TyClD (unLoc $1)) }
766         | inst_decl                             { sL1 $1 (InstD (unLoc $1)) }
767         | stand_alone_deriving                  { sLL $1 $> (DerivD (unLoc $1)) }
768         | role_annot                            { sL1 $1 (RoleAnnotD (unLoc $1)) }
769         | 'default' '(' comma_types0 ')'    {% ams (sLL $1 $> (DefD (DefaultDecl $3)))
770                                                          [mj AnnDefault $1
771                                                          ,mop $2,mcp $4] }
772         | 'foreign' fdecl          {% ams (sLL $1 $> (snd $ unLoc $2))
773                                            (mj AnnForeign $1:(fst $ unLoc $2)) }
774         | '{-# DEPRECATED' deprecations '#-}'   {% ams (sLL $1 $> $ WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2)))
775                                                        [mo $1,mc $3] }
776         | '{-# WARNING' warnings '#-}'          {% ams (sLL $1 $> $ WarningD (Warnings (getWARNING_PRAGs $1) (fromOL $2)))
777                                                        [mo $1,mc $3] }
778         | '{-# RULES' rules '#-}'               {% ams (sLL $1 $> $ RuleD (HsRules (getRULES_PRAGs $1) (fromOL $2)))
779                                                        [mo $1,mc $3] }
780         | '{-# VECTORISE' qvar '=' exp '#-}' {% ams (sLL $1 $> $ VectD (HsVect (getVECT_PRAGs $1) $2 $4))
781                                                     [mo $1,mj AnnEqual $3
782                                                     ,mc $5] }
783         | '{-# NOVECTORISE' qvar '#-}'       {% ams (sLL $1 $> $ VectD (HsNoVect (getNOVECT_PRAGs $1) $2))
784                                                      [mo $1,mc $3] }
785         | '{-# VECTORISE' 'type' gtycon '#-}'
786                                 {% ams (sLL $1 $> $
787                                     VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 Nothing))
788                                     [mo $1,mj AnnType $2,mc $4] }
789
790         | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
791                                 {% ams (sLL $1 $> $
792                                     VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 Nothing))
793                                     [mo $1,mj AnnType $2,mc $4] }
794
795         | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
796                                 {% ams (sLL $1 $> $
797                                     VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 (Just $5)))
798                                     [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
799         | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
800                                 {% ams (sLL $1 $> $
801                                     VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 (Just $5)))
802                                     [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
803
804         | '{-# VECTORISE' 'class' gtycon '#-}'
805                                          {% ams (sLL $1 $>  $ VectD (HsVectClassIn (getVECT_PRAGs $1) $3))
806                                                  [mo $1,mj AnnClass $2,mc $4] }
807         | annotation { $1 }
808         | decl_no_th                            { $1 }
809
810         -- Template Haskell Extension
811         -- The $(..) form is one possible form of infixexp
812         -- but we treat an arbitrary expression just as if
813         -- it had a $(..) wrapped around it
814         | infixexp                              { sLL $1 $> $ mkSpliceDecl $1 }
815
816 -- Type classes
817 --
818 cl_decl :: { LTyClDecl RdrName }
819         : 'class' tycl_hdr fds where_cls
820                 {% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))
821                         (mj AnnClass $1:(fst $ unLoc $3)++(fst $ unLoc $4)) }
822
823 -- Type declarations (toplevel)
824 --
825 ty_decl :: { LTyClDecl RdrName }
826            -- ordinary type synonyms
827         : 'type' type '=' ctypedoc
828                 -- Note ctype, not sigtype, on the right of '='
829                 -- We allow an explicit for-all but we don't insert one
830                 -- in   type Foo a = (b,b)
831                 -- Instead we just say b is out of scope
832                 --
833                 -- Note the use of type for the head; this allows
834                 -- infix type constructors to be declared
835                 {% amms (mkTySynonym (comb2 $1 $4) $2 $4)
836                         [mj AnnType $1,mj AnnEqual $3] }
837
838            -- type family declarations
839         | 'type' 'family' type opt_kind_sig where_type_family
840                 -- Note the use of type for the head; this allows
841                 -- infix type constructors to be declared
842                 {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $5) $3
843                                    (snd $ unLoc $4))
844                         (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)++(fst $ unLoc $5)) }
845
846           -- ordinary data type or newtype declaration
847         | data_or_newtype capi_ctype tycl_hdr constrs deriving
848                 {% amms (mkTyData (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
849                            Nothing (reverse (snd $ unLoc $4))
850                                    (unLoc $5))
851                                    -- We need the location on tycl_hdr in case
852                                    -- constrs and deriving are both empty
853                         ((fst $ unLoc $1):(fst $ unLoc $4)) }
854
855           -- ordinary GADT declaration
856         | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
857                  gadt_constrlist
858                  deriving
859             {% amms (mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
860                             (snd $ unLoc $4) (snd $ unLoc $5) (unLoc $6) )
861                                    -- We need the location on tycl_hdr in case
862                                    -- constrs and deriving are both empty
863                     ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
864
865           -- data/newtype family
866         | 'data' 'family' type opt_kind_sig
867                 {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (snd $ unLoc $4))
868                         (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
869
870 inst_decl :: { LInstDecl RdrName }
871         : 'instance' overlap_pragma inst_type where_inst
872        {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
873              ; let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
874                                      , cid_sigs = sigs, cid_tyfam_insts = ats
875                                      , cid_overlap_mode = $2
876                                      , cid_datafam_insts = adts }
877              ; ams (L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid }))
878                    (mj AnnInstance $1 : (fst $ unLoc $4)) } }
879
880            -- type instance declarations
881         | 'type' 'instance' ty_fam_inst_eqn
882                 {% ams $3 (fst $ unLoc $3)
883                 >> amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
884                     (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
885
886           -- data/newtype instance declaration
887         | data_or_newtype 'instance' capi_ctype tycl_hdr constrs deriving
888             {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 $4
889                                       Nothing (reverse (snd  $ unLoc $5))
890                                               (unLoc $6))
891                     ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) }
892
893           -- GADT instance declaration
894         | data_or_newtype 'instance' capi_ctype tycl_hdr opt_kind_sig
895                  gadt_constrlist
896                  deriving
897             {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 $4
898                                    (snd $ unLoc $5) (snd $ unLoc $6) (unLoc $7))
899                     ((fst $ unLoc $1):mj AnnInstance $2
900                        :(fst $ unLoc $5)++(fst $ unLoc $6)) }
901
902 overlap_pragma :: { Maybe (Located OverlapMode) }
903   : '{-# OVERLAPPABLE'    '#-}' {% ajs (Just (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))))
904                                        [mo $1,mc $2] }
905   | '{-# OVERLAPPING'     '#-}' {% ajs (Just (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1))))
906                                        [mo $1,mc $2] }
907   | '{-# OVERLAPS'        '#-}' {% ajs (Just (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1))))
908                                        [mo $1,mc $2] }
909   | '{-# INCOHERENT'      '#-}' {% ajs (Just (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1))))
910                                        [mo $1,mc $2] }
911   | {- empty -}                 { Nothing }
912
913
914 -- Closed type families
915
916 where_type_family :: { Located ([AddAnn],FamilyInfo RdrName) }
917         : {- empty -}                      { noLoc ([],OpenTypeFamily) }
918         | 'where' ty_fam_inst_eqn_list
919                { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
920                     ,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }
921
922 ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn RdrName]) }
923         :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ([moc $1,mcc $3]
924                                                 ,Just (unLoc $2)) }
925         | vocurly ty_fam_inst_eqns close   { let L loc _ = $2 in
926                                              L loc ([],Just (unLoc $2)) }
927         |     '{' '..' '}'                 { sLL $1 $> ([moc $1,mj AnnDotdot $2
928                                                  ,mcc $3],Nothing) }
929         | vocurly '..' close               { let L loc _ = $2 in
930                                              L loc ([mj AnnDotdot $2],Nothing) }
931
932 ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
933         : ty_fam_inst_eqns ';' ty_fam_inst_eqn
934                                       {% asl (unLoc $1) $2 (snd $ unLoc $3)
935                                          >> ams $3 (fst $ unLoc $3)
936                                          >> return (sLL $1 $> ((snd $ unLoc $3) : unLoc $1)) }
937         | ty_fam_inst_eqns ';'        {% addAnnotation (gl $1) AnnSemi (gl $2)
938                                          >> return (sLL $1 $>  (unLoc $1)) }
939         | ty_fam_inst_eqn             {% ams $1 (fst $ unLoc $1)
940                                          >> return (sLL $1 $> [snd $ unLoc $1]) }
941         | {- empty -}                 { noLoc [] }
942
943 ty_fam_inst_eqn :: { Located ([AddAnn],LTyFamInstEqn RdrName) }
944         : type '=' ctype
945                 -- Note the use of type for the head; this allows
946                 -- infix type constructors and type patterns
947               {% do { (eqn,ann) <- mkTyFamInstEqn $1 $3
948                     ; return (sLL $1 $> (mj AnnEqual $2:ann, sLL $1 $> eqn))  } }
949
950 -- Associated type family declarations
951 --
952 -- * They have a different syntax than on the toplevel (no family special
953 --   identifier).
954 --
955 -- * They also need to be separate from instances; otherwise, data family
956 --   declarations without a kind signature cause parsing conflicts with empty
957 --   data declarations.
958 --
959 at_decl_cls :: { LHsDecl RdrName }
960         :  -- data family declarations, with optional 'family' keyword
961           'data' opt_family type opt_kind_sig
962                 {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
963                                                   (snd $ unLoc $4)))
964                         (mj AnnData $1:$2++(fst $ unLoc $4)) }
965
966            -- type family declarations, with optional 'family' keyword
967            -- (can't use opt_instance because you get shift/reduce errors
968         | 'type' type opt_kind_sig
969                {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $2 $3)
970                                                   OpenTypeFamily $2 (snd $ unLoc $3)))
971                        (mj AnnType $1:(fst $ unLoc $3)) }
972         | 'type' 'family' type opt_kind_sig
973                {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4)
974                                                   OpenTypeFamily $3 (snd $ unLoc $4)))
975                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)) }
976
977            -- default type instances, with optional 'instance' keyword
978         | 'type' ty_fam_inst_eqn
979                 {% ams $2 (fst $ unLoc $2) >>
980                    amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2)))
981                         (mj AnnType $1:(fst $ unLoc $2)) }
982         | 'type' 'instance' ty_fam_inst_eqn
983                 {% ams $3 (fst $ unLoc $3) >>
984                    amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3)))
985                         (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
986
987 opt_family   :: { [AddAnn] }
988               : {- empty -}   { [] }
989               | 'family'      { [mj AnnFamily $1] }
990
991 -- Associated type instances
992 --
993 at_decl_inst :: { LInstDecl RdrName }
994            -- type instance declarations
995         : 'type' ty_fam_inst_eqn
996                 -- Note the use of type for the head; this allows
997                 -- infix type constructors and type patterns
998                 {% ams $2 (fst $ unLoc $2) >>
999                    amms (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2))
1000                         (mj AnnType $1:(fst $ unLoc $2)) }
1001
1002         -- data/newtype instance declaration
1003         | data_or_newtype capi_ctype tycl_hdr constrs deriving
1004                {% amms (mkDataFamInst (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
1005                                     Nothing (reverse (snd $ unLoc $4))
1006                                             (unLoc $5))
1007                        ((fst $ unLoc $1):(fst $ unLoc $4)) }
1008
1009         -- GADT instance declaration
1010         | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
1011                  gadt_constrlist
1012                  deriving
1013                 {% amms (mkDataFamInst (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2
1014                                 $3 (snd $ unLoc $4) (snd $ unLoc $5) (unLoc $6))
1015                         ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
1016
1017 data_or_newtype :: { Located (AddAnn,NewOrData) }
1018         : 'data'        { sL1 $1 (mj AnnData    $1,DataType) }
1019         | 'newtype'     { sL1 $1 (mj AnnNewtype $1,NewType) }
1020
1021 opt_kind_sig :: { Located ([AddAnn],Maybe (LHsKind RdrName)) }
1022         :                             { noLoc ([],Nothing) }
1023         | '::' kind                   { sLL $1 $> ([mj AnnDcolon $1],Just ($2)) }
1024
1025 -- tycl_hdr parses the header of a class or data type decl,
1026 -- which takes the form
1027 --      T a b
1028 --      Eq a => T a
1029 --      (Eq a, Ord b) => T a b
1030 --      T Int [a]                       -- for associated types
1031 -- Rather a lot of inlining here, else we get reduce/reduce errors
1032 tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
1033         : context '=>' type         {% addAnnotation (gl $1) AnnDarrow (gl $2)
1034                                        >> (return (sLL $1 $> (Just $1, $3)))
1035                                     }
1036         | type                      { sL1 $1 (Nothing, $1) }
1037
1038 capi_ctype :: { Maybe (Located CType) }
1039 capi_ctype : '{-# CTYPE' STRING STRING '#-}'
1040                        {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))
1041                                         (getSTRINGs $3,getSTRING $3))))
1042                               [mo $1,mj AnnHeader $2,mj AnnVal $3,mc $4] }
1043
1044            | '{-# CTYPE'        STRING '#-}'
1045                        {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) Nothing  (getSTRINGs $2, getSTRING $2))))
1046                               [mo $1,mj AnnVal $2,mc $3] }
1047
1048            |           { Nothing }
1049
1050 -----------------------------------------------------------------------------
1051 -- Stand-alone deriving
1052
1053 -- Glasgow extension: stand-alone deriving declarations
1054 stand_alone_deriving :: { LDerivDecl RdrName }
1055   : 'deriving' 'instance' overlap_pragma inst_type
1056                          {% do {
1057                                  let err = text "in the stand-alone deriving instance"
1058                                             <> colon <+> quotes (ppr $4)
1059                                ; ams (sLL $1 $> (DerivDecl $4 $3))
1060                                      [mj AnnDeriving $1,mj AnnInstance $2] }}
1061
1062 -----------------------------------------------------------------------------
1063 -- Role annotations
1064
1065 role_annot :: { LRoleAnnotDecl RdrName }
1066 role_annot : 'type' 'role' oqtycon maybe_roles
1067           {% amms (mkRoleAnnotDecl (comb3 $1 $3 $4) $3 (reverse (unLoc $4)))
1068                   [mj AnnType $1,mj AnnRole $2] }
1069
1070 -- Reversed!
1071 maybe_roles :: { Located [Located (Maybe FastString)] }
1072 maybe_roles : {- empty -}    { noLoc [] }
1073             | roles          { $1 }
1074
1075 roles :: { Located [Located (Maybe FastString)] }
1076 roles : role             { sLL $1 $> [$1] }
1077       | roles role       { sLL $1 $> $ $2 : unLoc $1 }
1078
1079 -- read it in as a varid for better error messages
1080 role :: { Located (Maybe FastString) }
1081 role : VARID             { sL1 $1 $ Just $ getVARID $1 }
1082      | '_'               { sL1 $1 Nothing }
1083
1084 -- Pattern synonyms
1085
1086 -- Glasgow extension: pattern synonyms
1087 pattern_synonym_decl :: { LHsDecl RdrName }
1088         : 'pattern' pattern_synonym_lhs '=' pat
1089          {%ams ( let (name, args) = $2
1090                  in sLL $1 $> . ValD $ mkPatSynBind name args $4
1091                                                     ImplicitBidirectional)
1092                [mj AnnPattern $1,mj AnnEqual $3]
1093          }
1094         | 'pattern' pattern_synonym_lhs '<-' pat
1095          {%ams (let (name, args) = $2
1096                 in sLL $1 $> . ValD $ mkPatSynBind name args $4 Unidirectional)
1097                [mj AnnPattern $1,mj AnnLarrow $3] }
1098         | 'pattern' pattern_synonym_lhs '<-' pat where_decls
1099             {% do { let (name, args) = $2
1100                   ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
1101                   ; ams (sLL $1 $> . ValD $
1102                            mkPatSynBind name args $4 (ExplicitBidirectional mg))
1103                         (mj AnnPattern $1:mj AnnLarrow $3:(fst $ unLoc $5))
1104                    }}
1105
1106 pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName)) }
1107         : con vars0 { ($1, PrefixPatSyn $2) }
1108         | varid consym varid { ($2, InfixPatSyn $1 $3) }
1109
1110 vars0 :: { [Located RdrName] }
1111         : {- empty -}                 { [] }
1112         | varid vars0                 { $1 : $2 }
1113
1114 where_decls :: { Located ([AddAnn]
1115                          , Located (OrdList (LHsDecl RdrName))) }
1116         : 'where' '{' decls '}'       { sLL $1 $> ((mj AnnWhere $1:moc $2
1117                                            :mcc $4:(fst $ unLoc $3)),sL1 $3 (snd $ unLoc $3)) }
1118         | 'where' vocurly decls close { L (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
1119                                           ,sL1 $3 (snd $ unLoc $3)) }
1120 pattern_synonym_sig :: { LSig RdrName }
1121         : 'pattern' con '::' ptype
1122             {% do { let (flag, qtvs, prov, req, ty) = snd $ unLoc $4
1123                   ; let sig = PatSynSig $2 (flag, mkHsQTvs qtvs) prov req ty
1124                   ; ams (sLL $1 $> $ sig)
1125                         (mj AnnPattern $1:mj AnnDcolon $3:(fst $ unLoc $4)) } }
1126
1127 ptype :: { Located ([AddAnn]
1128                   ,( HsExplicitFlag, [LHsTyVarBndr RdrName], LHsContext RdrName
1129                    , LHsContext RdrName, LHsType RdrName)) }
1130         : 'forall' tv_bndrs '.' ptype
1131             {% do { hintExplicitForall (getLoc $1)
1132                   ; let (_, qtvs', prov, req, ty) = snd $ unLoc $4
1133                   ; return $ sLL $1 $>
1134                                 ((mj AnnForall $1:mj AnnDot $3:(fst $ unLoc $4))
1135                                 ,(Explicit, $2 ++ qtvs', prov, req ,ty)) }}
1136         | context '=>' context '=>' type
1137             { sLL $1 $> ([mj AnnDarrow $2,mj AnnDarrow $4]
1138                         ,(Implicit, [], $1, $3, $5)) }
1139         | context '=>' type
1140             { sLL $1 $> ([mj AnnDarrow $2],(Implicit, [], $1, noLoc [], $3)) }
1141         | type
1142             { sL1 $1 ([],(Implicit, [], noLoc [], noLoc [], $1)) }
1143
1144 -----------------------------------------------------------------------------
1145 -- Nested declarations
1146
1147 -- Declaration in class bodies
1148 --
1149 decl_cls  :: { LHsDecl RdrName }
1150 decl_cls  : at_decl_cls                 { $1 }
1151           | decl                        { $1 }
1152
1153           -- A 'default' signature used with the generic-programming extension
1154           | 'default' infixexp '::' sigtypedoc
1155                     {% do { (TypeSig l ty _) <- checkValSig $2 $4
1156                           ; let err = text "in default signature" <> colon <+>
1157                                       quotes (ppr ty)
1158                           ; ams (sLL $1 $> $ SigD (GenericSig l ty))
1159                                 [mj AnnDefault $1,mj AnnDcolon $3] } }
1160
1161 decls_cls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }  -- Reversed
1162           : decls_cls ';' decl_cls      {% if isNilOL (snd $ unLoc $1)
1163                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1164                                                                     , unitOL $3))
1165                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
1166                                            >> return (sLL $1 $> (fst $ unLoc $1
1167                                                                 ,(snd $ unLoc $1) `appOL` unitOL $3)) }
1168           | decls_cls ';'               {% if isNilOL (snd $ unLoc $1)
1169                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1170                                                                                    ,snd $ unLoc $1))
1171                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
1172                                            >> return (sLL $1 $>  (unLoc $1)) }
1173           | decl_cls                    { sL1 $1 ([], unitOL $1) }
1174           | {- empty -}                 { noLoc ([],nilOL) }
1175
1176 decllist_cls
1177         :: { Located ([AddAnn]
1178                      , OrdList (LHsDecl RdrName)) }      -- Reversed
1179         : '{'         decls_cls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
1180                                              ,snd $ unLoc $2) }
1181         |     vocurly decls_cls close   { $2 }
1182
1183 -- Class body
1184 --
1185 where_cls :: { Located ([AddAnn]
1186                        ,(OrdList (LHsDecl RdrName))) }    -- Reversed
1187                                 -- No implicit parameters
1188                                 -- May have type declarations
1189         : 'where' decllist_cls          { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1190                                              ,snd $ unLoc $2) }
1191         | {- empty -}                   { noLoc ([],nilOL) }
1192
1193 -- Declarations in instance bodies
1194 --
1195 decl_inst  :: { Located (OrdList (LHsDecl RdrName)) }
1196 decl_inst  : at_decl_inst               { sLL $1 $> (unitOL (sL1 $1 (InstD (unLoc $1)))) }
1197            | decl                       { sLL $1 $> (unitOL $1) }
1198
1199 decls_inst :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }   -- Reversed
1200            : decls_inst ';' decl_inst   {% if isNilOL (snd $ unLoc $1)
1201                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1202                                                                     , unLoc $3))
1203                                              else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1204                                            >> return
1205                                             (sLL $1 $> (fst $ unLoc $1
1206                                                        ,(snd $ unLoc $1) `appOL` unLoc $3)) }
1207            | decls_inst ';'             {% if isNilOL (snd $ unLoc $1)
1208                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1209                                                                                    ,snd $ unLoc $1))
1210                                              else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1211                                            >> return (sLL $1 $> (unLoc $1)) }
1212            | decl_inst                  { sL1 $1 ([],unLoc $1) }
1213            | {- empty -}                { noLoc ([],nilOL) }
1214
1215 decllist_inst
1216         :: { Located ([AddAnn]
1217                      , OrdList (LHsDecl RdrName)) }      -- Reversed
1218         : '{'         decls_inst '}'    { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) }
1219         |     vocurly decls_inst close  { L (gl $2) (unLoc $2) }
1220
1221 -- Instance body
1222 --
1223 where_inst :: { Located ([AddAnn]
1224                         , OrdList (LHsDecl RdrName)) }   -- Reversed
1225                                 -- No implicit parameters
1226                                 -- May have type declarations
1227         : 'where' decllist_inst         { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1228                                              ,(snd $ unLoc $2)) }
1229         | {- empty -}                   { noLoc ([],nilOL) }
1230
1231 -- Declarations in binding groups other than classes and instances
1232 --
1233 decls   :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
1234         : decls ';' decl    {% if isNilOL (snd $ unLoc $1)
1235                                  then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1236                                                         , unitOL $3))
1237                                  else do ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1238                                            >> return (
1239                                           let { this = unitOL $3;
1240                                                 rest = snd $ unLoc $1;
1241                                                 these = rest `appOL` this }
1242                                           in rest `seq` this `seq` these `seq`
1243                                              (sLL $1 $> (fst $ unLoc $1,these))) }
1244         | decls ';'          {% if isNilOL (snd $ unLoc $1)
1245                                   then return (sLL $1 $> ((mj AnnSemi $2:(fst $ unLoc $1)
1246                                                           ,snd $ unLoc $1)))
1247                                   else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1248                                            >> return (sLL $1 $> (unLoc $1)) }
1249         | decl                          { sL1 $1 ([], unitOL $1) }
1250         | {- empty -}                   { noLoc ([],nilOL) }
1251
1252 decllist :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
1253         : '{'            decls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
1254                                                    ,snd $ unLoc $2) }
1255         |     vocurly    decls close   { L (gl $2) (fst $ unLoc $2,snd $ unLoc $2) }
1256
1257 -- Binding groups other than those of class and instance declarations
1258 --
1259 binds   ::  { Located ([AddAnn],HsLocalBinds RdrName) }
1260                                          -- May have implicit parameters
1261                                                 -- No type declarations
1262         : decllist          {% do { val_binds <- cvBindGroup (snd $ unLoc $1)
1263                                   ; return (sL1 $1 (fst $ unLoc $1
1264                                                     ,HsValBinds val_binds)) } }
1265
1266         | '{'            dbinds '}'     { sLL $1 $> ([moc $1,mcc $3]
1267                                              ,HsIPBinds (IPBinds (unLoc $2)
1268                                                          emptyTcEvBinds)) }
1269
1270         |     vocurly    dbinds close   { L (getLoc $2) ([]
1271                                             ,HsIPBinds (IPBinds (unLoc $2)
1272                                                         emptyTcEvBinds)) }
1273
1274
1275 wherebinds :: { Located ([AddAnn],HsLocalBinds RdrName) }
1276                                                 -- May have implicit parameters
1277                                                 -- No type declarations
1278         : 'where' binds                 { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2)
1279                                              ,snd $ unLoc $2) }
1280         | {- empty -}                   { noLoc ([],emptyLocalBinds) }
1281
1282
1283 -----------------------------------------------------------------------------
1284 -- Transformation Rules
1285
1286 rules   :: { OrdList (LRuleDecl RdrName) }
1287         :  rules ';' rule              {% addAnnotation (oll $1) AnnSemi (gl $2)
1288                                           >> return ($1 `snocOL` $3) }
1289         |  rules ';'                   {% addAnnotation (oll $1) AnnSemi (gl $2)
1290                                           >> return $1 }
1291         |  rule                        { unitOL $1 }
1292         |  {- empty -}                 { nilOL }
1293
1294 rule    :: { LRuleDecl RdrName }
1295         : STRING rule_activation rule_forall infixexp '=' exp
1296          {%ams (sLL $1 $> $ (HsRule (L (gl $1) (getSTRINGs $1,getSTRING $1))
1297                                   ((snd $2) `orElse` AlwaysActive)
1298                                   (snd $3) $4 placeHolderNames $6
1299                                   placeHolderNames))
1300                (mj AnnEqual $5 : (fst $2) ++ (fst $3)) }
1301
1302 -- Rules can be specified to be NeverActive, unlike inline/specialize pragmas
1303 rule_activation :: { ([AddAnn],Maybe Activation) }
1304         : {- empty -}                           { ([],Nothing) }
1305         | rule_explicit_activation              { (fst $1,Just (snd $1)) }
1306
1307 rule_explicit_activation :: { ([AddAnn]
1308                               ,Activation) }  -- In brackets
1309         : '[' INTEGER ']'       { ([mos $1,mj AnnVal $2,mcs $3]
1310                                   ,ActiveAfter  (fromInteger (getINTEGER $2))) }
1311         | '[' '~' INTEGER ']'   { ([mos $1,mj AnnTilde $2,mj AnnVal $3,mcs $4]
1312                                   ,ActiveBefore (fromInteger (getINTEGER $3))) }
1313         | '[' '~' ']'           { ([mos $1,mj AnnTilde $2,mcs $3]
1314                                   ,NeverActive) }
1315
1316 rule_forall :: { ([AddAnn],[LRuleBndr RdrName]) }
1317         : 'forall' rule_var_list '.'     { ([mj AnnForall $1,mj AnnDot $3],$2) }
1318         | {- empty -}                    { ([],[]) }
1319
1320 rule_var_list :: { [LRuleBndr RdrName] }
1321         : rule_var                              { [$1] }
1322         | rule_var rule_var_list                { $1 : $2 }
1323
1324 rule_var :: { LRuleBndr RdrName }
1325         : varid                         { sLL $1 $> (RuleBndr $1) }
1326         | '(' varid '::' ctype ')'      {% ams (sLL $1 $> (RuleBndrSig $2
1327                                                        (mkHsWithBndrs $4)))
1328                                                [mop $1,mj AnnDcolon $3,mcp $5] }
1329
1330 -----------------------------------------------------------------------------
1331 -- Warnings and deprecations (c.f. rules)
1332
1333 warnings :: { OrdList (LWarnDecl RdrName) }
1334         : warnings ';' warning         {% addAnnotation (oll $1) AnnSemi (gl $2)
1335                                           >> return ($1 `appOL` $3) }
1336         | warnings ';'                 {% addAnnotation (oll $1) AnnSemi (gl $2)
1337                                           >> return $1 }
1338         | warning                      { $1 }
1339         | {- empty -}                  { nilOL }
1340
1341 -- SUP: TEMPORARY HACK, not checking for `module Foo'
1342 warning :: { OrdList (LWarnDecl RdrName) }
1343         : namelist strings
1344                 {% amsu (sLL $1 $> (Warning (unLoc $1) (WarningTxt (noLoc "") $ snd $ unLoc $2)))
1345                      (fst $ unLoc $2) }
1346
1347 deprecations :: { OrdList (LWarnDecl RdrName) }
1348         : deprecations ';' deprecation
1349                                        {% addAnnotation (oll $1) AnnSemi (gl $2)
1350                                           >> return ($1 `appOL` $3) }
1351         | deprecations ';'             {% addAnnotation (oll $1) AnnSemi (gl $2)
1352                                           >> return $1 }
1353         | deprecation                  { $1 }
1354         | {- empty -}                  { nilOL }
1355
1356 -- SUP: TEMPORARY HACK, not checking for `module Foo'
1357 deprecation :: { OrdList (LWarnDecl RdrName) }
1358         : namelist strings
1359              {% amsu (sLL $1 $> $ (Warning (unLoc $1) (DeprecatedTxt (noLoc "") $ snd $ unLoc $2)))
1360                      (fst $ unLoc $2) }
1361
1362 strings :: { Located ([AddAnn],[Located StringLiteral]) }
1363     : STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) }
1364     | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) }
1365
1366 stringlist :: { Located (OrdList (Located StringLiteral)) }
1367     : stringlist ',' STRING {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
1368                                return (sLL $1 $> (unLoc $1 `snocOL`
1369                                                   (L (gl $3) (getStringLiteral $3)))) }
1370     | STRING                { sLL $1 $> (unitOL (L (gl $1) (getStringLiteral $1))) }
1371
1372 -----------------------------------------------------------------------------
1373 -- Annotations
1374 annotation :: { LHsDecl RdrName }
1375     : '{-# ANN' name_var aexp '#-}'      {% ams (sLL $1 $> (AnnD $ HsAnnotation
1376                                             (getANN_PRAGs $1)
1377                                             (ValueAnnProvenance $2) $3))
1378                                             [mo $1,mc $4] }
1379
1380     | '{-# ANN' 'type' tycon aexp '#-}'  {% ams (sLL $1 $> (AnnD $ HsAnnotation
1381                                             (getANN_PRAGs $1)
1382                                             (TypeAnnProvenance $3) $4))
1383                                             [mo $1,mj AnnType $2,mc $5] }
1384
1385     | '{-# ANN' 'module' aexp '#-}'      {% ams (sLL $1 $> (AnnD $ HsAnnotation
1386                                                 (getANN_PRAGs $1)
1387                                                  ModuleAnnProvenance $3))
1388                                                 [mo $1,mj AnnModule $2,mc $4] }
1389
1390
1391 -----------------------------------------------------------------------------
1392 -- Foreign import and export declarations
1393
1394 fdecl :: { Located ([AddAnn],HsDecl RdrName) }
1395 fdecl : 'import' callconv safety fspec
1396                {% mkImport $2 $3 (snd $ unLoc $4) >>= \i ->
1397                  return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i))  }
1398       | 'import' callconv        fspec
1399                {% do { d <- mkImport $2 (noLoc PlaySafe) (snd $ unLoc $3);
1400                     return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $3),d)) }}
1401       | 'export' callconv fspec
1402                {% mkExport $2 (snd $ unLoc $3) >>= \i ->
1403                   return (sLL $1 $> (mj AnnExport $1 : (fst $ unLoc $3),i) ) }
1404
1405 callconv :: { Located CCallConv }
1406           : 'stdcall'                   { sLL $1 $> StdCallConv }
1407           | 'ccall'                     { sLL $1 $> CCallConv   }
1408           | 'capi'                      { sLL $1 $> CApiConv    }
1409           | 'prim'                      { sLL $1 $> PrimCallConv}
1410           | 'javascript'                { sLL $1 $> JavaScriptCallConv }
1411
1412 safety :: { Located Safety }
1413         : 'unsafe'                      { sLL $1 $> PlayRisky }
1414         | 'safe'                        { sLL $1 $> PlaySafe }
1415         | 'interruptible'               { sLL $1 $> PlayInterruptible }
1416
1417 fspec :: { Located ([AddAnn]
1418                     ,(Located StringLiteral, Located RdrName, LHsType RdrName)) }
1419        : STRING var '::' sigtypedoc     { sLL $1 $> ([mj AnnDcolon $3]
1420                                              ,(L (getLoc $1)
1421                                                     (getStringLiteral $1), $2, $4)) }
1422        |        var '::' sigtypedoc     { sLL $1 $> ([mj AnnDcolon $2]
1423                                              ,(noLoc (StringLiteral "" nilFS), $1, $3)) }
1424          -- if the entity string is missing, it defaults to the empty string;
1425          -- the meaning of an empty entity string depends on the calling
1426          -- convention
1427
1428 -----------------------------------------------------------------------------
1429 -- Type signatures
1430
1431 opt_sig :: { ([AddAnn],Maybe (LHsType RdrName)) }
1432         : {- empty -}                   { ([],Nothing) }
1433         | '::' sigtype                  { ([mj AnnDcolon $1],Just $2) }
1434
1435 opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) }
1436         : {- empty -}                   { ([],Nothing) }
1437         | '::' atype                    { ([mj AnnDcolon $1],Just $2) }
1438
1439 sigtype :: { LHsType RdrName }          -- Always a HsForAllTy,
1440                                         -- to tell the renamer where to generalise
1441         : ctype                         { sL1 $1 (mkImplicitHsForAllTy $1) }
1442         -- Wrap an Implicit forall if there isn't one there already
1443
1444 sigtypedoc :: { LHsType RdrName }       -- Always a HsForAllTy
1445         : ctypedoc                      { sL1 $1 (mkImplicitHsForAllTy $1) }
1446         -- Wrap an Implicit forall if there isn't one there already
1447
1448 sig_vars :: { Located [Located RdrName] }    -- Returned in reversed order
1449          : sig_vars ',' var           {% addAnnotation (gl $ head $ unLoc $1)
1450                                                        AnnComma (gl $2)
1451                                          >> return (sLL $1 $> ($3 : unLoc $1)) }
1452          | var                        { sL1 $1 [$1] }
1453
1454 sigtypes1 :: { (OrdList (LHsType RdrName)) }      -- Always HsForAllTys
1455         : sigtype                      { unitOL $1 }
1456         | sigtype ',' sigtypes1        {% addAnnotation (gl $1) AnnComma (gl $2)
1457                                           >> return ((unitOL $1) `appOL` $3) }
1458
1459 -----------------------------------------------------------------------------
1460 -- Types
1461
1462 strict_mark :: { Located ([AddAnn],HsBang) }
1463         : strictness { sL1 $1 (let (a, str) = unLoc $1 in (a, HsSrcBang Nothing NoSrcUnpack str)) }
1464         | unpackedness { sL1 $1 (let (a, prag, unpk) = unLoc $1 in (a, HsSrcBang prag unpk NoSrcStrictness)) }
1465         | unpackedness strictness { sLL $1 $> (let { (a, prag, unpk) = unLoc $1
1466                                                    ; (a', str) = unLoc $2 }
1467                                                 in (a ++ a', HsSrcBang prag unpk str)) }
1468         -- Although UNPACK with no '!' without StrictData and UNPACK with '~' are illegal,
1469         -- we get a better error message if we parse them here
1470
1471 strictness :: { Located ([AddAnn], SrcStrictness) }
1472         : '!' { sL1 $1 ([mj AnnBang $1], SrcStrict) }
1473         | '~' { sL1 $1 ([mj AnnTilde $1], SrcLazy) }
1474
1475 unpackedness :: { Located ([AddAnn], Maybe SourceText, SrcUnpackedness) }
1476         : '{-# UNPACK' '#-}'   { sLL $1 $> ([mo $1, mc $2], Just $ getUNPACK_PRAGs $1, SrcUnpack) }
1477         | '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], Just $ getNOUNPACK_PRAGs $1, SrcNoUnpack) }
1478
1479 -- A ctype is a for-all type
1480 ctype   :: { LHsType RdrName }
1481         : 'forall' tv_bndrs '.' ctype   {% hintExplicitForall (getLoc $1) >>
1482                                            ams (sLL $1 $> $ mkExplicitHsForAllTy $2
1483                                                                  (noLoc []) $4)
1484                                                [mj AnnForall $1,mj AnnDot $3] }
1485         | context '=>' ctype          {% addAnnotation (gl $1) AnnDarrow (gl $2)
1486                                          >> return (sLL $1 $> $
1487                                                mkQualifiedHsForAllTy $1 $3) }
1488         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
1489                                              [mj AnnVal $1,mj AnnDcolon $2] }
1490         | type                        { $1 }
1491
1492 ----------------------
1493 -- Notes for 'ctypedoc'
1494 -- It would have been nice to simplify the grammar by unifying `ctype` and
1495 -- ctypedoc` into one production, allowing comments on types everywhere (and
1496 -- rejecting them after parsing, where necessary).  This is however not possible
1497 -- since it leads to ambiguity. The reason is the support for comments on record
1498 -- fields:
1499 --         data R = R { field :: Int -- ^ comment on the field }
1500 -- If we allow comments on types here, it's not clear if the comment applies
1501 -- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
1502
1503 ctypedoc :: { LHsType RdrName }
1504         : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
1505                                             ams (sLL $1 $> $ mkExplicitHsForAllTy $2
1506                                                                   (noLoc []) $4)
1507                                                 [mj AnnForall $1,mj AnnDot $3] }
1508         | context '=>' ctypedoc       {% addAnnotation (gl $1) AnnDarrow (gl $2)
1509                                          >> return (sLL $1 $> $
1510                                                   mkQualifiedHsForAllTy $1 $3) }
1511         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
1512                                              [mj AnnVal $1,mj AnnDcolon $2] }
1513         | typedoc                     { $1 }
1514
1515 ----------------------
1516 -- Notes for 'context'
1517 -- We parse a context as a btype so that we don't get reduce/reduce
1518 -- errors in ctype.  The basic problem is that
1519 --      (Eq a, Ord a)
1520 -- looks so much like a tuple type.  We can't tell until we find the =>
1521
1522 -- We have the t1 ~ t2 form both in 'context' and in type,
1523 -- to permit an individual equational constraint without parenthesis.
1524 -- Thus for some reason we allow    f :: a~b => blah
1525 -- but not                          f :: ?x::Int => blah
1526 -- See Note [Parsing ~]
1527 context :: { LHsContext RdrName }
1528         :  btype                        {% do { (anns,ctx) <- checkContext (splitTilde $1)
1529                                                 ; if null (unLoc ctx)
1530                                                    then addAnnotation (gl $1) AnnUnit (gl $1)
1531                                                    else return ()
1532                                                 ; ams ctx anns
1533                                                 } }
1534 -- See Note [Parsing ~]
1535 type :: { LHsType RdrName }
1536         : btype                         { splitTilde $1 }
1537         | btype qtyconop type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1538         | btype tyvarop  type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1539         | btype '->'     ctype          {% ams $1 [mj AnnRarrow $2]
1540                                         >> ams (sLL $1 $> $ HsFunTy (splitTilde $1) $3)
1541                                                [mj AnnRarrow $2] }
1542         | btype SIMPLEQUOTE qconop type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1543                                                 [mj AnnSimpleQuote $2] }
1544         | btype SIMPLEQUOTE varop  type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1545                                                 [mj AnnSimpleQuote $2] }
1546 -- See Note [Parsing ~]
1547 typedoc :: { LHsType RdrName }
1548         : btype                          { splitTilde $1 }
1549         | btype docprev                  { sLL $1 $> $ HsDocTy (splitTilde $1) $2 }
1550         | btype qtyconop type            { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1551         | btype qtyconop type docprev    { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
1552         | btype tyvarop  type            { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1553         | btype tyvarop  type docprev    { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
1554         | btype '->'     ctypedoc        {% ams (sLL $1 $> $ HsFunTy (splitTilde $1) $3)
1555                                                 [mj AnnRarrow $2] }
1556         | btype docprev '->' ctypedoc    {% ams (sLL $1 $> $ HsFunTy (L (comb2 (splitTilde $1) $2)
1557                                                             (HsDocTy $1 $2)) $4)
1558                                                 [mj AnnRarrow $3] }
1559         | btype SIMPLEQUOTE qconop type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1560                                                 [mj AnnSimpleQuote $2] }
1561         | btype SIMPLEQUOTE varop  type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1562                                                 [mj AnnSimpleQuote $2] }
1563
1564 btype :: { LHsType RdrName }
1565         : btype atype                   { sLL $1 $> $ HsAppTy $1 $2 }
1566         | atype                         { $1 }
1567
1568 atype :: { LHsType RdrName }
1569         : ntgtycon                       { sL1 $1 (HsTyVar (unLoc $1)) }      -- Not including unit tuples
1570         | tyvar                          {% do { nwc <- namedWildCardsEnabled -- (See Note [Unit tuples])
1571                                                ; let tv@(Unqual name) = unLoc $1
1572                                                ; return $ if (startsWithUnderscore name && nwc)
1573                                                           then (sL1 $1 (mkNamedWildCardTy tv))
1574                                                           else (sL1 $1 (HsTyVar tv)) } }
1575
1576         | strict_mark atype              {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2))
1577                                                 (fst $ unLoc $1) }  -- Constructor sigs only
1578         | '{' fielddecls '}'             {% amms (checkRecordSyntax
1579                                                     (sLL $1 $> $ HsRecTy $2))
1580                                                         -- Constructor sigs only
1581                                                  [moc $1,mcc $3] }
1582         | '(' ')'                        {% ams (sLL $1 $> $ HsTupleTy
1583                                                     HsBoxedOrConstraintTuple [])
1584                                                 [mop $1,mcp $2] }
1585         | '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
1586                                                           (gl $3) >>
1587                                             ams (sLL $1 $> $ HsTupleTy
1588                                              HsBoxedOrConstraintTuple ($2 : $4))
1589                                                 [mop $1,mcp $5] }
1590         | '(#' '#)'                   {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple [])
1591                                              [mo $1,mc $2] }
1592         | '(#' comma_types1 '#)'      {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple $2)
1593                                              [mo $1,mc $3] }
1594         | '[' ctype ']'               {% ams (sLL $1 $> $ HsListTy  $2) [mos $1,mcs $3] }
1595         | '[:' ctype ':]'             {% ams (sLL $1 $> $ HsPArrTy  $2) [mo $1,mc $3] }
1596         | '(' ctype ')'               {% ams (sLL $1 $> $ HsParTy   $2) [mop $1,mcp $3] }
1597         | '(' ctype '::' kind ')'     {% ams (sLL $1 $> $ HsKindSig $2 $4)
1598                                              [mop $1,mj AnnDcolon $3,mcp $5] }
1599         | quasiquote                  { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
1600         | '$(' exp ')'                {% ams (sLL $1 $> $ mkHsSpliceTy $2)
1601                                              [mj AnnOpenPE $1,mj AnnCloseP $3] }
1602         | TH_ID_SPLICE                {%ams (sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $
1603                                              mkUnqual varName (getTH_ID_SPLICE $1))
1604                                              [mj AnnThIdSplice $1] }
1605                                       -- see Note [Promotion] for the followings
1606         | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar $ unLoc $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
1607         | SIMPLEQUOTE  '(' ctype ',' comma_types1 ')'
1608                              {% addAnnotation (gl $3) AnnComma (gl $4) >>
1609                                 ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5))
1610                                     [mj AnnSimpleQuote $1,mop $2,mcp $6] }
1611         | SIMPLEQUOTE  '[' comma_types0 ']'     {% ams (sLL $1 $> $ HsExplicitListTy
1612                                                             placeHolderKind $3)
1613                                                        [mj AnnSimpleQuote $1,mos $2,mcs $4] }
1614         | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar $ unLoc $2)
1615                                                        [mj AnnSimpleQuote $1,mj AnnName $2] }
1616
1617         -- Two or more [ty, ty, ty] must be a promoted list type, just as
1618         -- if you had written '[ty, ty, ty]
1619         -- (One means a list type, zero means the list type constructor,
1620         -- so you have to quote those.)
1621         | '[' ctype ',' comma_types1 ']'  {% addAnnotation (gl $2) AnnComma
1622                                                            (gl $3) >>
1623                                              ams (sLL $1 $> $ HsExplicitListTy
1624                                                      placeHolderKind ($2 : $4))
1625                                                  [mos $1,mcs $5] }
1626         | INTEGER              { sLL $1 $> $ HsTyLit $ HsNumTy (getINTEGERs $1)
1627                                                                (getINTEGER $1) }
1628         | STRING               { sLL $1 $> $ HsTyLit $ HsStrTy (getSTRINGs $1)
1629                                                                (getSTRING  $1) }
1630         | '_'                  { sL1 $1 $ mkAnonWildCardTy }
1631
1632 -- An inst_type is what occurs in the head of an instance decl
1633 --      e.g.  (Foo a, Gaz b) => Wibble a b
1634 -- It's kept as a single type, with a MonoDictTy at the right
1635 -- hand corner, for convenience.
1636 inst_type :: { LHsType RdrName }
1637         : sigtype                       { $1 }
1638
1639 inst_types1 :: { [LHsType RdrName] }
1640         : inst_type                     { [$1] }
1641
1642         | inst_type ',' inst_types1    {% addAnnotation (gl $1) AnnComma (gl $2)
1643                                           >> return ($1 : $3) }
1644
1645 comma_types0  :: { [LHsType RdrName] }  -- Zero or more:  ty,ty,ty
1646         : comma_types1                  { $1 }
1647         | {- empty -}                   { [] }
1648
1649 comma_types1    :: { [LHsType RdrName] }  -- One or more:  ty,ty,ty
1650         : ctype                        { [$1] }
1651         | ctype  ',' comma_types1      {% addAnnotation (gl $1) AnnComma (gl $2)
1652                                           >> return ($1 : $3) }
1653
1654 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1655          : tv_bndr tv_bndrs             { $1 : $2 }
1656          | {- empty -}                  { [] }
1657
1658 tv_bndr :: { LHsTyVarBndr RdrName }
1659         : tyvar                         { sL1 $1 (UserTyVar (unLoc $1)) }
1660         | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar $2 $4))
1661                                                [mop $1,mj AnnDcolon $3
1662                                                ,mcp $5] }
1663
1664 fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
1665         : {- empty -}                   { noLoc ([],[]) }
1666         | '|' fds1                      { (sLL $1 $> ([mj AnnVbar $1]
1667                                                  ,reverse (unLoc $2))) }
1668
1669 fds1 :: { Located [Located (FunDep (Located RdrName))] }
1670         : fds1 ',' fd   {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2)
1671                            >> return (sLL $1 $> ($3 : unLoc $1)) }
1672         | fd            { sL1 $1 [$1] }
1673
1674 fd :: { Located (FunDep (Located RdrName)) }
1675         : varids0 '->' varids0  {% ams (L (comb3 $1 $2 $3)
1676                                        (reverse (unLoc $1), reverse (unLoc $3)))
1677                                        [mj AnnRarrow $2] }
1678
1679 varids0 :: { Located [Located RdrName] }
1680         : {- empty -}                   { noLoc [] }
1681         | varids0 tyvar                 { sLL $1 $> ($2 : unLoc $1) }
1682
1683 {-
1684 Note [Parsing ~]
1685 ~~~~~~~~~~~~~~~~
1686
1687 Due to parsing conflicts between lazyness annotations in data type
1688 declarations (see strict_mark) and equality types ~'s are always
1689 parsed as lazyness annotations, and turned into HsEqTy's in the
1690 correct places using RdrHsSyn.splitTilde.
1691
1692 Since strict_mark is parsed as part of atype which is part of type,
1693 typedoc and context (where HsEqTy previously appeared) it made most
1694 sense and was simplest to parse ~ as part of strict_mark and later
1695 turn them into HsEqTy's.
1696
1697 -}
1698
1699
1700 -----------------------------------------------------------------------------
1701 -- Kinds
1702
1703 kind :: { LHsKind RdrName }
1704         : bkind                  { $1 }
1705         | bkind '->' kind        {% ams (sLL $1 $> $ HsFunTy $1 $3)
1706                                         [mj AnnRarrow $2] }
1707
1708 bkind :: { LHsKind RdrName }
1709         : akind                  { $1 }
1710         | bkind akind            { sLL $1 $> $ HsAppTy $1 $2 }
1711
1712 akind :: { LHsKind RdrName }
1713         : '*'                    { sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName) }
1714         | '(' kind ')'           {% ams (sLL $1 $>  $ HsParTy $2)
1715                                         [mop $1,mcp $3] }
1716         | pkind                  { $1 }
1717         | tyvar                  { sL1 $1 $ HsTyVar (unLoc $1) }
1718
1719 pkind :: { LHsKind RdrName }  -- promoted type, see Note [Promotion]
1720         : qtycon                          { sL1 $1 $ HsTyVar $ unLoc $1 }
1721         | '(' ')'                   {% ams (sLL $1 $> $ HsTyVar $ getRdrName unitTyCon)
1722                                            [mop $1,mcp $2] }
1723         | '(' kind ',' comma_kinds1 ')'
1724                           {% addAnnotation (gl $2) AnnComma (gl $3) >>
1725                              ams (sLL $1 $> $ HsTupleTy HsBoxedTuple ( $2 : $4))
1726                                  [mop $1,mcp $5] }
1727         | '[' kind ']'                    {% ams (sLL $1 $> $ HsListTy $2)
1728                                                  [mos $1,mcs $3] }
1729
1730 comma_kinds1 :: { [LHsKind RdrName] }
1731         : kind                         { [$1] }
1732         | kind  ',' comma_kinds1       {% addAnnotation (gl $1) AnnComma (gl $2)
1733                                           >> return ($1 : $3) }
1734
1735 {- Note [Promotion]
1736    ~~~~~~~~~~~~~~~~
1737
1738 - Syntax of promoted qualified names
1739 We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
1740 names. Moreover ticks are only allowed in types, not in kinds, for a
1741 few reasons:
1742   1. we don't need quotes since we cannot define names in kinds
1743   2. if one day we merge types and kinds, tick would mean look in DataName
1744   3. we don't have a kind namespace anyway
1745
1746 - Syntax of explicit kind polymorphism  (IA0_TODO: not yet implemented)
1747 Kind abstraction is implicit. We write
1748 > data SList (s :: k -> *) (as :: [k]) where ...
1749 because it looks like what we do in terms
1750 > id (x :: a) = x
1751
1752 - Name resolution
1753 When the user write Zero instead of 'Zero in types, we parse it a
1754 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
1755 deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
1756 bounded in the type level, then we look for it in the term level (we
1757 change its namespace to DataName, see Note [Demotion] in OccName). And
1758 both become a HsTyVar ("Zero", DataName) after the renamer.
1759
1760 -}
1761
1762
1763 -----------------------------------------------------------------------------
1764 -- Datatype declarations
1765
1766 gadt_constrlist :: { Located ([AddAnn]
1767                           ,[LConDecl RdrName]) } -- Returned in order
1768         : 'where' '{'        gadt_constrs '}'   { L (comb2 $1 $3)
1769                                                     ([mj AnnWhere $1
1770                                                      ,moc $2
1771                                                      ,mcc $4]
1772                                                     , unLoc $3) }
1773         | 'where' vocurly    gadt_constrs close  { L (comb2 $1 $3)
1774                                                      ([mj AnnWhere $1]
1775                                                      , unLoc $3) }
1776         | {- empty -}                            { noLoc ([],[]) }
1777
1778 gadt_constrs :: { Located [LConDecl RdrName] }
1779         : gadt_constr_with_doc ';' gadt_constrs
1780                   {% addAnnotation (gl $1) AnnSemi (gl $2)
1781                      >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
1782         | gadt_constr_with_doc          { L (gl $1) [$1] }
1783         | {- empty -}                   { noLoc [] }
1784
1785 -- We allow the following forms:
1786 --      C :: Eq a => a -> T a
1787 --      C :: forall a. Eq a => !a -> T a
1788 --      D { x,y :: a } :: T a
1789 --      forall a. Eq a => D { x,y :: a } :: T a
1790
1791 gadt_constr_with_doc :: { LConDecl RdrName }
1792 gadt_constr_with_doc
1793         : maybe_docnext ';' gadt_constr
1794                 {% return $ addConDoc $3 $1 }
1795         | gadt_constr
1796                 {% return $1 }
1797
1798 gadt_constr :: { LConDecl RdrName }
1799     -- see Note [Difference in parsing GADT and data constructors]
1800     -- Returns a list because of:   C,D :: ty
1801         : con_list '::' sigtype
1802                 {% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3
1803                       ; ams (sLL $1 $> gadtDecl)
1804                             (mj AnnDcolon $2:anns) } }
1805
1806 {- Note [Difference in parsing GADT and data constructors]
1807 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1808 GADT constructors have simpler syntax than usual data constructors:
1809 in GADTs, types cannot occur to the left of '::', so they cannot be mixed
1810 with constructor names (see Note [Parsing data constructors is hard]).
1811
1812 Due to simplified syntax, GADT constructor names (left-hand side of '::')
1813 use simpler grammar production than usual data constructor names. As a
1814 consequence, GADT constructor names are resticted (names like '(*)' are
1815 allowed in usual data constructors, but not in GADTs).
1816 -}
1817
1818 constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
1819         : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
1820                                                      ,addConDocs (unLoc $3) $1)}
1821
1822 constrs1 :: { Located [LConDecl RdrName] }
1823         : constrs1 maybe_docnext '|' maybe_docprev constr
1824             {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
1825                >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
1826         | constr                                          { sL1 $1 [$1] }
1827
1828 constr :: { LConDecl RdrName }
1829         : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1830                 {% ams (let (con,details) = unLoc $5 in
1831                   addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con
1832                                                    (snd $ unLoc $2) $3 details))
1833                             ($1 `mplus` $6))
1834                         (mj AnnDarrow $4:(fst $ unLoc $2)) }
1835         | maybe_docnext forall constr_stuff maybe_docprev
1836                 {% ams ( let (con,details) = unLoc $3 in
1837                   addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con
1838                                            (snd $ unLoc $2) (noLoc []) details))
1839                             ($1 `mplus` $4))
1840                        (fst $ unLoc $2) }
1841
1842 forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) }
1843         : 'forall' tv_bndrs '.'       { sLL $1 $> ([mj AnnForall $1,mj AnnDot $3],$2) }
1844         | {- empty -}                 { noLoc ([],[]) }
1845
1846 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1847     -- see Note [Parsing data constructors is hard]
1848         : btype                         {% splitCon $1 >>= return.sLL $1 $> }
1849         | btype conop btype             {  sLL $1 $> ($2, InfixCon $1 $3) }
1850
1851 {- Note [Parsing data constructors is hard]
1852 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1853 We parse the constructor declaration
1854      C t1 t2
1855 as a btype (treating C as a type constructor) and then convert C to be
1856 a data constructor.  Reason: it might continue like this:
1857      C t1 t2 %: D Int
1858 in which case C really would be a type constructor.  We can't resolve this
1859 ambiguity till we come across the constructor oprerator :% (or not, more usually)
1860 -}
1861
1862 fielddecls :: { [LConDeclField RdrName] }
1863         : {- empty -}     { [] }
1864         | fielddecls1     { $1 }
1865
1866 fielddecls1 :: { [LConDeclField RdrName] }
1867         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
1868             {% addAnnotation (gl $1) AnnComma (gl $3) >>
1869                return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
1870         | fielddecl   { [$1] }
1871
1872 fielddecl :: { LConDeclField RdrName }
1873                                               -- A list because of   f,g :: Int
1874         : maybe_docnext sig_vars '::' ctype maybe_docprev
1875             {% ams (L (comb2 $2 $4)
1876                       (ConDeclField (reverse (unLoc $2)) $4 ($1 `mplus` $5)))
1877                    [mj AnnDcolon $3] }
1878
1879 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1880 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1881 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1882 -- We don't allow a context, but that's sorted out by the type checker.
1883 deriving :: { Located (Maybe (Located [LHsType RdrName])) }
1884         : {- empty -}             { noLoc Nothing }
1885         | 'deriving' qtycon       {% aljs ( let { L loc tv = $2 }
1886                                             in (sLL $1 $> (Just (sLL $1 $>
1887                                                        [L loc (HsTyVar tv)]))))
1888                                           [mj AnnDeriving $1] }
1889         | 'deriving' '(' ')'      {% aljs (sLL $1 $> (Just (sLL $1 $> [])))
1890                                           [mj AnnDeriving $1,mop $2,mcp $3] }
1891
1892         | 'deriving' '(' inst_types1 ')'  {% aljs (sLL $1 $> (Just (sLL $1 $> $3)))
1893                                                  [mj AnnDeriving $1,mop $2,mcp $4] }
1894              -- Glasgow extension: allow partial
1895              -- applications in derivings
1896
1897 -----------------------------------------------------------------------------
1898 -- Value definitions
1899
1900 {- Note [Declaration/signature overlap]
1901 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1902 There's an awkward overlap with a type signature.  Consider
1903         f :: Int -> Int = ...rhs...
1904    Then we can't tell whether it's a type signature or a value
1905    definition with a result signature until we see the '='.
1906    So we have to inline enough to postpone reductions until we know.
1907 -}
1908
1909 {-
1910   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1911   instead of qvar, we get another shift/reduce-conflict. Consider the
1912   following programs:
1913
1914      { (^^) :: Int->Int ; }          Type signature; only var allowed
1915
1916      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
1917                                      qvar allowed (because of instance decls)
1918
1919   We can't tell whether to reduce var to qvar until after we've read the signatures.
1920 -}
1921
1922 docdecl :: { LHsDecl RdrName }
1923         : docdecld { sL1 $1 (DocD (unLoc $1)) }
1924
1925 docdecld :: { LDocDecl }
1926         : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
1927         | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
1928         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
1929         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
1930
1931 decl_no_th :: { LHsDecl RdrName }
1932         : sigdecl               { $1 }
1933
1934         | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) };
1935                                         pat <- checkPattern empty e;
1936                                         _ <- ams (sLL $1 $> ())
1937                                                (fst $ unLoc $3);
1938                                         return $ sLL $1 $> $ ValD $
1939                                             PatBind pat (snd $ unLoc $3)
1940                                                     placeHolderType
1941                                                     placeHolderNames
1942                                                     ([],[]) } }
1943                                 -- Turn it all into an expression so that
1944                                 -- checkPattern can check that bangs are enabled
1945
1946         | infixexp opt_sig rhs  {% do { (ann,r) <- checkValDef empty $1 (snd $2) $3;
1947                                         let { l = comb2 $1 $> };
1948                                         case r of {
1949                                           (FunBind n _ _ _ _ _) ->
1950                                                 ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
1951                                           (PatBind (L lh _lhs) _rhs _ _ _) ->
1952                                                 ams (L lh ()) (fst $2) >> return () } ;
1953                                         _ <- ams (L l ()) (ann ++ (fst $ unLoc $3));
1954                                         return $! (sL l $ ValD r) } }
1955         | pattern_synonym_decl  { $1 }
1956         | docdecl               { $1 }
1957
1958 decl    :: { LHsDecl RdrName }
1959         : decl_no_th            { $1 }
1960
1961         -- Why do we only allow naked declaration splices in top-level
1962         -- declarations and not here? Short answer: because readFail009
1963         -- fails terribly with a panic in cvBindsAndSigs otherwise.
1964         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
1965
1966 rhs     :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
1967         : '=' exp wherebinds    { sL (comb3 $1 $2 $3)
1968                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
1969                                     ,GRHSs (unguardedRHS (comb3 $1 $2 $3) $2)
1970                                    (snd $ unLoc $3)) }
1971         | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
1972                                     ,GRHSs (reverse (unLoc $1))
1973                                                     (snd $ unLoc $2)) }
1974
1975 gdrhs :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
1976         : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
1977         | gdrh                  { sL1 $1 [$1] }
1978
1979 gdrh :: { LGRHS RdrName (LHsExpr RdrName) }
1980         : '|' guardquals '=' exp  {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
1981                                          [mj AnnVbar $1,mj AnnEqual $3] }
1982
1983 sigdecl :: { LHsDecl RdrName }
1984         :
1985         -- See Note [Declaration/signature overlap] for why we need infixexp here
1986           infixexp '::' sigtypedoc
1987                         {% do s <- checkValSig $1 $3
1988                         ; _ <- ams (sLL $1 $> ()) [mj AnnDcolon $2]
1989                         ; return (sLL $1 $> $ SigD s) }
1990
1991         | var ',' sig_vars '::' sigtypedoc
1992            {% do { let sig = TypeSig ($1 : reverse (unLoc $3)) $5 PlaceHolder
1993                  ; addAnnotation (gl $1) AnnComma (gl $2)
1994                  ; ams ( sLL $1 $> $ SigD sig )
1995                        [mj AnnDcolon $4] } }
1996
1997         | infix prec ops
1998               {% ams (sLL $1 $> $ SigD
1999                         (FixSig (FixitySig (fromOL $ unLoc $3)
2000                                 (Fixity (unLoc $2) (unLoc $1)))))
2001                      [mj AnnInfix $1,mj AnnVal $2] }
2002
2003         | pattern_synonym_sig   { sLL $1 $> . SigD . unLoc $ $1 }
2004
2005         | '{-# INLINE' activation qvar '#-}'
2006                 {% ams ((sLL $1 $> $ SigD (InlineSig $3
2007                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
2008                                             (snd $2)))))
2009                        ((mo $1:fst $2) ++ [mc $4]) }
2010
2011         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
2012              {% ams (
2013                  let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
2014                                              (EmptyInlineSpec, FunLike) (snd $2)
2015                   in sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag))
2016                     (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
2017
2018         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
2019              {% ams (sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
2020                                (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
2021                                                (getSPEC_INLINE $1) (snd $2))))
2022                        (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
2023
2024         | '{-# SPECIALISE' 'instance' inst_type '#-}'
2025                 {% ams (sLL $1 $>
2026                                   $ SigD (SpecInstSig (getSPEC_PRAGs $1) $3))
2027                        [mo $1,mj AnnInstance $2,mc $4] }
2028
2029         -- AZ TODO: Do we need locations in the name_formula_opt?
2030         -- A minimal complete definition
2031         | '{-# MINIMAL' name_boolformula_opt '#-}'
2032             {% ams (sLL $1 $> $ SigD (MinimalSig (getMINIMAL_PRAGs $1) (snd $2)))
2033                    (mo $1:mc $3:fst $2) }
2034
2035 activation :: { ([AddAnn],Maybe Activation) }
2036         : {- empty -}                           { ([],Nothing) }
2037         | explicit_activation                   { (fst $1,Just (snd $1)) }
2038
2039 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
2040         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
2041                                   ,ActiveAfter  (fromInteger (getINTEGER $2))) }
2042         | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
2043                                                  ,mj AnnCloseS $4]
2044                                   ,ActiveBefore (fromInteger (getINTEGER $3))) }
2045
2046 -----------------------------------------------------------------------------
2047 -- Expressions
2048
2049 quasiquote :: { Located (HsSplice RdrName) }
2050         : TH_QUASIQUOTE   { let { loc = getLoc $1
2051                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
2052                                 ; quoterId = mkUnqual varName quoter }
2053                             in sL1 $1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2054         | TH_QQUASIQUOTE  { let { loc = getLoc $1
2055                                 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
2056                                 ; quoterId = mkQual varName (qual, quoter) }
2057                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2058
2059 exp   :: { LHsExpr RdrName }
2060         : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 $3 PlaceHolder)
2061                                        [mj AnnDcolon $2] }
2062         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2063                                                         HsFirstOrderApp True)
2064                                        [mj Annlarrowtail $2] }
2065         | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2066                                                       HsFirstOrderApp False)
2067                                        [mj Annrarrowtail $2] }
2068         | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2069                                                       HsHigherOrderApp True)
2070                                        [mj AnnLarrowtail $2] }
2071         | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2072                                                       HsHigherOrderApp False)
2073                                        [mj AnnRarrowtail $2] }
2074         | infixexp              { $1 }
2075
2076 infixexp :: { LHsExpr RdrName }
2077         : exp10                   { $1 }
2078         | infixexp qop exp10      {% ams (sLL $1 $>
2079                                              (OpApp $1 $2 placeHolderFixity $3))
2080                                          [mj AnnVal $2] }
2081                  -- AnnVal annotation for NPlusKPat, which discards the operator
2082
2083
2084 exp10 :: { LHsExpr RdrName }
2085         : '\\' apat apats opt_asig '->' exp
2086                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
2087                             [sLL $1 $> $ Match Nothing ($2:$3) (snd $4) (unguardedGRHSs $6)]))
2088                           (mj AnnLam $1:mj AnnRarrow $5:(fst $4)) }
2089         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
2090                                                (mj AnnLet $1:mj AnnIn $3
2091                                                  :(fst $ unLoc $2)) }
2092         | '\\' 'lcase' altslist
2093             {% ams (sLL $1 $> $ HsLamCase placeHolderType
2094                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
2095                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
2096         | 'if' exp optSemi 'then' exp optSemi 'else' exp
2097                            {% checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
2098                               ams (sLL $1 $> $ mkHsIf $2 $5 $8)
2099                                   (mj AnnIf $1:mj AnnThen $4
2100                                      :mj AnnElse $7
2101                                      :(map (\l -> mj AnnSemi l) (fst $3))
2102                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
2103         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
2104                                            ams (sLL $1 $> $ HsMultiIf
2105                                                      placeHolderType
2106                                                      (reverse $ snd $ unLoc $2))
2107                                                (mj AnnIf $1:(fst $ unLoc $2)) }
2108         | 'case' exp 'of' altslist      {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
2109                                                    FromSource (snd $ unLoc $4)))
2110                                                (mj AnnCase $1:mj AnnOf $3
2111                                                   :(fst $ unLoc $4)) }
2112         | '-' fexp                      {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
2113                                                [mj AnnMinus $1] }
2114
2115         | 'do' stmtlist              {% ams (L (comb2 $1 $2)
2116                                                (mkHsDo DoExpr (snd $ unLoc $2)))
2117                                                (mj AnnDo $1:(fst $ unLoc $2)) }
2118         | 'mdo' stmtlist            {% ams (L (comb2 $1 $2)
2119                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
2120                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
2121
2122         | scc_annot exp        {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2123                                       (fst $ fst $ unLoc $1) }
2124
2125         | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2126                                       (fst $ fst $ unLoc $1) }
2127
2128         | 'proc' aexp '->' exp
2129                        {% checkPattern empty $2 >>= \ p ->
2130                            checkCommand $4 >>= \ cmd ->
2131                            ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
2132                                                 placeHolderType []))
2133                                             -- TODO: is LL right here?
2134                                [mj AnnProc $1,mj AnnRarrow $3] }
2135
2136         | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4)
2137                                               [mo $1,mj AnnVal $2
2138                                               ,mc $3] }
2139                                           -- hdaume: core annotation
2140         | fexp                         { $1 }
2141
2142         -- parsing error messages go below here
2143         | '\\' apat apats opt_asig '->' error        {% parseErrorSDoc (combineLocs $1 $5) $ text
2144                                                         "parse error in lambda: no expression after '->'"
2145                                                      }
2146         | '\\' error                                 {% parseErrorSDoc (getLoc $1) $ text
2147                                                         "parse error: naked lambda expression '\'"
2148                                                      }
2149         | 'let' binds 'in' error                     {% parseErrorSDoc (combineLocs $1 $2) $ text
2150                                                         "parse error in let binding: missing expression after 'in'"
2151                                                      }
2152         | 'let' binds error                          {% parseErrorSDoc (combineLocs $1 $2) $ text
2153                                                         "parse error in let binding: missing required 'in'"
2154                                                      }
2155         | 'let' error                                {% parseErrorSDoc (getLoc $1) $ text
2156                                                         "parse error: naked let binding"
2157                                                      }
2158         | 'if' exp optSemi 'then' exp optSemi
2159           'else' error                               {% hintIf (combineLocs $1 $5) "else clause empty" }
2160         | 'if' exp optSemi 'then' exp optSemi error  {% hintIf (combineLocs $1 $5) "missing required else clause" }
2161         | 'if' exp optSemi 'then' error              {% hintIf (combineLocs $1 $2) "then clause empty" }
2162         | 'if' exp optSemi error                     {% hintIf (combineLocs $1 $2) "missing required then and else clauses" }
2163         | 'if' error                                 {% hintIf (getLoc $1) "naked if statement" }
2164         | 'case' exp 'of' error                      {% parseErrorSDoc (combineLocs $1 $2) $ text
2165                                                         "parse error in case statement: missing list after '->'"
2166                                                      }
2167         | 'case' exp error                           {% parseErrorSDoc (combineLocs $1 $2) $ text
2168                                                         "parse error in case statement: missing required 'of'"
2169                                                      }
2170         | 'case' error                               {% parseErrorSDoc (getLoc $1) $ text
2171                                                         "parse error: naked case statement"
2172                                                      }
2173 optSemi :: { ([Located a],Bool) }
2174         : ';'         { ([$1],True) }
2175         | {- empty -} { ([],False) }
2176
2177 scc_annot :: { Located (([AddAnn],SourceText),StringLiteral) }
2178         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
2179                                             ; return $ sLL $1 $>
2180                                                (([mo $1,mj AnnValStr $2
2181                                                 ,mc $3],getSCC_PRAGs $1),(StringLiteral (getSTRINGs $2) scc)) }
2182         | '{-# SCC' VARID  '#-}'      { sLL $1 $> (([mo $1,mj AnnVal $2
2183                                          ,mc $3],getSCC_PRAGs $1)
2184                                         ,(StringLiteral (unpackFS $ getVARID $2) (getVARID $2))) }
2185
2186 hpc_annot :: { Located (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))) }
2187       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
2188                                       { sLL $1 $> $ (([mo $1,mj AnnVal $2
2189                                               ,mj AnnVal $3,mj AnnColon $4
2190                                               ,mj AnnVal $5,mj AnnMinus $6
2191                                               ,mj AnnVal $7,mj AnnColon $8
2192                                               ,mj AnnVal $9,mc $10],
2193                                                 getGENERATED_PRAGs $1)
2194                                               ,((getStringLiteral $2)
2195                                                ,( fromInteger $ getINTEGER $3
2196                                                 , fromInteger $ getINTEGER $5
2197                                                 )
2198                                                ,( fromInteger $ getINTEGER $7
2199                                                 , fromInteger $ getINTEGER $9
2200                                                 )
2201                                                ))
2202                                          }
2203
2204 fexp    :: { LHsExpr RdrName }
2205         : fexp aexp                             { sLL $1 $> $ HsApp $1 $2 }
2206         | 'static' aexp                         {% ams (sLL $1 $> $ HsStatic $2)
2207                                                        [mj AnnStatic $1] }
2208         | aexp                                  { $1 }
2209
2210 aexp    :: { LHsExpr RdrName }
2211         : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
2212         | '~' aexp              {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
2213         | aexp1                 { $1 }
2214
2215 aexp1   :: { LHsExpr RdrName }
2216         : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
2217                                                                    (snd $3)
2218                                      ; _ <- ams (sLL $1 $> ()) (moc $2:mcc $4:(fst $3))
2219                                      ; checkRecordSyntax (sLL $1 $> r) }}
2220         | aexp2                { $1 }
2221
2222 aexp2   :: { LHsExpr RdrName }
2223         : qvar                          { sL1 $1 (HsVar   $! unLoc $1) }
2224         | qcon                          { sL1 $1 (HsVar   $! unLoc $1) }
2225         | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
2226         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
2227 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
2228 -- into HsOverLit when -foverloaded-strings is on.
2229 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
2230 --                                       (getSTRING $1) placeHolderType) }
2231         | INTEGER   { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGERs $1)
2232                                          (getINTEGER $1) placeHolderType) }
2233         | RATIONAL  { sL (getLoc $1) (HsOverLit $! mkHsFractional
2234                                           (getRATIONAL $1) placeHolderType) }
2235
2236         -- N.B.: sections get parsed by these next two productions.
2237         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
2238         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
2239         -- but the less cluttered version fell out of having texps.
2240         | '(' texp ')'                  {% ams (sLL $1 $> (HsPar $2)) [mop $1,mcp $3] }
2241         | '(' tup_exprs ')'             {% ams (sLL $1 $> (ExplicitTuple $2 Boxed))
2242                                                [mop $1,mcp $3] }
2243
2244         | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple [L (gl $2)
2245                                                          (Present $2)] Unboxed))
2246                                                [mo $1,mc $3] }
2247         | '(#' tup_exprs '#)'           {% ams (sLL $1 $> (ExplicitTuple $2 Unboxed))
2248                                                [mo $1,mc $3] }
2249
2250         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
2251         | '[:' parr ':]'    {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
2252         | '_'               { sL1 $1 EWildPat }
2253
2254         -- Template Haskell Extension
2255         | splice_exp            { $1 }
2256
2257         | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2258         | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2259         | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2260         | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2261         | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] }
2262         | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]}
2263         | '[t|' ctype '|]'    {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
2264         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
2265                                       ams (sLL $1 $> $ HsBracket (PatBr p))
2266                                           [mo $1,mc $3] }
2267         | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
2268                                       (mo $1:mc $3:fst $2) }
2269         | quasiquote          { sL1 $1 (HsSpliceE (unLoc $1)) }
2270
2271         -- arrow notation extension
2272         | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm $2
2273                                                            Nothing (reverse $3))
2274                                           [mo $1,mc $4] }
2275
2276 splice_exp :: { LHsExpr RdrName }
2277         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkHsSpliceE
2278                                         (sL1 $1 $ HsVar (mkUnqual varName
2279                                                         (getTH_ID_SPLICE $1))))
2280                                        [mj AnnThIdSplice $1] }
2281         | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE $2)
2282                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
2283         | TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkHsSpliceTE
2284                                         (sL1 $1 $ HsVar (mkUnqual varName
2285                                                      (getTH_ID_TY_SPLICE $1))))
2286                                        [mj AnnThIdTySplice $1] }
2287         | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE $2)
2288                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
2289
2290 cmdargs :: { [LHsCmdTop RdrName] }
2291         : cmdargs acmd                  { $2 : $1 }
2292         | {- empty -}                   { [] }
2293
2294 acmd    :: { LHsCmdTop RdrName }
2295         : aexp2                 {% checkCommand $1 >>= \ cmd ->
2296                                     return (sL1 $1 $ HsCmdTop cmd
2297                                            placeHolderType placeHolderType []) }
2298
2299 cvtopbody :: { ([AddAnn],[LHsDecl RdrName]) }
2300         :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1
2301                                                   ,mj AnnCloseC $3],$2) }
2302         |      vocurly    cvtopdecls0 close    { ([],$2) }
2303
2304 cvtopdecls0 :: { [LHsDecl RdrName] }
2305         : {- empty -}           { [] }
2306         | cvtopdecls            { $1 }
2307
2308 -----------------------------------------------------------------------------
2309 -- Tuple expressions
2310
2311 -- "texp" is short for tuple expressions:
2312 -- things that can appear unparenthesized as long as they're
2313 -- inside parens or delimitted by commas
2314 texp :: { LHsExpr RdrName }
2315         : exp                           { $1 }
2316
2317         -- Note [Parsing sections]
2318         -- ~~~~~~~~~~~~~~~~~~~~~~~
2319         -- We include left and right sections here, which isn't
2320         -- technically right according to the Haskell standard.
2321         -- For example (3 +, True) isn't legal.
2322         -- However, we want to parse bang patterns like
2323         --      (!x, !y)
2324         -- and it's convenient to do so here as a section
2325         -- Then when converting expr to pattern we unravel it again
2326         -- Meanwhile, the renamer checks that real sections appear
2327         -- inside parens.
2328         | infixexp qop        { sLL $1 $> $ SectionL $1 $2 }
2329         | qopm infixexp       { sLL $1 $> $ SectionR $1 $2 }
2330
2331        -- View patterns get parenthesized above
2332         | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] }
2333
2334 -- Always at least one comma
2335 tup_exprs :: { [LHsTupArg RdrName] }
2336            : texp commas_tup_tail
2337                           {% do { addAnnotation (gl $1) AnnComma (fst $2)
2338                                 ; return ((sL1 $1 (Present $1)) : snd $2) } }
2339
2340            | commas tup_tail
2341                 {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
2342                       ; return
2343                            (map (\l -> L l missingTupArg) (fst $1) ++ $2) } }
2344
2345 -- Always starts with commas; always follows an expr
2346 commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) }
2347 commas_tup_tail : commas tup_tail
2348        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
2349              ; return (
2350             (head $ fst $1
2351             ,(map (\l -> L l missingTupArg) (tail $ fst $1)) ++ $2)) } }
2352
2353 -- Always follows a comma
2354 tup_tail :: { [LHsTupArg RdrName] }
2355           : texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
2356                                     return ((L (gl $1) (Present $1)) : snd $2) }
2357           | texp                 { [L (gl $1) (Present $1)] }
2358           | {- empty -}          { [noLoc missingTupArg] }
2359
2360 -----------------------------------------------------------------------------
2361 -- List expressions
2362
2363 -- The rules below are little bit contorted to keep lexps left-recursive while
2364 -- avoiding another shift/reduce-conflict.
2365 list :: { ([AddAnn],HsExpr RdrName) }
2366         : texp    { ([],ExplicitList placeHolderType Nothing [$1]) }
2367         | lexps   { ([],ExplicitList placeHolderType Nothing
2368                                                    (reverse (unLoc $1))) }
2369         | texp '..'             { ([mj AnnDotdot $2],
2370                                       ArithSeq noPostTcExpr Nothing (From $1)) }
2371         | texp ',' exp '..'     { ([mj AnnComma $2,mj AnnDotdot $4],
2372                                   ArithSeq noPostTcExpr Nothing
2373                                                              (FromThen $1 $3)) }
2374         | texp '..' exp         { ([mj AnnDotdot $2],
2375                                    ArithSeq noPostTcExpr Nothing
2376                                                                (FromTo $1 $3)) }
2377         | texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
2378                                     ArithSeq noPostTcExpr Nothing
2379                                                 (FromThenTo $1 $3 $5)) }
2380         | texp '|' flattenedpquals
2381              {% checkMonadComp >>= \ ctxt ->
2382                 return ([mj AnnVbar $2],
2383                         mkHsComp ctxt (unLoc $3) $1) }
2384
2385 lexps :: { Located [LHsExpr RdrName] }
2386         : lexps ',' texp          {% addAnnotation (gl $ head $ unLoc $1)
2387                                                             AnnComma (gl $2) >>
2388                                       return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
2389         | texp ',' texp            {% addAnnotation (gl $1) AnnComma (gl $2) >>
2390                                       return (sLL $1 $> [$3,$1]) }
2391
2392 -----------------------------------------------------------------------------
2393 -- List Comprehensions
2394
2395 flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2396     : pquals   { case (unLoc $1) of
2397                     [qs] -> sL1 $1 qs
2398                     -- We just had one thing in our "parallel" list so
2399                     -- we simply return that thing directly
2400
2401                     qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock qs [] noSyntaxExpr |
2402                                             qs <- qss]
2403                                             noSyntaxExpr noSyntaxExpr]
2404                     -- We actually found some actual parallel lists so
2405                     -- we wrap them into as a ParStmt
2406                 }
2407
2408 pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] }
2409     : squals '|' pquals
2410                      {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
2411                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
2412     | squals         { L (getLoc $1) [reverse (unLoc $1)] }
2413
2414 squals :: { Located [LStmt RdrName (LHsExpr RdrName)] }   -- In reverse order, because the last
2415                                         -- one can "grab" the earlier ones
2416     : squals ',' transformqual
2417              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2418                 ams (sLL $1 $> ()) (fst $ unLoc $3) >>
2419                 return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
2420     | squals ',' qual
2421              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2422                 return (sLL $1 $> ($3 : unLoc $1)) }
2423     | transformqual        {% ams $1 (fst $ unLoc $1) >>
2424                               return (sLL $1 $> [L (getLoc $1) ((snd $ unLoc $1) [])]) }
2425     | qual                                { sL1 $1 [$1] }
2426 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
2427 --  | '{|' pquals '|}'                       { sL1 $1 [$2] }
2428
2429 -- It is possible to enable bracketing (associating) qualifier lists
2430 -- by uncommenting the lines with {| |} above. Due to a lack of
2431 -- consensus on the syntax, this feature is not being used until we
2432 -- get user demand.
2433
2434 transformqual :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)] -> Stmt RdrName (LHsExpr RdrName)) }
2435                         -- Function is applied to a list of stmts *in order*
2436     : 'then' exp               { sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
2437     | 'then' exp 'by' exp      { sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],\ss -> (mkTransformByStmt ss $2 $4)) }
2438     | 'then' 'group' 'using' exp
2439              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3], \ss -> (mkGroupUsingStmt ss $4)) }
2440
2441     | 'then' 'group' 'by' exp 'using' exp
2442              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5], \ss -> (mkGroupByUsingStmt ss $4 $6)) }
2443
2444 -- Note that 'group' is a special_id, which means that you can enable
2445 -- TransformListComp while still using Data.List.group. However, this
2446 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
2447 -- in by choosing the "group by" variant, which is what we want.
2448
2449 -----------------------------------------------------------------------------
2450 -- Parallel array expressions
2451
2452 -- The rules below are little bit contorted; see the list case for details.
2453 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
2454 -- Moreover, we allow explicit arrays with no element (represented by the nil
2455 -- constructor in the list case).
2456
2457 parr :: { ([AddAnn],HsExpr RdrName) }
2458         :                      { ([],ExplicitPArr placeHolderType []) }
2459         | texp                 { ([],ExplicitPArr placeHolderType [$1]) }
2460         | lexps                { ([],ExplicitPArr placeHolderType
2461                                                           (reverse (unLoc $1))) }
2462         | texp '..' exp        { ([mj AnnDotdot $2]
2463                                  ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
2464         | texp ',' exp '..' exp
2465                         { ([mj AnnComma $2,mj AnnDotdot $4]
2466                           ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
2467         | texp '|' flattenedpquals
2468                         { ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
2469
2470 -- We are reusing `lexps' and `flattenedpquals' from the list case.
2471
2472 -----------------------------------------------------------------------------
2473 -- Guards
2474
2475 guardquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2476     : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
2477
2478 guardquals1 :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2479     : guardquals1 ',' qual  {% addAnnotation (gl $ head $ unLoc $1) AnnComma
2480                                              (gl $2) >>
2481                                return (sLL $1 $> ($3 : unLoc $1)) }
2482     | qual                  { sL1 $1 [$1] }
2483
2484 -----------------------------------------------------------------------------
2485 -- Case alternatives
2486
2487 altslist :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2488         : '{'            alts '}'  { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2489                                                ,(reverse (snd $ unLoc $2))) }
2490         |     vocurly    alts  close { L (getLoc $2) (fst $ unLoc $2
2491                                         ,(reverse (snd $ unLoc $2))) }
2492         | '{'                 '}'    { noLoc ([moc $1,mcc $2],[]) }
2493         |     vocurly          close { noLoc ([],[]) }
2494
2495 alts    :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2496         : alts1                    { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
2497         | ';' alts                 { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
2498                                                ,snd $ unLoc $2) }
2499
2500 alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2501         : alts1 ';' alt         {% if null (snd $ unLoc $1)
2502                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2503                                                   ,[$3]))
2504                                      else (ams (head $ snd $ unLoc $1)
2505                                                (mj AnnSemi $2:(fst $ unLoc $1))
2506                                            >> return (sLL $1 $> ([],$3 : (snd $ unLoc $1))) ) }
2507         | alts1 ';'             {% if null (snd $ unLoc $1)
2508                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2509                                                   ,snd $ unLoc $1))
2510                                      else (ams (head $ snd $ unLoc $1)
2511                                                (mj AnnSemi $2:(fst $ unLoc $1))
2512                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
2513         | alt                   { sL1 $1 ([],[$1]) }
2514
2515 alt     :: { LMatch RdrName (LHsExpr RdrName) }
2516         : pat opt_sig alt_rhs      {%ams (sLL $1 $> (Match Nothing [$1] (snd $2)
2517                                                               (snd $ unLoc $3)))
2518                                          ((fst $2) ++ (fst $ unLoc $3))}
2519
2520 alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2521         : ralt wherebinds           { sLL $1 $> (fst $ unLoc $2,
2522                                             GRHSs (unLoc $1) (snd $ unLoc $2)) }
2523
2524 ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2525         : '->' exp            {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
2526                                      [mj AnnRarrow $1] }
2527         | gdpats              { sL1 $1 (reverse (unLoc $1)) }
2528
2529 gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2530         : gdpats gdpat                  { sLL $1 $> ($2 : unLoc $1) }
2531         | gdpat                         { sL1 $1 [$1] }
2532
2533 -- optional semi-colons between the guards of a MultiWayIf, because we use
2534 -- layout here, but we don't need (or want) the semicolon as a separator (#7783).
2535 gdpatssemi :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2536         : gdpatssemi gdpat optSemi  {% ams (sL (comb2 $1 $2) ($2 : unLoc $1))
2537                                            (map (\l -> mj AnnSemi l) $ fst $3) }
2538         | gdpat optSemi             {% ams (sL1 $1 [$1])
2539                                            (map (\l -> mj AnnSemi l) $ fst $2) }
2540
2541 -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
2542 -- generate the open brace in addition to the vertical bar in the lexer, and
2543 -- we don't need it.
2544 ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
2545          : '{' gdpatssemi '}'             { sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }
2546          |     gdpatssemi close           { sL1 $1 ([],unLoc $1) }
2547
2548 gdpat   :: { LGRHS RdrName (LHsExpr RdrName) }
2549         : '|' guardquals '->' exp
2550                                   {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2551                                          [mj AnnVbar $1,mj AnnRarrow $3] }
2552
2553 -- 'pat' recognises a pattern, including one with a bang at the top
2554 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
2555 -- Bangs inside are parsed as infix operator applications, so that
2556 -- we parse them right when bang-patterns are off
2557 pat     :: { LPat RdrName }
2558 pat     :  exp          {% checkPattern empty $1 }
2559         | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR
2560                                                      (sL1 $1 (HsVar bang_RDR)) $2)))
2561                                 [mj AnnBang $1] }
2562
2563 bindpat :: { LPat RdrName }
2564 bindpat :  exp            {% checkPattern
2565                                 (text "Possibly caused by a missing 'do'?") $1 }
2566         | '!' aexp        {% amms (checkPattern
2567                                      (text "Possibly caused by a missing 'do'?")
2568                                      (sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2)))
2569                                   [mj AnnBang $1] }
2570
2571 apat   :: { LPat RdrName }
2572 apat    : aexp                  {% checkPattern empty $1 }
2573         | '!' aexp              {% amms (checkPattern empty
2574                                             (sLL $1 $> (SectionR
2575                                                 (sL1 $1 (HsVar bang_RDR)) $2)))
2576                                         [mj AnnBang $1] }
2577
2578 apats  :: { [LPat RdrName] }
2579         : apat apats            { $1 : $2 }
2580         | {- empty -}           { [] }
2581
2582 -----------------------------------------------------------------------------
2583 -- Statement sequences
2584
2585 stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2586         : '{'           stmts '}'       { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2587                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
2588         |     vocurly   stmts close     { L (gl $2) (fst $ unLoc $2
2589                                                     ,reverse $ snd $ unLoc $2) }
2590
2591 --      do { ;; s ; s ; ; s ;; }
2592 -- The last Stmt should be an expression, but that's hard to enforce
2593 -- here, because we need too much lookahead if we see do { e ; }
2594 -- So we use BodyStmts throughout, and switch the last one over
2595 -- in ParseUtils.checkDo instead
2596 -- AZ: TODO check that we can retrieve multiple semis.
2597
2598 stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2599         : stmts ';' stmt  {% if null (snd $ unLoc $1)
2600                               then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2601                                                      ,$3 : (snd $ unLoc $1)))
2602                               else do
2603                                { ams (head $ snd $ unLoc $1) [mj AnnSemi $2]
2604                                ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(snd $ unLoc $1)) }}
2605
2606         | stmts ';'     {% if null (snd $ unLoc $1)
2607                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1),snd $ unLoc $1))
2608                              else do
2609                                { ams (head $ snd $ unLoc $1)
2610                                                [mj AnnSemi $2]
2611                                ; return $1 } }
2612         | stmt                   { sL1 $1 ([],[$1]) }
2613         | {- empty -}            { noLoc ([],[]) }
2614
2615
2616 -- For typing stmts at the GHCi prompt, where
2617 -- the input may consist of just comments.
2618 maybe_stmt :: { Maybe (LStmt RdrName (LHsExpr RdrName)) }
2619         : stmt                          { Just $1 }
2620         | {- nothing -}                 { Nothing }
2621
2622 stmt  :: { LStmt RdrName (LHsExpr RdrName) }
2623         : qual                          { $1 }
2624         | 'rec' stmtlist                {% ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
2625                                                (mj AnnRec $1:(fst $ unLoc $2)) }
2626
2627 qual  :: { LStmt RdrName (LHsExpr RdrName) }
2628     : bindpat '<-' exp                  {% ams (sLL $1 $> $ mkBindStmt $1 $3)
2629                                                [mj AnnLarrow $2] }
2630     | exp                               { sL1 $1 $ mkBodyStmt $1 }
2631     | 'let' binds                       {% ams (sLL $1 $>$ LetStmt (snd $ unLoc $2))
2632                                                (mj AnnLet $1:(fst $ unLoc $2)) }
2633
2634 -----------------------------------------------------------------------------
2635 -- Record Field Update/Construction
2636
2637 fbinds  :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2638         : fbinds1                       { $1 }
2639         | {- empty -}                   { ([],([], False)) }
2640
2641 fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2642         : fbind ',' fbinds1
2643                 {% addAnnotation (gl $1) AnnComma (gl $2) >>
2644                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
2645         | fbind                         { ([],([$1], False)) }
2646         | '..'                          { ([mj AnnDotdot $1],([],   True)) }
2647
2648 fbind   :: { LHsRecField RdrName (LHsExpr RdrName) }
2649         : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField $1 $3             False)
2650                                 [mj AnnEqual $2] }
2651                         -- RHS is a 'texp', allowing view patterns (Trac #6038)
2652                         -- and, incidentaly, sections.  Eg
2653                         -- f (R { x = show -> s }) = ...
2654
2655         | qvar          { sLL $1 $> $ HsRecField $1 placeHolderPunRhs True }
2656                         -- In the punning case, use a place-holder
2657                         -- The renamer fills in the final value
2658
2659 -----------------------------------------------------------------------------
2660 -- Implicit Parameter Bindings
2661
2662 dbinds  :: { Located [LIPBind RdrName] }
2663         : dbinds ';' dbind
2664                       {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2665                          return (let { this = $3; rest = unLoc $1 }
2666                               in rest `seq` this `seq` sLL $1 $> (this : rest)) }
2667         | dbinds ';'  {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2668                          return (sLL $1 $> (unLoc $1)) }
2669         | dbind                        { let this = $1 in this `seq` sL1 $1 [this] }
2670 --      | {- empty -}                  { [] }
2671
2672 dbind   :: { LIPBind RdrName }
2673 dbind   : ipvar '=' exp                {% ams (sLL $1 $> (IPBind (Left $1) $3))
2674                                               [mj AnnEqual $2] }
2675
2676 ipvar   :: { Located HsIPName }
2677         : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
2678
2679 -----------------------------------------------------------------------------
2680 -- Warnings and deprecations
2681
2682 name_boolformula_opt :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2683         : name_boolformula          { $1 }
2684         | {- empty -}               { ([],mkTrue) }
2685
2686 name_boolformula :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2687         : name_boolformula_and                      { $1 }
2688         | name_boolformula_and '|' name_boolformula
2689                                              { ((mj AnnVbar $2:fst $1)++(fst $3)
2690                                                 ,Or [snd $1,snd $3]) }
2691
2692 name_boolformula_and :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2693         : name_boolformula_atom                             { $1 }
2694         | name_boolformula_atom ',' name_boolformula_and
2695                   { ((mj AnnComma $2:fst $1)++(fst $3), And [snd $1,snd $3]) }
2696
2697 name_boolformula_atom :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2698         : '(' name_boolformula ')'  { ((mop $1:mcp $3:(fst $2)),snd $2) }
2699         | name_var                  { ([],Var $1) }
2700
2701 namelist :: { Located [Located RdrName] }
2702 namelist : name_var              { sL1 $1 [$1] }
2703          | name_var ',' namelist {% addAnnotation (gl $1) AnnComma (gl $2) >>
2704                                     return (sLL $1 $> ($1 : unLoc $3)) }
2705
2706 name_var :: { Located RdrName }
2707 name_var : var { $1 }
2708          | con { $1 }
2709
2710 -----------------------------------------
2711 -- Data constructors
2712 -- There are two different productions here as lifted list constructors
2713 -- are parsed differently.
2714
2715 qcon_nowiredlist :: { Located RdrName }
2716         : gen_qcon                     { $1 }
2717         | sysdcon_nolist               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2718
2719 qcon :: { Located RdrName }
2720   : gen_qcon              { $1}
2721   | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2722
2723 gen_qcon :: { Located RdrName }
2724   : qconid                { $1 }
2725   | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))
2726                                    [mop $1,mj AnnVal $2,mcp $3] }
2727
2728 -- The case of '[:' ':]' is part of the production `parr'
2729
2730 con     :: { Located RdrName }
2731         : conid                 { $1 }
2732         | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))
2733                                        [mop $1,mj AnnVal $2,mcp $3] }
2734         | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2735
2736 con_list :: { Located [Located RdrName] }
2737 con_list : con                  { sL1 $1 [$1] }
2738          | con ',' con_list     {% addAnnotation (gl $1) AnnComma (gl $2) >>
2739                                    return (sLL $1 $> ($1 : unLoc $3)) }
2740
2741 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
2742         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
2743         | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
2744                                        (mop $1:mcp $3:(mcommas (fst $2))) }
2745         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
2746         | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
2747                                        (mo $1:mc $3:(mcommas (fst $2))) }
2748
2749 sysdcon :: { Located DataCon }
2750         : sysdcon_nolist                 { $1 }
2751         | '[' ']'               {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] }
2752
2753 conop :: { Located RdrName }
2754         : consym                { $1 }
2755         | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2))
2756                                        [mj AnnBackquote $1,mj AnnVal $2
2757                                        ,mj AnnBackquote $3] }
2758
2759 qconop :: { Located RdrName }
2760         : qconsym               { $1 }
2761         | '`' qconid '`'        {% ams (sLL $1 $> (unLoc $2))
2762                                        [mj AnnBackquote $1,mj AnnVal $2
2763                                        ,mj AnnBackquote $3] }
2764
2765 ----------------------------------------------------------------------------
2766 -- Type constructors
2767
2768
2769 -- See Note [Unit tuples] in HsTypes for the distinction
2770 -- between gtycon and ntgtycon
2771 gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
2772         : ntgtycon                     { $1 }
2773         | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)
2774                                               [mop $1,mcp $2] }
2775         | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)
2776                                               [mo $1,mc $2] }
2777
2778 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
2779         : oqtycon               { $1 }
2780         | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
2781                                                         (snd $2 + 1)))
2782                                        (mop $1:mcp $3:(mcommas (fst $2))) }
2783         | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
2784                                                         (snd $2 + 1)))
2785                                        (mo $1:mc $3:(mcommas (fst $2))) }
2786         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
2787                                        [mop $1,mj AnnRarrow $2,mcp $3] }
2788         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
2789         | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
2790         | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
2791                                         [mop $1,mj AnnTildehsh $2,mcp $3] }
2792
2793 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
2794                                 -- These can appear in export lists
2795         : qtycon                        { $1 }
2796         | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2))
2797                                                [mop $1,mj AnnVal $2,mcp $3] }
2798         | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)
2799                                                [mop $1,mj AnnTilde $2,mcp $3] }
2800
2801 oqtycon_no_varcon :: { Located RdrName }  -- Type constructor which cannot be mistaken
2802                                           -- for variable constructor in export lists
2803                                           -- see Note [Type constructors in export list]
2804         :  qtycon            { $1 }
2805         | '(' QCONSYM ')'    {% let name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2)
2806                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
2807         | '(' CONSYM ')'     {% let name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2)
2808                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
2809         | '(' ':' ')'        {% let name = sL1 $2 $! consDataCon_RDR
2810                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
2811         | '(' '~' ')'        {% ams (sLL $1 $> $ eqTyCon_RDR) [mop $1,mj AnnTilde $2,mcp $3] }
2812
2813 {- Note [Type constructors in export list]
2814 ~~~~~~~~~~~~~~~~~~~~~
2815 Mixing type constructors and variable constructors in export lists introduces
2816 ambiguity in grammar: e.g. (*) may be both a type constructor and a function.
2817
2818 -XExplicitNamespaces allows to disambiguate by explicitly prefixing type
2819 constructors with 'type' keyword.
2820
2821 This ambiguity causes reduce/reduce conflicts in parser, which are always
2822 resolved in favour of variable constructors. To get rid of conflicts we demand
2823 that ambigous type constructors (those, which are formed by the same
2824 productions as variable constructors) are always prefixed with 'type' keyword.
2825 Unambigous type constructors may occur both with or without 'type' keyword.
2826 -}
2827
2828 qtyconop :: { Located RdrName } -- Qualified or unqualified
2829         : qtyconsym                     { $1 }
2830         | '`' qtycon '`'                {% ams (sLL $1 $> (unLoc $2))
2831                                                [mj AnnBackquote $1,mj AnnVal $2
2832                                                ,mj AnnBackquote $3] }
2833
2834 qtycon :: { Located RdrName }   -- Qualified or unqualified
2835         : QCONID            { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
2836         | tycon             { $1 }
2837
2838 tycon   :: { Located RdrName }  -- Unqualified
2839         : CONID                   { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
2840
2841 qtyconsym :: { Located RdrName }
2842         : QCONSYM            { sL1 $1 $! mkQual tcClsName (getQCONSYM $1) }
2843         | QVARSYM            { sL1 $1 $! mkQual tcClsName (getQVARSYM $1) }
2844         | tyconsym           { $1 }
2845
2846 -- Does not include "!", because that is used for strictness marks
2847 --               or ".", because that separates the quantified type vars from the rest
2848 tyconsym :: { Located RdrName }
2849         : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
2850         | VARSYM                { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
2851         | ':'                   { sL1 $1 $! consDataCon_RDR }
2852         | '*'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "*") }
2853         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
2854
2855
2856 -----------------------------------------------------------------------------
2857 -- Operators
2858
2859 op      :: { Located RdrName }   -- used in infix decls
2860         : varop                 { $1 }
2861         | conop                 { $1 }
2862
2863 varop   :: { Located RdrName }
2864         : varsym                { $1 }
2865         | '`' varid '`'         {% ams (sLL $1 $> (unLoc $2))
2866                                        [mj AnnBackquote $1,mj AnnVal $2
2867                                        ,mj AnnBackquote $3] }
2868
2869 qop     :: { LHsExpr RdrName }   -- used in sections
2870         : qvarop                { sL1 $1 $ HsVar (unLoc $1) }
2871         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2872
2873 qopm    :: { LHsExpr RdrName }   -- used in sections
2874         : qvaropm               { sL1 $1 $ HsVar (unLoc $1) }
2875         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2876
2877 qvarop :: { Located RdrName }
2878         : qvarsym               { $1 }
2879         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
2880                                        [mj AnnBackquote $1,mj AnnVal $2
2881                                        ,mj AnnBackquote $3] }
2882
2883 qvaropm :: { Located RdrName }
2884         : qvarsym_no_minus      { $1 }
2885         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
2886                                        [mj AnnBackquote $1,mj AnnVal $2
2887                                        ,mj AnnBackquote $3] }
2888
2889 -----------------------------------------------------------------------------
2890 -- Type variables
2891
2892 tyvar   :: { Located RdrName }
2893 tyvar   : tyvarid               { $1 }
2894
2895 tyvarop :: { Located RdrName }
2896 tyvarop : '`' tyvarid '`'       {% ams (sLL $1 $> (unLoc $2))
2897                                        [mj AnnBackquote $1,mj AnnVal $2
2898                                        ,mj AnnBackquote $3] }
2899         | '.'                   {% parseErrorSDoc (getLoc $1)
2900                                       (vcat [ptext (sLit "Illegal symbol '.' in type"),
2901                                              ptext (sLit "Perhaps you intended to use RankNTypes or a similar language"),
2902                                              ptext (sLit "extension to enable explicit-forall syntax: forall <tvs>. <type>")])
2903                                 }
2904
2905 tyvarid :: { Located RdrName }
2906         : VARID            { sL1 $1 $! mkUnqual tvName (getVARID $1) }
2907         | special_id       { sL1 $1 $! mkUnqual tvName (unLoc $1) }
2908         | 'unsafe'         { sL1 $1 $! mkUnqual tvName (fsLit "unsafe") }
2909         | 'safe'           { sL1 $1 $! mkUnqual tvName (fsLit "safe") }
2910         | 'interruptible'  { sL1 $1 $! mkUnqual tvName (fsLit "interruptible") }
2911
2912 -----------------------------------------------------------------------------
2913 -- Variables
2914
2915 var     :: { Located RdrName }
2916         : varid                 { $1 }
2917         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
2918                                        [mop $1,mj AnnVal $2,mcp $3] }
2919
2920 qvar    :: { Located RdrName }
2921         : qvarid                { $1 }
2922         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
2923                                        [mop $1,mj AnnVal $2,mcp $3] }
2924         | '(' qvarsym1 ')'      {% ams (sLL $1 $> (unLoc $2))
2925                                        [mop $1,mj AnnVal $2,mcp $3] }
2926 -- We've inlined qvarsym here so that the decision about
2927 -- whether it's a qvar or a var can be postponed until
2928 -- *after* we see the close paren.
2929
2930 qvarid :: { Located RdrName }
2931         : varid               { $1 }
2932         | QVARID              { sL1 $1 $! mkQual varName (getQVARID $1) }
2933
2934 -- Note that 'role' and 'family' get lexed separately regardless of
2935 -- the use of extensions. However, because they are listed here, this
2936 -- is OK and they can be used as normal varids.
2937 varid :: { Located RdrName }
2938         : VARID            { sL1 $1 $! mkUnqual varName (getVARID $1) }
2939         | special_id       { sL1 $1 $! mkUnqual varName (unLoc $1) }
2940         | 'unsafe'         { sL1 $1 $! mkUnqual varName (fsLit "unsafe") }
2941         | 'safe'           { sL1 $1 $! mkUnqual varName (fsLit "safe") }
2942         | 'interruptible'  { sL1 $1 $! mkUnqual varName (fsLit "interruptible")}
2943         | 'forall'         { sL1 $1 $! mkUnqual varName (fsLit "forall") }
2944         | 'family'         { sL1 $1 $! mkUnqual varName (fsLit "family") }
2945         | 'role'           { sL1 $1 $! mkUnqual varName (fsLit "role") }
2946
2947 qvarsym :: { Located RdrName }
2948         : varsym                { $1 }
2949         | qvarsym1              { $1 }
2950
2951 qvarsym_no_minus :: { Located RdrName }
2952         : varsym_no_minus       { $1 }
2953         | qvarsym1              { $1 }
2954
2955 qvarsym1 :: { Located RdrName }
2956 qvarsym1 : QVARSYM              { sL1 $1 $ mkQual varName (getQVARSYM $1) }
2957
2958 varsym :: { Located RdrName }
2959         : varsym_no_minus       { $1 }
2960         | '-'                   { sL1 $1 $ mkUnqual varName (fsLit "-") }
2961
2962 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
2963         : VARSYM               { sL1 $1 $ mkUnqual varName (getVARSYM $1) }
2964         | special_sym          { sL1 $1 $ mkUnqual varName (unLoc $1) }
2965
2966
2967 -- These special_ids are treated as keywords in various places,
2968 -- but as ordinary ids elsewhere.   'special_id' collects all these
2969 -- except 'unsafe', 'interruptible', 'forall', 'family', and 'role',
2970 -- whose treatment differs depending on context
2971 special_id :: { Located FastString }
2972 special_id
2973         : 'as'                  { sL1 $1 (fsLit "as") }
2974         | 'qualified'           { sL1 $1 (fsLit "qualified") }
2975         | 'hiding'              { sL1 $1 (fsLit "hiding") }
2976         | 'export'              { sL1 $1 (fsLit "export") }
2977         | 'label'               { sL1 $1 (fsLit "label")  }
2978         | 'dynamic'             { sL1 $1 (fsLit "dynamic") }
2979         | 'stdcall'             { sL1 $1 (fsLit "stdcall") }
2980         | 'ccall'               { sL1 $1 (fsLit "ccall") }
2981         | 'capi'                { sL1 $1 (fsLit "capi") }
2982         | 'prim'                { sL1 $1 (fsLit "prim") }
2983         | 'javascript'          { sL1 $1 (fsLit "javascript") }
2984         | 'group'               { sL1 $1 (fsLit "group") }
2985
2986 special_sym :: { Located FastString }
2987 special_sym : '!'       {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
2988             | '.'       { sL1 $1 (fsLit ".") }
2989             | '*'       { sL1 $1 (fsLit "*") }
2990
2991 -----------------------------------------------------------------------------
2992 -- Data constructors
2993
2994 qconid :: { Located RdrName }   -- Qualified or unqualified
2995         : conid              { $1 }
2996         | QCONID             { sL1 $1 $! mkQual dataName (getQCONID $1) }
2997
2998 conid   :: { Located RdrName }
2999         : CONID                { sL1 $1 $ mkUnqual dataName (getCONID $1) }
3000
3001 qconsym :: { Located RdrName }  -- Qualified or unqualified
3002         : consym               { $1 }
3003         | QCONSYM              { sL1 $1 $ mkQual dataName (getQCONSYM $1) }
3004
3005 consym :: { Located RdrName }
3006         : CONSYM              { sL1 $1 $ mkUnqual dataName (getCONSYM $1) }
3007
3008         -- ':' means only list cons
3009         | ':'                { sL1 $1 $ consDataCon_RDR }
3010
3011
3012 -----------------------------------------------------------------------------
3013 -- Literals
3014
3015 literal :: { Located HsLit }
3016         : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }
3017         | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)
3018                                                    $ getSTRING $1 }
3019         | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)
3020                                                    $ getPRIMINTEGER $1 }
3021         | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)
3022                                                    $ getPRIMWORD $1 }
3023         | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)
3024                                                    $ getPRIMCHAR $1 }
3025         | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
3026                                                    $ getPRIMSTRING $1 }
3027         | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
3028         | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
3029
3030 -----------------------------------------------------------------------------
3031 -- Layout
3032
3033 close :: { () }
3034         : vccurly               { () } -- context popped in lexer.
3035         | error                 {% popContext }
3036
3037 -----------------------------------------------------------------------------
3038 -- Miscellaneous (mostly renamings)
3039
3040 modid   :: { Located ModuleName }
3041         : CONID                 { sL1 $1 $ mkModuleNameFS (getCONID $1) }
3042         | QCONID                { sL1 $1 $ let (mod,c) = getQCONID $1 in
3043                                   mkModuleNameFS
3044                                    (mkFastString
3045                                      (unpackFS mod ++ '.':unpackFS c))
3046                                 }
3047
3048 commas :: { ([SrcSpan],Int) }   -- One or more commas
3049         : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }
3050         | ','                    { ([gl $1],1) }
3051
3052 -----------------------------------------------------------------------------
3053 -- Documentation comments
3054
3055 docnext :: { LHsDocString }
3056   : DOCNEXT {% return (sL1 $1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
3057
3058 docprev :: { LHsDocString }
3059   : DOCPREV {% return (sL1 $1 (HsDocString (mkFastString (getDOCPREV $1)))) }
3060
3061 docnamed :: { Located (String, HsDocString) }
3062   : DOCNAMED {%
3063       let string = getDOCNAMED $1
3064           (name, rest) = break isSpace string
3065       in return (sL1 $1 (name, HsDocString (mkFastString rest))) }
3066
3067 docsection :: { Located (Int, HsDocString) }
3068   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
3069         return (sL1 $1 (n, HsDocString (mkFastString doc))) }
3070
3071 moduleheader :: { Maybe LHsDocString }
3072         : DOCNEXT {% let string = getDOCNEXT $1 in
3073                      return (Just (sL1 $1 (HsDocString (mkFastString string)))) }
3074
3075 maybe_docprev :: { Maybe LHsDocString }
3076         : docprev                       { Just $1 }
3077         | {- empty -}                   { Nothing }
3078
3079 maybe_docnext :: { Maybe LHsDocString }
3080         : docnext                       { Just $1 }
3081         | {- empty -}                   { Nothing }
3082
3083 {
3084 happyError :: P a
3085 happyError = srcParseFail
3086
3087 getVARID        (L _ (ITvarid    x)) = x
3088 getCONID        (L _ (ITconid    x)) = x
3089 getVARSYM       (L _ (ITvarsym   x)) = x
3090 getCONSYM       (L _ (ITconsym   x)) = x
3091 getQVARID       (L _ (ITqvarid   x)) = x
3092 getQCONID       (L _ (ITqconid   x)) = x
3093 getQVARSYM      (L _ (ITqvarsym  x)) = x
3094 getQCONSYM      (L _ (ITqconsym  x)) = x
3095 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
3096 getCHAR         (L _ (ITchar   _ x)) = x
3097 getSTRING       (L _ (ITstring _ x)) = x
3098 getINTEGER      (L _ (ITinteger _ x)) = x
3099 getRATIONAL     (L _ (ITrational x)) = x
3100 getPRIMCHAR     (L _ (ITprimchar _ x)) = x
3101 getPRIMSTRING   (L _ (ITprimstring _ x)) = x
3102 getPRIMINTEGER  (L _ (ITprimint  _ x)) = x
3103 getPRIMWORD     (L _ (ITprimword _ x)) = x
3104 getPRIMFLOAT    (L _ (ITprimfloat x)) = x
3105 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
3106 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
3107 getTH_ID_TY_SPLICE (L _ (ITidTyEscape x)) = x
3108 getINLINE       (L _ (ITinline_prag _ inl conl)) = (inl,conl)
3109 getSPEC_INLINE  (L _ (ITspec_inline_prag _ True))  = (Inline,  FunLike)
3110 getSPEC_INLINE  (L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)
3111
3112 getDOCNEXT (L _ (ITdocCommentNext x)) = x
3113 getDOCPREV (L _ (ITdocCommentPrev x)) = x
3114 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
3115 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
3116
3117 getCHARs        (L _ (ITchar       src _)) = src
3118 getSTRINGs      (L _ (ITstring     src _)) = src
3119 getINTEGERs     (L _ (ITinteger    src _)) = src
3120 getPRIMCHARs    (L _ (ITprimchar   src _)) = src
3121 getPRIMSTRINGs  (L _ (ITprimstring src _)) = src
3122 getPRIMINTEGERs (L _ (ITprimint    src _)) = src
3123 getPRIMWORDs    (L _ (ITprimword   src _)) = src
3124
3125 -- See Note [Pragma source text] in BasicTypes for the following
3126 getINLINE_PRAGs       (L _ (ITinline_prag       src _ _)) = src
3127 getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src
3128 getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src
3129 getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src
3130 getRULES_PRAGs        (L _ (ITrules_prag        src)) = src
3131 getWARNING_PRAGs      (L _ (ITwarning_prag      src)) = src
3132 getDEPRECATED_PRAGs   (L _ (ITdeprecated_prag   src)) = src
3133 getSCC_PRAGs          (L _ (ITscc_prag          src)) = src
3134 getGENERATED_PRAGs    (L _ (ITgenerated_prag    src)) = src
3135 getCORE_PRAGs         (L _ (ITcore_prag         src)) = src
3136 getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src
3137 getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src
3138 getANN_PRAGs          (L _ (ITann_prag          src)) = src
3139 getVECT_PRAGs         (L _ (ITvect_prag         src)) = src
3140 getVECT_SCALAR_PRAGs  (L _ (ITvect_scalar_prag  src)) = src
3141 getNOVECT_PRAGs       (L _ (ITnovect_prag       src)) = src
3142 getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src
3143 getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src
3144 getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src
3145 getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src
3146 getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src
3147 getCTYPEs             (L _ (ITctype             src)) = src
3148
3149 getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l)
3150
3151 getSCC :: Located Token -> P FastString
3152 getSCC lt = do let s = getSTRING lt
3153                    err = "Spaces are not allowed in SCCs"
3154                -- We probably actually want to be more restrictive than this
3155                if ' ' `elem` unpackFS s
3156                    then failSpanMsgP (getLoc lt) (text err)
3157                    else return s
3158
3159 -- Utilities for combining source spans
3160 comb2 :: Located a -> Located b -> SrcSpan
3161 comb2 a b = a `seq` b `seq` combineLocs a b
3162
3163 comb3 :: Located a -> Located b -> Located c -> SrcSpan
3164 comb3 a b c = a `seq` b `seq` c `seq`
3165     combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
3166
3167 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
3168 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
3169     (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
3170                 combineSrcSpans (getLoc c) (getLoc d))
3171
3172 -- strict constructor version:
3173 {-# INLINE sL #-}
3174 sL :: SrcSpan -> a -> Located a
3175 sL span a = span `seq` a `seq` L span a
3176
3177 -- See Note [Adding location info] for how these utility functions are used
3178
3179 -- replaced last 3 CPP macros in this file
3180 {-# INLINE sL0 #-}
3181 sL0 :: a -> Located a
3182 sL0 = L noSrcSpan       -- #define L0   L noSrcSpan
3183
3184 {-# INLINE sL1 #-}
3185 sL1 :: Located a -> b -> Located b
3186 sL1 x = sL (getLoc x)   -- #define sL1   sL (getLoc $1)
3187
3188 {-# INLINE sLL #-}
3189 sLL :: Located a -> Located b -> c -> Located c
3190 sLL x y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
3191
3192 {- Note [Adding location info]
3193    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
3194
3195 This is done using the three functions below, sL0, sL1
3196 and sLL.  Note that these functions were mechanically
3197 converted from the three macros that used to exist before,
3198 namely L0, L1 and LL.
3199
3200 They each add a SrcSpan to their argument.
3201
3202    sL0  adds 'noSrcSpan', used for empty productions
3203      -- This doesn't seem to work anymore -=chak
3204
3205    sL1  for a production with a single token on the lhs.  Grabs the SrcSpan
3206         from that token.
3207
3208    sLL  for a production with >1 token on the lhs.  Makes up a SrcSpan from
3209         the first and last tokens.
3210
3211 These suffice for the majority of cases.  However, we must be
3212 especially careful with empty productions: sLL won't work if the first
3213 or last token on the lhs can represent an empty span.  In these cases,
3214 we have to calculate the span using more of the tokens from the lhs, eg.
3215
3216         | 'newtype' tycl_hdr '=' newconstr deriving
3217                 { L (comb3 $1 $4 $5)
3218                     (mkTyData NewType (unLoc $2) $4 (unLoc $5)) }
3219
3220 We provide comb3 and comb4 functions which are useful in such cases.
3221
3222 Be careful: there's no checking that you actually got this right, the
3223 only symptom will be that the SrcSpans of your syntax will be
3224 incorrect.
3225
3226 -}
3227
3228 -- Make a source location for the file.  We're a bit lazy here and just
3229 -- make a point SrcSpan at line 1, column 0.  Strictly speaking we should
3230 -- try to find the span of the whole file (ToDo).
3231 fileSrcSpan :: P SrcSpan
3232 fileSrcSpan = do
3233   l <- getSrcLoc;