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

{
11 12 13 14 15 16 17 18 19 20 21 22
-- | This module provides the generated Happy parser for Haskell. It exports
-- a number of parsers which may be used in any library that uses the GHC API.
-- A common usage pattern is to initialize the parser state with a given string
-- and then parse that string:
--
-- @
--     runParser :: DynFlags -> String -> P a -> ParseResult a
--     runParser flags str parser = unP parser parseState
--     where
--       filename = "\<interactive\>"
--       location = mkRealSrcLoc (mkFastString filename) 1 1
--       buffer = stringToStringBuffer str
23
--       parseState = mkPState flags buffer location
24
-- @
Edward Z. Yang's avatar
Edward Z. Yang committed
25
module Parser (parseModule, parseSignature, parseImport, parseStatement, parseBackpack,
26 27
               parseDeclaration, parseExpression, parsePattern,
               parseTypeSignature,
28
               parseStmt, parseIdentifier,
29 30
               parseType, parseHeader) where

rodlogic's avatar
rodlogic committed
31 32 33 34 35
-- base
import Control.Monad    ( unless, liftM )
import GHC.Exts
import Data.Char
import Control.Monad    ( mplus )
36
import Control.Applicative ((<$))
37

rodlogic's avatar
rodlogic committed
38
-- compiler/hsSyn
39
import HsSyn
rodlogic's avatar
rodlogic committed
40 41

-- compiler/main
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
42
import HscTypes         ( IsBootInterface, WarningTxt(..) )
rodlogic's avatar
rodlogic committed
43
import DynFlags
Edward Z. Yang's avatar
Edward Z. Yang committed
44 45
import BkpSyn
import PackageConfig
rodlogic's avatar
rodlogic committed
46 47 48

-- compiler/utils
import OrdList
49
import BooleanFormula   ( BooleanFormula(..), LBooleanFormula(..), mkTrue )
rodlogic's avatar
rodlogic committed
50 51 52 53 54
import FastString
import Maybes           ( orElse )
import Outputable

-- compiler/basicTypes
55
import RdrName
thomasw's avatar
thomasw committed
56
import OccName          ( varName, dataName, tcClsName, tvName, startsWithUnderscore )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
57
import DataCon          ( DataCon, dataConName )
Ian Lynagh's avatar
Ian Lynagh committed
58
import SrcLoc
59
import Module
rodlogic's avatar
rodlogic committed
60 61 62 63
import BasicTypes

-- compiler/types
import Type             ( funTyCon )
64
import Kind             ( Kind )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
65
import Class            ( FunDep )
rodlogic's avatar
rodlogic committed
66 67 68 69

-- compiler/parser
import RdrHsSyn
import Lexer
70
import HaddockUtils
Alan Zimmerman's avatar
Alan Zimmerman committed
71
import ApiAnnotation
72

rodlogic's avatar
rodlogic committed
73 74
-- compiler/typecheck
import TcEvidence       ( emptyTcEvBinds )
75

rodlogic's avatar
rodlogic committed
76 77
-- compiler/prelude
import ForeignCall
78 79
import TysPrim          ( eqPrimTyCon )
import PrelNames        ( eqTyCon_RDR )
80
import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
rodlogic's avatar
rodlogic committed
81
                          unboxedUnitTyCon, unboxedUnitDataCon,
82
                          listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
Alan Zimmerman's avatar
Alan Zimmerman committed
83

84 85
-- compiler/utils
import Util             ( looksLikePackageName )
86
import Prelude
87

88
import qualified GHC.LanguageExtensions as LangExt
89 90
}

91
%expect 36 -- shift/reduce conflicts
92

Ryan Scott's avatar
Ryan Scott committed
93
{- Last updated: 3 Aug 2016
94

95 96
If you modify this parser and add a conflict, please update this comment.
You can learn more about the conflicts by passing 'happy' the -i flag:
97

98
    happy -agc --strict compiler/parser/Parser.y -idetailed-info
99

100
How is this section formatted? Look up the state the conflict is
101 102 103 104
reported at, and copy the list of applicable rules (at the top, without the
rule numbers).  Mark *** for the rule that is the conflicting reduction (that
is, the interpretation which is NOT taken).  NB: Happy doesn't print a rule
in a state if it is empty, but you should include it in the list (you can
105
look these up in the Grammar section of the info file).
106

107 108 109
Obviously the state numbers are not stable across modifications to the parser,
the idea is to reproduce enough information on each conflict so you can figure
out what happened if the states were renumbered.  Try not to gratuitously move
110
productions around in this file.
111

112
-------------------------------------------------------------------------------
Gabor Greif's avatar
Gabor Greif committed
113

114
state 0 contains 1 shift/reduce conflicts.
Gabor Greif's avatar
Gabor Greif committed
115

116
    Conflicts: DOCNEXT (empty missing_module_keyword reduces)
117

118 119 120
Ambiguity when the source file starts with "-- | doc". We need another
token of lookahead to determine if a top declaration or the 'module' keyword
follows. Shift parses as if the 'module' keyword follows.
121

122
-------------------------------------------------------------------------------
123

Ryan Scott's avatar
Ryan Scott committed
124
state 48 contains 2 shift/reduce conflicts.
125

126 127
    *** strict_mark -> unpackedness .
        strict_mark -> unpackedness . strictness
128 129 130 131 132

    Conflicts: '~' '!'

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

Ryan Scott's avatar
Ryan Scott committed
133
state 52 contains 1 shift/reduce conflict.
134

135 136 137
        context -> btype .
    *** type -> btype .
        type -> btype . '->' ctype
138

139
    Conflicts: '->'
140

141 142
-------------------------------------------------------------------------------

Ryan Scott's avatar
Ryan Scott committed
143
state 53 contains 9 shift/reduce conflicts.
144

145 146
    *** btype -> tyapps .
        tyapps -> tyapps . tyapp
147

148
    Conflicts: ':' '-' '!' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
149

150
-------------------------------------------------------------------------------
151

Ryan Scott's avatar
Ryan Scott committed
152
state 134 contains 14 shift/reduce conflicts.
153

154 155 156 157 158 159 160
        exp -> infixexp . '::' sigtype
        exp -> infixexp . '-<' exp
        exp -> infixexp . '>-' exp
        exp -> infixexp . '-<<' exp
        exp -> infixexp . '>>-' exp
    *** exp -> infixexp .
        infixexp -> infixexp . qop exp10
161

162
    Conflicts: ':' '::' '-' '!' '-<' '>-' '-<<' '>>-'
163
               '.' '`' VARSYM CONSYM QVARSYM QCONSYM
164

165 166 167 168
Examples of ambiguity:
    'if x then y else z -< e'
    'if x then y else z :: T'
    'if x then y else z + 1' (NB: '+' is in VARSYM)
169

170 171 172 173
Shift parses as (per longest-parse rule):
    'if x then y else (z -< T)'
    'if x then y else (z :: T)'
    'if x then y else (z + 1)'
174

175
-------------------------------------------------------------------------------
176

Ryan Scott's avatar
Ryan Scott committed
177
state 299 contains 1 shift/reduce conflicts.
178

179
        rule -> STRING . rule_activation rule_forall infixexp '=' exp
180

181
    Conflict: '[' (empty rule_activation reduces)
182

183 184 185
We don't know whether the '[' starts the activation or not: it
might be the start of the declaration with the activation being
empty.  --SDM 1/4/2002
186

187 188
Example ambiguity:
    '{-# RULE [0] f = ... #-}'
189

190 191
We parse this as having a [0] rule activation for rewriting 'f', rather
a rule instructing how to rewrite the expression '[0] f'.
192

193
-------------------------------------------------------------------------------
ross's avatar
ross committed
194

Ryan Scott's avatar
Ryan Scott committed
195
state 309 contains 1 shift/reduce conflict.
196

197 198
    *** type -> btype .
        type -> btype . '->' ctype
199

200
    Conflict: '->'
201

202
Same as state 50 but without contexts.
203

204
-------------------------------------------------------------------------------
205

Ryan Scott's avatar
Ryan Scott committed
206
state 348 contains 1 shift/reduce conflicts.
207

208 209 210
        tup_exprs -> commas . tup_tail
        sysdcon_nolist -> '(' commas . ')'
        commas -> commas . ','
211

212
    Conflict: ')' (empty tup_tail reduces)
213

214 215 216 217
A tuple section with NO free variables '(,,)' is indistinguishable
from the Haskell98 data constructor for a tuple.  Shift resolves in
favor of sysdcon, which is good because a tuple section will get rejected
if -XTupleSections is not specified.
218

219
-------------------------------------------------------------------------------
220

Ryan Scott's avatar
Ryan Scott committed
221
state 402 contains 1 shift/reduce conflicts.
222

223 224 225
        tup_exprs -> commas . tup_tail
        sysdcon_nolist -> '(#' commas . '#)'
        commas -> commas . ','
226 227 228

    Conflict: '#)' (empty tup_tail reduces)

229
Same as State 324 for unboxed tuples.
230 231 232

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

Ryan Scott's avatar
Ryan Scott committed
233
state 477 contains 1 shift/reduce conflict.
234

235 236
        oqtycon -> '(' qtyconsym . ')'
    *** qtyconop -> qtyconsym .
237

238
    Conflict: ')'
239 240 241 242 243

TODO: Why?

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

Ryan Scott's avatar
Ryan Scott committed
244
state 658 contains 1 shift/reduce conflicts.
245

246 247
    *** aexp2 -> ipvar .
        dbind -> ipvar . '=' exp
248 249 250 251 252 253 254 255 256 257 258

    Conflict: '='

Example ambiguity: 'let ?x ...'

The parser can't tell whether the ?x is the lhs of a normal binding or
an implicit binding.  Fortunately, resolving as shift gives it the only
sensible meaning, namely the lhs of an implicit binding.

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

Ryan Scott's avatar
Ryan Scott committed
259
state 731 contains 1 shift/reduce conflicts.
260

261
        rule -> STRING rule_activation . rule_forall infixexp '=' exp
262 263 264 265 266 267 268 269 270 271 272 273 274 275

    Conflict: 'forall' (empty rule_forall reduces)

Example ambiguity: '{-# RULES "name" forall = ... #-}'

'forall' is a valid variable name---we don't know whether
to treat a forall on the input as the beginning of a quantifier
or the beginning of the rule itself.  Resolving to shift means
it's always treated as a quantifier, hence the above is disallowed.
This saves explicitly defining a grammar for the rule lhs that
doesn't include 'forall'.

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

Ryan Scott's avatar
Ryan Scott committed
276
state 963 contains 1 shift/reduce conflicts.
277

278 279 280
        transformqual -> 'then' 'group' . 'using' exp
        transformqual -> 'then' 'group' . 'by' exp 'using' exp
    *** special_id -> 'group' .
281 282 283

    Conflict: 'by'

284 285
-------------------------------------------------------------------------------

Ryan Scott's avatar
Ryan Scott committed
286
state 1303 contains 1 shift/reduce conflict.
287

288 289
    *** atype -> tyvar .
        tv_bndr -> '(' tyvar . '::' kind ')'
290 291 292 293

    Conflict: '::'

TODO: Why?
294 295

-------------------------------------------------------------------------------
296
-- API Annotations
297
--
298 299 300 301 302 303 304 305 306 307 308

A lot of the productions are now cluttered with calls to
aa,am,ams,amms etc.

These are helper functions to make sure that the locations of the
various keywords such as do / let / in are captured for use by tools
that want to do source to source conversions, such as refactorers or
structured editors.

The helper functions are defined at the bottom of this file.

309 310 311 312
See
  https://ghc.haskell.org/trac/ghc/wiki/ApiAnnotations and
  https://ghc.haskell.org/trac/ghc/wiki/GhcAstAnnotations
for some background.
313

314 315 316 317 318
If you modify the parser and want to ensure that the API annotations are processed
correctly, see the README in (REPO)/utils/check-api-annotations for details on
how to set up a test using the check-api-annotations utility, and interpret the
output it generates.

319 320 321 322 323
-- -----------------------------------------------------------------------------

-}

%token
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
324 325
 '_'            { L _ ITunderscore }            -- Haskell keywords
 'as'           { L _ ITas }
326 327 328
 'case'         { L _ ITcase }
 'class'        { L _ ITclass }
 'data'         { L _ ITdata }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
 'default'      { L _ ITdefault }
 'deriving'     { L _ ITderiving }
 'do'           { L _ ITdo }
 'else'         { L _ ITelse }
 'hiding'       { L _ IThiding }
 'if'           { L _ ITif }
 'import'       { L _ ITimport }
 'in'           { L _ ITin }
 'infix'        { L _ ITinfix }
 'infixl'       { L _ ITinfixl }
 'infixr'       { L _ ITinfixr }
 'instance'     { L _ ITinstance }
 'let'          { L _ ITlet }
 'module'       { L _ ITmodule }
 'newtype'      { L _ ITnewtype }
 'of'           { L _ ITof }
 'qualified'    { L _ ITqualified }
 'then'         { L _ ITthen }
 'type'         { L _ ITtype }
 'where'        { L _ ITwhere }

350
 'forall'       { L _ (ITforall _) }                -- GHC extension keywords
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
351 352
 'foreign'      { L _ ITforeign }
 'export'       { L _ ITexport }
353
 'label'        { L _ ITlabel }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
354 355
 'dynamic'      { L _ ITdynamic }
 'safe'         { L _ ITsafe }
356
 'interruptible' { L _ ITinterruptible }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
357 358 359
 'unsafe'       { L _ ITunsafe }
 'mdo'          { L _ ITmdo }
 'family'       { L _ ITfamily }
360
 'role'         { L _ ITrole }
361 362
 'stdcall'      { L _ ITstdcallconv }
 'ccall'        { L _ ITccallconv }
363
 'capi'         { L _ ITcapiconv }
364
 'prim'         { L _ ITprimcallconv }
thoughtpolice's avatar
thoughtpolice committed
365
 'javascript'   { L _ ITjavascriptcallconv }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
366 367
 'proc'         { L _ ITproc }          -- for arrow notation extension
 'rec'          { L _ ITrec }           -- for arrow notation extension
368 369 370
 'group'    { L _ ITgroup }     -- for list transform extension
 'by'       { L _ ITby }        -- for list transform extension
 'using'    { L _ ITusing }     -- for list transform extension
cactus's avatar
cactus committed
371
 'pattern'      { L _ ITpattern } -- for pattern synonyms
Facundo Domínguez's avatar
Facundo Domínguez committed
372
 'static'       { L _ ITstatic }  -- for static pointers extension
Ryan Scott's avatar
Ryan Scott committed
373 374
 'stock'        { L _ ITstock }    -- for DerivingStrategies extension
 'anyclass'     { L _ ITanyclass } -- for DerivingStrategies extension
375

Edward Z. Yang's avatar
Edward Z. Yang committed
376 377 378 379
 'unit'         { L _ ITunit }
 'signature'    { L _ ITsignature }
 'dependency'   { L _ ITdependency }

380
 '{-# INLINE'             { L _ (ITinline_prag _ _ _) } -- INLINE or INLINABLE
Alan Zimmerman's avatar
Alan Zimmerman committed
381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402
 '{-# SPECIALISE'         { L _ (ITspec_prag _) }
 '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _ _) }
 '{-# SOURCE'             { L _ (ITsource_prag _) }
 '{-# RULES'              { L _ (ITrules_prag _) }
 '{-# CORE'               { L _ (ITcore_prag _) }      -- hdaume: annotated core
 '{-# SCC'                { L _ (ITscc_prag _)}
 '{-# GENERATED'          { L _ (ITgenerated_prag _) }
 '{-# DEPRECATED'         { L _ (ITdeprecated_prag _) }
 '{-# WARNING'            { L _ (ITwarning_prag _) }
 '{-# UNPACK'             { L _ (ITunpack_prag _) }
 '{-# NOUNPACK'           { L _ (ITnounpack_prag _) }
 '{-# ANN'                { L _ (ITann_prag _) }
 '{-# VECTORISE'          { L _ (ITvect_prag _) }
 '{-# VECTORISE_SCALAR'   { L _ (ITvect_scalar_prag _) }
 '{-# NOVECTORISE'        { L _ (ITnovect_prag _) }
 '{-# MINIMAL'            { L _ (ITminimal_prag _) }
 '{-# CTYPE'              { L _ (ITctype _) }
 '{-# OVERLAPPING'        { L _ (IToverlapping_prag _) }
 '{-# OVERLAPPABLE'       { L _ (IToverlappable_prag _) }
 '{-# OVERLAPS'           { L _ (IToverlaps_prag _) }
 '{-# INCOHERENT'         { L _ (ITincoherent_prag _) }
 '#-}'                    { L _ ITclose_prag }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
403 404 405

 '..'           { L _ ITdotdot }                        -- reserved symbols
 ':'            { L _ ITcolon }
406
 '::'           { L _ (ITdcolon _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
407 408
 '='            { L _ ITequal }
 '\\'           { L _ ITlam }
409
 'lcase'        { L _ ITlcase }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
410
 '|'            { L _ ITvbar }
411 412
 '<-'           { L _ (ITlarrow _) }
 '->'           { L _ (ITrarrow _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
413 414 415
 '@'            { L _ ITat }
 '~'            { L _ ITtilde }
 '~#'           { L _ ITtildehsh }
416
 '=>'           { L _ (ITdarrow _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
417 418
 '-'            { L _ ITminus }
 '!'            { L _ ITbang }
419 420 421 422
 '-<'           { L _ (ITlarrowtail _) }            -- for arrow notation
 '>-'           { L _ (ITrarrowtail _) }            -- for arrow notation
 '-<<'          { L _ (ITLarrowtail _) }            -- for arrow notation
 '>>-'          { L _ (ITRarrowtail _) }            -- for arrow notation
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
423
 '.'            { L _ ITdot }
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
424
 TYPEAPP        { L _ ITtypeApp }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
425 426 427 428 429 430 431 432 433 434 435 436 437

 '{'            { L _ ITocurly }                        -- special symbols
 '}'            { L _ ITccurly }
 vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
 vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
 '['            { L _ ITobrack }
 ']'            { L _ ITcbrack }
 '[:'           { L _ ITopabrack }
 ':]'           { L _ ITcpabrack }
 '('            { L _ IToparen }
 ')'            { L _ ITcparen }
 '(#'           { L _ IToubxparen }
 '#)'           { L _ ITcubxparen }
438 439
 '(|'           { L _ (IToparenbar _) }
 '|)'           { L _ (ITcparenbar _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
440 441 442
 ';'            { L _ ITsemi }
 ','            { L _ ITcomma }
 '`'            { L _ ITbackquote }
dreixel's avatar
dreixel committed
443
 SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
444 445 446 447 448 449 450 451 452

 VARID          { L _ (ITvarid    _) }          -- identifiers
 CONID          { L _ (ITconid    _) }
 VARSYM         { L _ (ITvarsym   _) }
 CONSYM         { L _ (ITconsym   _) }
 QVARID         { L _ (ITqvarid   _) }
 QCONID         { L _ (ITqconid   _) }
 QVARSYM        { L _ (ITqvarsym  _) }
 QCONSYM        { L _ (ITqconsym  _) }
453

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
454
 IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
Adam Gundry's avatar
Adam Gundry committed
455
 LABELVARID     { L _ (ITlabelvarid   _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
456

457 458 459
 CHAR           { L _ (ITchar   _ _) }
 STRING         { L _ (ITstring _ _) }
 INTEGER        { L _ (ITinteger _ _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
460
 RATIONAL       { L _ (ITrational _) }
461

462 463 464 465
 PRIMCHAR       { L _ (ITprimchar   _ _) }
 PRIMSTRING     { L _ (ITprimstring _ _) }
 PRIMINTEGER    { L _ (ITprimint    _ _) }
 PRIMWORD       { L _ (ITprimword   _ _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
466 467 468 469 470 471 472
 PRIMFLOAT      { L _ (ITprimfloat  _) }
 PRIMDOUBLE     { L _ (ITprimdouble _) }

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

474
-- Template Haskell
475
'[|'            { L _ (ITopenExpQuote _ _) }
476 477 478
'[p|'           { L _ ITopenPatQuote  }
'[t|'           { L _ ITopenTypQuote  }
'[d|'           { L _ ITopenDecQuote  }
479
'|]'            { L _ (ITcloseQuote _) }
480
'[||'           { L _ (ITopenTExpQuote _) }
481
'||]'           { L _ ITcloseTExpQuote  }
482
TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
483
'$('            { L _ ITparenEscape   }     -- $( exp )
484 485
TH_ID_TY_SPLICE { L _ (ITidTyEscape _)  }   -- $$x
'$$('           { L _ ITparenTyEscape   }   -- $$( exp )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
486 487
TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
488
TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
489 490

%monad { P } { >>= } { return }
Alan Zimmerman's avatar
Alan Zimmerman committed
491
%lexer { (lexer True) } { L _ ITeof }
492 493 494
%tokentype { (Located Token) }

-- Exported parsers
495
%name parseModule module
Edward Z. Yang's avatar
Edward Z. Yang committed
496
%name parseSignature signature
497 498 499 500
%name parseImport importdecl
%name parseStatement stmt
%name parseDeclaration topdecl
%name parseExpression exp
501
%name parsePattern pat
502
%name parseTypeSignature sigdecl
503 504
%name parseStmt   maybe_stmt
%name parseIdentifier  identifier
505
%name parseType ctype
Edward Z. Yang's avatar
Edward Z. Yang committed
506
%name parseBackpack backpack
507
%partial parseHeader header
508 509
%%

510 511 512
-----------------------------------------------------------------------------
-- Identifiers; one of the entry points
identifier :: { Located RdrName }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
513 514 515 516
        : qvar                          { $1 }
        | qcon                          { $1 }
        | qvarop                        { $1 }
        | qconop                        { $1 }
Alan Zimmerman's avatar
Alan Zimmerman committed
517
    | '(' '->' ')'      {% ams (sLL $1 $> $ getRdrName funTyCon)
518
                               [mj AnnOpenP $1,mu AnnRarrow $2,mj AnnCloseP $3] }
519

Edward Z. Yang's avatar
Edward Z. Yang committed
520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577
-----------------------------------------------------------------------------
-- Backpack stuff

backpack :: { [LHsUnit PackageName] }
         : implicit_top units close { fromOL $2 }
         | '{' units '}'            { fromOL $2 }

units :: { OrdList (LHsUnit PackageName) }
         : units ';' unit { $1 `appOL` unitOL $3 }
         | units ';'      { $1 }
         | unit           { unitOL $1 }

unit :: { LHsUnit PackageName }
        : 'unit' pkgname 'where' unitbody
            { sL1 $1 $ HsUnit { hsunitName = $2
                              , hsunitBody = fromOL $4 } }

unitid :: { LHsUnitId PackageName }
        : pkgname                  { sL1 $1 $ HsUnitId $1 [] }
        | pkgname '[' msubsts ']'  { sLL $1 $> $ HsUnitId $1 (fromOL $3) }

msubsts :: { OrdList (LHsModuleSubst PackageName) }
        : msubsts ',' msubst { $1 `appOL` unitOL $3 }
        | msubsts ','        { $1 }
        | msubst             { unitOL $1 }

msubst :: { LHsModuleSubst PackageName }
        : modid '=' moduleid { sLL $1 $> $ ($1, $3) }
        | modid VARSYM modid VARSYM { sLL $1 $> $ ($1, sLL $2 $> $ HsModuleVar $3) }

moduleid :: { LHsModuleId PackageName }
          : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar $2 }
          | unitid ':' modid    { sLL $1 $> $ HsModuleId $1 $3 }

pkgname :: { Located PackageName }
        : STRING     { sL1 $1 $ PackageName (getSTRING $1) }
        | litpkgname { sL1 $1 $ PackageName (unLoc $1) }

litpkgname_segment :: { Located FastString }
        : VARID  { sL1 $1 $ getVARID $1 }
        | CONID  { sL1 $1 $ getCONID $1 }
        | special_id { $1 }

litpkgname :: { Located FastString }
        : litpkgname_segment { $1 }
        -- a bit of a hack, means p - b is parsed same as p-b, enough for now.
        | litpkgname_segment '-' litpkgname  { sLL $1 $> $ appendFS (unLoc $1) (consFS '-' (unLoc $3)) }

mayberns :: { Maybe [LRenaming] }
        : {- empty -} { Nothing }
        | '(' rns ')' { Just (fromOL $2) }

rns :: { OrdList LRenaming }
        : rns ',' rn { $1 `appOL` unitOL $3 }
        | rns ','    { $1 }
        | rn         { unitOL $1 }

rn :: { LRenaming }
578 579
        : modid 'as' modid { sLL $1 $> $ Renaming $1 (Just $3) }
        | modid            { sL1 $1    $ Renaming $1 Nothing }
Edward Z. Yang's avatar
Edward Z. Yang committed
580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605

unitbody :: { OrdList (LHsUnitDecl PackageName) }
        : '{'     unitdecls '}'   { $2 }
        | vocurly unitdecls close { $2 }

unitdecls :: { OrdList (LHsUnitDecl PackageName) }
        : unitdecls ';' unitdecl { $1 `appOL` unitOL $3 }
        | unitdecls ';'         { $1 }
        | unitdecl              { unitOL $1 }

unitdecl :: { LHsUnitDecl PackageName }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
             -- XXX not accurate
             { sL1 $2 $ DeclD ModuleD $3 (Just (sL1 $2 (HsModule (Just $3) $5 (fst $ snd $7) (snd $ snd $7) $4 $1))) }
        | maybedocheader 'signature' modid maybemodwarning maybeexports 'where' body
             { sL1 $2 $ DeclD SignatureD $3 (Just (sL1 $2 (HsModule (Just $3) $5 (fst $ snd $7) (snd $ snd $7) $4 $1))) }
        -- NB: MUST have maybedocheader here, otherwise shift-reduce conflict
        -- will prevent us from parsing both forms.
        | maybedocheader 'module' modid
             { sL1 $2 $ DeclD ModuleD $3 Nothing }
        | maybedocheader 'signature' modid
             { sL1 $2 $ DeclD SignatureD $3 Nothing }
        | 'dependency' unitid mayberns
             { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2
                                              , idModRenaming = $3 }) }

606 607 608 609 610 611 612 613 614 615
-----------------------------------------------------------------------------
-- Module Header

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

Edward Z. Yang's avatar
Edward Z. Yang committed
616 617 618 619 620 621 622 623
signature :: { Located (HsModule RdrName) }
       : maybedocheader 'signature' modid maybemodwarning maybeexports 'where' body
             {% fileSrcSpan >>= \ loc ->
                ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
                              (snd $ snd $7) $4 $1)
                    )
                    ([mj AnnModule $2, mj AnnWhere $6] ++ fst $7) }

Alan Zimmerman's avatar
Alan Zimmerman committed
624 625 626 627 628 629 630
module :: { Located (HsModule RdrName) }
       : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
             {% fileSrcSpan >>= \ loc ->
                ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
                              (snd $ snd $7) $4 $1)
                    )
                    ([mj AnnModule $2, mj AnnWhere $6] ++ fst $7) }
631
        | body2
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
632
                {% fileSrcSpan >>= \ loc ->
Alan Zimmerman's avatar
Alan Zimmerman committed
633 634 635
                   ams (L loc (HsModule Nothing Nothing
                               (fst $ snd $1) (snd $ snd $1) Nothing Nothing))
                       (fst $1) }
636

637
maybedocheader :: { Maybe LHsDocString }
638
        : moduleheader            { $1 }
639
        | {- empty -}             { Nothing }
640 641

missing_module_keyword :: { () }
642
        : {- empty -}                           {% pushModuleContext }
643

Edward Z. Yang's avatar
Edward Z. Yang committed
644 645 646
implicit_top :: { () }
        : {- empty -}                           {% pushModuleContext }

647
maybemodwarning :: { Maybe (Located WarningTxt) }
Alan Zimmerman's avatar
Alan Zimmerman committed
648
    : '{-# DEPRECATED' strings '#-}'
Alan Zimmerman's avatar
Alan Zimmerman committed
649 650
                      {% ajs (Just (sLL $1 $> $ DeprecatedTxt (sL1 $1 (getDEPRECATED_PRAGs $1)) (snd $ unLoc $2)))
                             (mo $1:mc $3: (fst $ unLoc $2)) }
Alan Zimmerman's avatar
Alan Zimmerman committed
651
    | '{-# WARNING' strings '#-}'
Alan Zimmerman's avatar
Alan Zimmerman committed
652
                         {% ajs (Just (sLL $1 $> $ WarningTxt (sL1 $1 (getWARNING_PRAGs $1)) (snd $ unLoc $2)))
Alan Zimmerman's avatar
Alan Zimmerman committed
653
                                (mo $1:mc $3 : (fst $ unLoc $2)) }
Ian Lynagh's avatar
Ian Lynagh committed
654
    |  {- empty -}                  { Nothing }
655

Alan Zimmerman's avatar
Alan Zimmerman committed
656 657
body    :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
Alan Zimmerman's avatar
Alan Zimmerman committed
658
        :  '{'            top '}'      { (moc $1:mcc $3:(fst $2)
Alan Zimmerman's avatar
Alan Zimmerman committed
659 660 661 662 663
                                         , snd $2) }
        |      vocurly    top close    { (fst $2, snd $2) }

body2   :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
Alan Zimmerman's avatar
Alan Zimmerman committed
664
        :  '{' top '}'                          { (moc $1:mcc $3
Alan Zimmerman's avatar
Alan Zimmerman committed
665 666 667 668 669
                                                   :(fst $2), snd $2) }
        |  missing_module_keyword top close     { ([],snd $2) }

top     :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
Alan Zimmerman's avatar
Alan Zimmerman committed
670 671 672 673 674 675 676 677 678 679
        : importdecls                   { (fst $1
                                          ,(reverse $ snd $1,[]))}
        | importdecls ';' cvtopdecls    {% if null (snd $1)
                                             then return ((mj AnnSemi $2:(fst $1))
                                                         ,(reverse $ snd $1,$3))
                                             else do
                                              { addAnnotation (gl $ head $ snd $1)
                                                              AnnSemi (gl $2)
                                              ; return (fst $1
                                                       ,(reverse $ snd $1,$3)) }}
Alan Zimmerman's avatar
Alan Zimmerman committed
680
        | cvtopdecls                    { ([],([],$1)) }
681 682

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

685 686 687
-----------------------------------------------------------------------------
-- Module declaration & imports only

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
688 689 690
header  :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
                {% fileSrcSpan >>= \ loc ->
Alan Zimmerman's avatar
Alan Zimmerman committed
691 692
                   ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
                          )) [mj AnnModule $2,mj AnnWhere $6] }
Edward Z. Yang's avatar
Edward Z. Yang committed
693 694 695 696
        | maybedocheader 'signature' modid maybemodwarning maybeexports 'where' header_body
                {% fileSrcSpan >>= \ loc ->
                   ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
                          )) [mj AnnModule $2,mj AnnWhere $6] }
697
        | header_body2
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
698
                {% fileSrcSpan >>= \ loc ->
699
                   return (L loc (HsModule Nothing Nothing $1 [] Nothing
700
                          Nothing)) }
701 702

header_body :: { [LImportDecl RdrName] }
Alan Zimmerman's avatar
Alan Zimmerman committed
703 704
        :  '{'            importdecls           { snd $2 }
        |      vocurly    importdecls           { snd $2 }
705 706

header_body2 :: { [LImportDecl RdrName] }
Alan Zimmerman's avatar
Alan Zimmerman committed
707 708
        :  '{' importdecls                      { snd $2 }
        |  missing_module_keyword importdecls   { snd $2 }
709

710 711 712
-----------------------------------------------------------------------------
-- The Export List

Alan Zimmerman's avatar
Alan Zimmerman committed
713
maybeexports :: { (Maybe (Located [LIE RdrName])) }
Alan Zimmerman's avatar
Alan Zimmerman committed
714
        :  '(' exportlist ')'       {% ams (sLL $1 $> ()) [mop $1,mcp $3] >>
Alan Zimmerman's avatar
Alan Zimmerman committed
715 716
                                       return (Just (sLL $1 $> (fromOL $2))) }
        |  {- empty -}              { Nothing }
717

718
exportlist :: { OrdList (LIE RdrName) }
Alan Zimmerman's avatar
Alan Zimmerman committed
719 720 721
        : expdoclist ',' expdoclist   {% addAnnotation (oll $1) AnnComma (gl $2)
                                         >> return ($1 `appOL` $3) }
        | exportlist1                 { $1 }
722

723
exportlist1 :: { OrdList (LIE RdrName) }
Alan Zimmerman's avatar
Alan Zimmerman committed
724 725 726 727 728 729
        : expdoclist export expdoclist ',' exportlist1
                          {% (addAnnotation (oll ($1 `appOL` $2 `appOL` $3))
                                            AnnComma (gl $4) ) >>
                              return ($1 `appOL` $2 `appOL` $3 `appOL` $5) }
        | expdoclist export expdoclist             { $1 `appOL` $2 `appOL` $3 }
        | expdoclist                               { $1 }
730

731 732 733
expdoclist :: { OrdList (LIE RdrName) }
        : exp_doc expdoclist                           { $1 `appOL` $2 }
        | {- empty -}                                  { nilOL }
734

735
exp_doc :: { OrdList (LIE RdrName) }
rodlogic's avatar
rodlogic committed
736 737 738
        : docsection    { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup n doc)) }
        | docnamed      { unitOL (sL1 $1 (IEDocNamed ((fst . unLoc) $1))) }
        | docnext       { unitOL (sL1 $1 (IEDoc (unLoc $1))) }
739 740


741 742
   -- No longer allow things like [] and (,,,) to be exported
   -- They are built in syntax, always available
743
export  :: { OrdList (LIE RdrName) }
744 745
        : qcname_ext export_subspec  {% mkModuleImpExp $1 (snd $ unLoc $2)
                                          >>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) }
Alan Zimmerman's avatar
Alan Zimmerman committed
746 747 748 749 750 751 752
        |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents $2))
                                             [mj AnnModule $1] }
        |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar $2))
                                             [mj AnnPattern $1] }

export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
        : {- empty -}             { sL0 ([],ImpExpAbs) }
753 754 755 756 757 758 759 760 761 762
        | '(' qcnames ')'         {% mkImpExpSubSpec (reverse (snd $2))
                                      >>= \(as,ie) -> return $ sLL $1 $>
                                            (as ++ [mop $1,mcp $3] ++ fst $2, ie) }


qcnames :: { ([AddAnn], [Located (Maybe RdrName)]) }
  : {- empty -}                   { ([],[]) }
  | qcnames1                      { $1 }

qcnames1 :: { ([AddAnn], [Located (Maybe RdrName)]) }     -- A reversed list
763
        :  qcnames1 ',' qcname_ext_w_wildcard  {% case (head (snd $1)) of
764
                                                    l@(L _ Nothing) ->
765 766 767 768 769
                                                       return ([mj AnnComma $2, mj AnnDotdot l]
                                                               ,(snd (unLoc $3)  : snd $1))
                                                    l -> (ams (head (snd $1)) [mj AnnComma $2] >>
                                                          return (fst $1 ++ fst (unLoc $3),
                                                                  snd (unLoc $3) : snd $1)) }
770 771


772 773
        -- Annotations re-added in mkImpExpSubSpec
        |  qcname_ext_w_wildcard                   { (fst (unLoc $1),[snd (unLoc $1)]) }
774 775 776

-- Variable, data constructor or wildcard
-- or tagged type constructor
777 778 779
qcname_ext_w_wildcard :: { Located ([AddAnn],Located (Maybe RdrName)) }
        :  qcname_ext               { sL1 $1 ([],Just `fmap` $1) }
        |  '..'                     { sL1 $1 ([mj AnnDotdot $1], sL1 $1 Nothing) }
780 781

qcname_ext :: { Located RdrName }
Alan Zimmerman's avatar
Alan Zimmerman committed
782
        :  qcname                   { $1 }
783
        |  'type' oqtycon           {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
784
                                            [mj AnnType $1,mj AnnVal $2] }
785

786
qcname  :: { Located RdrName }  -- Variable or type constructor
787 788 789
        :  qvar                 { $1 } -- Things which look like functions
                                       -- Note: This includes record selectors but
                                       -- also (-.->), see #11432
790
        |  oqtycon_no_varcon    { $1 } -- see Note [Type constructors in export list]
791 792 793 794 795 796 797

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

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

Alan Zimmerman's avatar
Alan Zimmerman committed
798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813
importdecls :: { ([AddAnn],[LImportDecl RdrName]) }
        : importdecls ';' importdecl
                                {% if null (snd $1)
                                     then return (mj AnnSemi $2:fst $1,$3 : snd $1)
                                     else do
                                      { addAnnotation (gl $ head $ snd $1)
                                                      AnnSemi (gl $2)
                                      ; return (fst $1,$3 : snd $1) } }
        | importdecls ';'       {% if null (snd $1)
                                     then return ((mj AnnSemi $2:fst $1),snd $1)
                                     else do
                                       { addAnnotation (gl $ head $ snd $1)
                                                       AnnSemi (gl $2)
                                       ; return $1} }
        | importdecl             { ([],[$1]) }
        | {- empty -}            { ([],[]) }
814 815

importdecl :: { LImportDecl RdrName }
816
        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
Alan Zimmerman's avatar
Alan Zimmerman committed
817
                {% ams (L (comb4 $1 $6 (snd $7) $8) $
Alan Zimmerman's avatar
Alan Zimmerman committed
818 819
                  ImportDecl { ideclSourceSrc = snd $ fst $2
                             , ideclName = $6, ideclPkgQual = snd $5
Alan Zimmerman's avatar
Alan Zimmerman committed
820 821 822 823
                             , ideclSource = snd $2, ideclSafe = snd $3
                             , ideclQualified = snd $4, ideclImplicit = False
                             , ideclAs = unLoc (snd $7)
                             , ideclHiding = unLoc $8 })
Alan Zimmerman's avatar
Alan Zimmerman committed
824
                   ((mj AnnImport $1 : (fst $ fst $2) ++ fst $3 ++ fst $4
825
                                    ++ fst $5 ++ fst $7)) }
Alan Zimmerman's avatar
Alan Zimmerman committed
826

Alan Zimmerman's avatar
Alan Zimmerman committed
827 828
maybe_src :: { (([AddAnn],SourceText),IsBootInterface) }
        : '{-# SOURCE' '#-}'        { (([mo $1,mc $2],getSOURCE_PRAGs $1)
Alan Zimmerman's avatar
Alan Zimmerman committed
829
                                      ,True) }
Alan Zimmerman's avatar
Alan Zimmerman committed
830
        | {- empty -}               { (([],NoSourceText),False) }
Alan Zimmerman's avatar
Alan Zimmerman committed
831 832 833 834 835

maybe_safe :: { ([AddAnn],Bool) }
        : 'safe'                                { ([mj AnnSafe $1],True) }
        | {- empty -}                           { ([],False) }

836
maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
837 838
        : STRING  {% let pkgFS = getSTRING $1 in
                     if looksLikePackageName (unpackFS pkgFS)
839
                        then return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS))
840 841 842 843
                        else parseErrorSDoc (getLoc $1) $ vcat [
                             text "parse error" <> colon <+> quotes (ppr pkgFS),
                             text "Version number or non-alphanumeric" <+>
                             text "character in package name"] }
Alan Zimmerman's avatar
Alan Zimmerman committed
844 845 846 847 848 849
        | {- empty -}                           { ([],Nothing) }

optqualified :: { ([AddAnn],Bool) }
        : 'qualified'                           { ([mj AnnQualified $1],True)  }
        | {- empty -}                           { ([],False) }

850 851 852
maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) }
        : 'as' modid                           { ([mj AnnAs $1]
                                                 ,sLL $1 $> (Just $2)) }
853
        | {- empty -}                          { ([],noLoc Nothing) }
854

855
maybeimpspec :: { Located (Maybe (Bool, Located [LIE RdrName])) }
856 857 858 859
        : impspec                  {% let (b, ie) = unLoc $1 in
                                       checkImportSpec ie
                                        >>= \checkedIe ->
                                          return (L (gl $1) (Just (b, checkedIe)))  }
Alan Zimmerman's avatar
Alan Zimmerman committed
860
        | {- empty -}              { noLoc Nothing }
861

862
impspec :: { Located (Bool, Located [LIE RdrName]) }
Alan Zimmerman's avatar
Alan Zimmerman committed
863 864 865 866 867 868
        :  '(' exportlist ')'               {% ams (sLL $1 $> (False,
                                                      sLL $1 $> $ fromOL $2))
                                                   [mop $1,mcp $3] }
        |  'hiding' '(' exportlist ')'      {% ams (sLL $1 $> (True,
                                                      sLL $1 $> $ fromOL $3))
                                               [mj AnnHiding $1,mop $2,mcp $4] }
869 870 871 872

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

873
prec    :: { Located (SourceText,Int) }
Alan Zimmerman's avatar
Alan Zimmerman committed
874
        : {- empty -}           { noLoc (NoSourceText,9) }
875
        | INTEGER
876
                 {% checkPrecP (sL1 $1 (getINTEGERs $1,fromInteger (getINTEGER $1))) }
877

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
878
infix   :: { Located FixityDirection }
rodlogic's avatar
rodlogic committed
879 880 881
        : 'infix'                               { sL1 $1 InfixN  }
        | 'infixl'                              { sL1 $1 InfixL  }
        | 'infixr'                              { sL1 $1 InfixR }
882

Alan Zimmerman's avatar
Alan Zimmerman committed
883
ops     :: { Located (OrdList (Located RdrName)) }
Alan Zimmerman's avatar
Alan Zimmerman committed
884 885 886
        : ops ',' op       {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
                              return (sLL $1 $> ((unLoc $1) `appOL` unitOL $3))}
        | op               { sL1 $1 (unitOL $1) }
887 888 889 890

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

891
topdecls :: { OrdList (LHsDecl RdrName) }
892
        : topdecls ';' topdecl        {% addAnnotation (oll $1) AnnSemi (gl $2)
893
                                         >> return ($1 `appOL` unitOL $3) }
Alan Zimmerman's avatar
Alan Zimmerman committed
894 895
        | topdecls ';'                {% addAnnotation (oll $1) AnnSemi (gl $2)
                                         >> return $1 }
896 897 898 899 900 901 902 903 904
        | topdecl                     { unitOL $1 }

topdecl :: { LHsDecl RdrName }
        : cl_decl                               { sL1 $1 (TyClD (unLoc $1)) }
        | ty_decl                               { sL1 $1 (TyClD (unLoc $1)) }
        | inst_decl                             { sL1 $1 (InstD (unLoc $1)) }
        | stand_alone_deriving                  { sLL $1 $> (DerivD (unLoc $1)) }
        | role_annot                            { sL1 $1 (RoleAnnotD (unLoc $1)) }
        | 'default' '(' comma_types0 ')'    {% ams (sLL $1 $> (DefD (DefaultDecl $3)))
thomasw's avatar
thomasw committed
905
                                                         [mj AnnDefault $1
thomasw's avatar
thomasw committed
906
                                                         ,mop $2,mcp $4] }
907
        | 'foreign' fdecl          {% ams (sLL $1 $> (snd $ unLoc $2))
Alan Zimmerman's avatar
Alan Zimmerman committed
908
                                           (mj AnnForeign $1:(fst $ unLoc $2)) }
909
        | '{-# DEPRECATED' deprecations '#-}'   {% ams (sLL $1 $> $ WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2)))
Alan Zimmerman's avatar
Alan Zimmerman committed
910
                                                       [mo $1,mc $3] }
911
        | '{-# WARNING' warnings '#-}'          {% ams (sLL $1 $> $ WarningD (Warnings (getWARNING_PRAGs $1) (fromOL $2)))
Alan Zimmerman's avatar
Alan Zimmerman committed
912
                                                       [mo $1,mc $3] }
913
        | '{-# RULES' rules '#-}'               {% ams (sLL $1 $> $ RuleD (HsRules (getRULES_PRAGs $1) (fromOL $2)))
Alan Zimmerman's avatar
Alan Zimmerman committed
914
                                                       [mo $1,mc $3] }
915
        | '{-# VECTORISE' qvar '=' exp '#-}' {% ams (sLL $1 $> $ VectD (HsVect (getVECT_PRAGs $1) $2 $4))
Alan Zimmerman's avatar
Alan Zimmerman committed
916 917
                                                    [mo $1,mj AnnEqual $3
                                                    ,mc $5] }
918
        | '{-# NOVECTORISE' qvar '#-}'       {% ams (sLL $1 $> $ VectD (HsNoVect (getNOVECT_PRAGs $1) $2))
Alan Zimmerman's avatar
Alan Zimmerman committed
919
                                                     [mo $1,mc $3] }
920
        | '{-# VECTORISE' 'type' gtycon '#-}'
921
                                {% ams (sLL $1 $> $
Alan Zimmerman's avatar
Alan Zimmerman committed
922
                                    VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 Nothing))
Alan Zimmerman's avatar
Alan Zimmerman committed
923 924
                                    [mo $1,mj AnnType $2,mc $4] }

925
        | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
926
                                {% ams (sLL $1 $> $
Alan Zimmerman's avatar
Alan Zimmerman committed
927
                                    VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 Nothing))
Alan Zimmerman's avatar
Alan Zimmerman committed
928 929
                                    [mo $1,mj AnnType $2,mc $4] }

930
        | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
931
                                {% ams (sLL $1 $> $
Alan Zimmerman's avatar
Alan Zimmerman committed
932
                                    VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 (Just $5)))
Alan Zimmerman's avatar
Alan Zimmerman committed
933
                                    [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
934
        | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
935
                                {% ams (sLL $1 $> $
Alan Zimmerman's avatar
Alan Zimmerman committed
936
                                    VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 (Just $5)))
Alan Zimmerman's avatar
Alan Zimmerman committed
937 938 939
                                    [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }

        | '{-# VECTORISE' 'class' gtycon '#-}'
940
                                         {% ams (sLL $1 $>  $ VectD (HsVectClassIn (getVECT_PRAGs $1) $3))
Alan Zimmerman's avatar
Alan Zimmerman committed
941
                                                 [mo $1,mj AnnClass $2,mc $4] }
942 943
        | annotation { $1 }
        | decl_no_th                            { $1 }
944 945 946

        -- Template Haskell Extension
        -- The $(..) form is one possible form of infixexp
947
        -- but we treat an arbitrary expression just as if
948
        -- it had a $(..) wrapped around it
949
        | infixexp_top                          { sLL $1 $> $ mkSpliceDecl $1 }
950

951 952 953
-- Type classes
--
cl_decl :: { LTyClDecl RdrName }
954
        : 'class' tycl_hdr fds where_cls
Alan Zimmerman's avatar
Alan Zimmerman committed
955
                {% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))