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

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

19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
-- | 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
--       parseState = mkPState flags buffer location in
-- @
module Parser (parseModule, parseImport, parseStatement,
               parseDeclaration, parseExpression, parseTypeSignature,
               parseFullStmt, parseStmt, parseIdentifier,
               parseType, parseHeader) where

rodlogic's avatar
rodlogic committed
38 39 40 41 42
-- base
import Control.Monad    ( unless, liftM )
import GHC.Exts
import Data.Char
import Control.Monad    ( mplus )
43

rodlogic's avatar
rodlogic committed
44
-- compiler/hsSyn
45
import HsSyn
rodlogic's avatar
rodlogic committed
46 47

-- compiler/main
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
48
import HscTypes         ( IsBootInterface, WarningTxt(..) )
rodlogic's avatar
rodlogic committed
49 50 51 52 53 54 55 56 57 58
import DynFlags

-- compiler/utils
import OrdList
import BooleanFormula   ( BooleanFormula, mkAnd, mkOr, mkTrue, mkVar )
import FastString
import Maybes           ( orElse )
import Outputable

-- compiler/basicTypes
59
import RdrName
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
60 61
import OccName          ( varName, dataName, tcClsName, tvName )
import DataCon          ( DataCon, dataConName )
Ian Lynagh's avatar
Ian Lynagh committed
62
import SrcLoc
63
import Module
rodlogic's avatar
rodlogic committed
64 65 66 67
import BasicTypes

-- compiler/types
import Type             ( funTyCon )
dreixel's avatar
dreixel committed
68
import Kind             ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
69
import Class            ( FunDep )
rodlogic's avatar
rodlogic committed
70 71 72 73

-- compiler/parser
import RdrHsSyn
import Lexer
74
import HaddockUtils
Alan Zimmerman's avatar
Alan Zimmerman committed
75
import ApiAnnotation
76

rodlogic's avatar
rodlogic committed
77 78
-- compiler/typecheck
import TcEvidence       ( emptyTcEvBinds )
79

rodlogic's avatar
rodlogic committed
80 81 82 83 84 85
-- compiler/prelude
import ForeignCall
import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
                          unboxedUnitTyCon, unboxedUnitDataCon,
                          listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
Alan Zimmerman's avatar
Alan Zimmerman committed
86

87 88 89
}

{-
90 91 92 93 94 95 96 97 98 99 100 101
-----------------------------------------------------------------------------
20 Nov 2014

Conflicts: 60 shift/reduce
           12 reduce/reduce

-----------------------------------------------------------------------------
25 June 2014

Conflicts: 47 shift/reduce
           1 reduce/reduce

102
-----------------------------------------------------------------------------
Gabor Greif's avatar
Gabor Greif committed
103 104 105 106 107 108 109
12 October 2012

Conflicts: 43 shift/reduce
           1 reduce/reduce

-----------------------------------------------------------------------------
24 February 2006
110 111 112 113 114 115 116 117 118

Conflicts: 33 shift/reduce
           1 reduce/reduce

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

  -=chak

119 120 121 122 123
-----------------------------------------------------------------------------
31 December 2006

Conflicts: 34 shift/reduce
           1 reduce/reduce
Alan Zimmerman's avatar
Alan Zimmerman committed
124
q
125 126 127 128 129
The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
would think the two should never occur in the same context.

  -=chak

130 131 132 133 134 135 136 137 138 139 140
-----------------------------------------------------------------------------
6 December 2006

Conflicts: 32 shift/reduce
           1 reduce/reduce

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

  -=chak

141 142 143 144 145 146 147 148 149 150 151
-----------------------------------------------------------------------------
26 July 2006

Conflicts: 37 shift/reduce
           1 reduce/reduce

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

  -=chak

152
-----------------------------------------------------------------------------
153
Conflicts: 38 shift/reduce (1.25)
154

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

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

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


chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
167 168 169 170
2 for ambiguity in 'case v of { x :: T -> T ... } '     [States 11, 253]
        Which of these two is intended?
          case v of
            (x::T) -> T         -- Rhs is T
171
    or
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
172 173
          case v of
            (x::T -> T) -> ..   -- Rhs is ...
ross's avatar
ross committed
174

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

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

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

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

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

203 204 205
-- ---------------------------------------------------------------------------
-- Adding location info

rodlogic's avatar
rodlogic committed
206 207 208 209
This is done using the three functions below, sL0, sL1
and sLL.  Note that these functions were mechanically
converted from the three macros that used to exist before,
namely L0, L1 and LL.
210 211 212

They each add a SrcSpan to their argument.

rodlogic's avatar
rodlogic committed
213
   sL0  adds 'noSrcSpan', used for empty productions
214
     -- This doesn't seem to work anymore -=chak
215

rodlogic's avatar
rodlogic committed
216
   sL1  for a production with a single token on the lhs.  Grabs the SrcSpan
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
217
        from that token.
218

rodlogic's avatar
rodlogic committed
219
   sLL  for a production with >1 token on the lhs.  Makes up a SrcSpan from
220 221 222
        the first and last tokens.

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
227 228
        | 'newtype' tycl_hdr '=' newconstr deriving
                { L (comb3 $1 $4 $5)
Alan Zimmerman's avatar
Alan Zimmerman committed
229
                    (mkTyData NewType (unLoc $2) $4 (unLoc $5)) }
230 231 232 233 234 235 236 237 238 239 240 241

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

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

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

-}

%token
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
242 243
 '_'            { L _ ITunderscore }            -- Haskell keywords
 'as'           { L _ ITas }
244 245 246
 'case'         { L _ ITcase }
 'class'        { L _ ITclass }
 'data'         { L _ ITdata }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
 'default'      { L _ ITdefault }
 'deriving'     { L _ ITderiving }
 'do'           { L _ ITdo }
 'else'         { L _ ITelse }
 'hiding'       { L _ IThiding }
 'if'           { L _ ITif }
 'import'       { L _ ITimport }
 'in'           { L _ ITin }
 'infix'        { L _ ITinfix }
 'infixl'       { L _ ITinfixl }
 'infixr'       { L _ ITinfixr }
 'instance'     { L _ ITinstance }
 'let'          { L _ ITlet }
 'module'       { L _ ITmodule }
 'newtype'      { L _ ITnewtype }
 'of'           { L _ ITof }
 'qualified'    { L _ ITqualified }
 'then'         { L _ ITthen }
 'type'         { L _ ITtype }
 'where'        { L _ ITwhere }

 'forall'       { L _ ITforall }                -- GHC extension keywords
 'foreign'      { L _ ITforeign }
 'export'       { L _ ITexport }
271
 'label'        { L _ ITlabel }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
272 273
 'dynamic'      { L _ ITdynamic }
 'safe'         { L _ ITsafe }
274
 'interruptible' { L _ ITinterruptible }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
275 276 277
 'unsafe'       { L _ ITunsafe }
 'mdo'          { L _ ITmdo }
 'family'       { L _ ITfamily }
278
 'role'         { L _ ITrole }
279 280
 'stdcall'      { L _ ITstdcallconv }
 'ccall'        { L _ ITccallconv }
281
 'capi'         { L _ ITcapiconv }
282
 'prim'         { L _ ITprimcallconv }
thoughtpolice's avatar
thoughtpolice committed
283
 'javascript'   { L _ ITjavascriptcallconv }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
284 285
 'proc'         { L _ ITproc }          -- for arrow notation extension
 'rec'          { L _ ITrec }           -- for arrow notation extension
286 287 288
 'group'    { L _ ITgroup }     -- for list transform extension
 'by'       { L _ ITby }        -- for list transform extension
 'using'    { L _ ITusing }     -- for list transform extension
Gergő Érdi's avatar
Gergő Érdi committed
289
 'pattern'      { L _ ITpattern } -- for pattern synonyms
290

291 292
 '{-# INLINE'             { L _ (ITinline_prag _ _) }
 '{-# SPECIALISE'         { L _ ITspec_prag }
293
 '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
294 295 296
 '{-# SOURCE'                                   { L _ ITsource_prag }
 '{-# RULES'                                    { L _ ITrules_prag }
 '{-# CORE'                                     { L _ ITcore_prag }              -- hdaume: annotated core
297 298 299 300 301
 '{-# SCC'                { L _ ITscc_prag }
 '{-# GENERATED'          { L _ ITgenerated_prag }
 '{-# DEPRECATED'         { L _ ITdeprecated_prag }
 '{-# WARNING'            { L _ ITwarning_prag }
 '{-# UNPACK'             { L _ ITunpack_prag }
302
 '{-# NOUNPACK'           { L _ ITnounpack_prag }
303
 '{-# ANN'                { L _ ITann_prag }
304 305
 '{-# VECTORISE'          { L _ ITvect_prag }
 '{-# VECTORISE_SCALAR'   { L _ ITvect_scalar_prag }
306
 '{-# NOVECTORISE'        { L _ ITnovect_prag }
307
 '{-# MINIMAL'            { L _ ITminimal_prag }
308
 '{-# CTYPE'              { L _ ITctype }
309 310 311
 '{-# OVERLAPPING'        { L _ IToverlapping_prag }
 '{-# OVERLAPPABLE'       { L _ IToverlappable_prag }
 '{-# OVERLAPS'           { L _ IToverlaps_prag }
312
 '{-# INCOHERENT'         { L _ ITincoherent_prag }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
313 314 315 316 317 318 319
 '#-}'                                          { L _ ITclose_prag }

 '..'           { L _ ITdotdot }                        -- reserved symbols
 ':'            { L _ ITcolon }
 '::'           { L _ ITdcolon }
 '='            { L _ ITequal }
 '\\'           { L _ ITlam }
320
 'lcase'        { L _ ITlcase }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353
 '|'            { L _ ITvbar }
 '<-'           { L _ ITlarrow }
 '->'           { L _ ITrarrow }
 '@'            { L _ ITat }
 '~'            { L _ ITtilde }
 '~#'           { L _ ITtildehsh }
 '=>'           { L _ ITdarrow }
 '-'            { L _ ITminus }
 '!'            { L _ ITbang }
 '*'            { L _ ITstar }
 '-<'           { L _ ITlarrowtail }            -- for arrow notation
 '>-'           { L _ ITrarrowtail }            -- for arrow notation
 '-<<'          { L _ ITLarrowtail }            -- for arrow notation
 '>>-'          { L _ ITRarrowtail }            -- for arrow notation
 '.'            { L _ ITdot }

 '{'            { L _ ITocurly }                        -- special symbols
 '}'            { L _ ITccurly }
 vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
 vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
 '['            { L _ ITobrack }
 ']'            { L _ ITcbrack }
 '[:'           { L _ ITopabrack }
 ':]'           { L _ ITcpabrack }
 '('            { L _ IToparen }
 ')'            { L _ ITcparen }
 '(#'           { L _ IToubxparen }
 '#)'           { L _ ITcubxparen }
 '(|'           { L _ IToparenbar }
 '|)'           { L _ ITcparenbar }
 ';'            { L _ ITsemi }
 ','            { L _ ITcomma }
 '`'            { L _ ITbackquote }
dreixel's avatar
dreixel committed
354
 SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
355 356 357 358 359 360 361 362 363

 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  _) }
364 365
 PREFIXQVARSYM  { L _ (ITprefixqvarsym  _) }
 PREFIXQCONSYM  { L _ (ITprefixqconsym  _) }
366

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
367 368
 IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension

369 370 371
 CHAR           { L _ (ITchar   _ _) }
 STRING         { L _ (ITstring _ _) }
 INTEGER        { L _ (ITinteger _ _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
372
 RATIONAL       { L _ (ITrational _) }
373

374 375 376 377
 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
378 379 380 381 382 383 384
 PRIMFLOAT      { L _ (ITprimfloat  _) }
 PRIMDOUBLE     { L _ (ITprimdouble _) }

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

386 387 388 389 390
-- Template Haskell
'[|'            { L _ ITopenExpQuote  }
'[p|'           { L _ ITopenPatQuote  }
'[t|'           { L _ ITopenTypQuote  }
'[d|'           { L _ ITopenDecQuote  }
391
'|]'            { L _ ITcloseQuote    }
392 393
'[||'           { L _ ITopenTExpQuote   }
'||]'           { L _ ITcloseTExpQuote  }
394
TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
395
'$('            { L _ ITparenEscape   }     -- $( exp )
396 397
TH_ID_TY_SPLICE { L _ (ITidTyEscape _)  }   -- $$x
'$$('           { L _ ITparenTyEscape   }   -- $$( exp )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
398 399
TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
400
TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
401 402

%monad { P } { >>= } { return }
Alan Zimmerman's avatar
Alan Zimmerman committed
403
%lexer { (lexer True) } { L _ ITeof }
404 405 406
%tokentype { (Located Token) }

-- Exported parsers
407
%name parseModule module
408 409 410 411 412 413
%name parseImport importdecl
%name parseStatement stmt
%name parseDeclaration topdecl
%name parseExpression exp
%name parseTypeSignature sigdecl
%name parseFullStmt   stmt
414 415
%name parseStmt   maybe_stmt
%name parseIdentifier  identifier
416
%name parseType ctype
417
%partial parseHeader header
418 419
%%

420 421 422
-----------------------------------------------------------------------------
-- Identifiers; one of the entry points
identifier :: { Located RdrName }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
423 424 425 426
        : qvar                          { $1 }
        | qcon                          { $1 }
        | qvarop                        { $1 }
        | qconop                        { $1 }
rodlogic's avatar
rodlogic committed
427
    | '(' '->' ')'      { sLL $1 $> $ getRdrName funTyCon }
428

429 430 431 432 433 434 435 436 437 438
-----------------------------------------------------------------------------
-- 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. :-)

Alan Zimmerman's avatar
Alan Zimmerman committed
439 440 441 442 443 444 445
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) }
446
        | body2
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
447
                {% fileSrcSpan >>= \ loc ->
Alan Zimmerman's avatar
Alan Zimmerman committed
448 449 450
                   ams (L loc (HsModule Nothing Nothing
                               (fst $ snd $1) (snd $ snd $1) Nothing Nothing))
                       (fst $1) }
451

452
maybedocheader :: { Maybe LHsDocString }
453
        : moduleheader            { $1 }
454
        | {- empty -}             { Nothing }
455 456

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

459
maybemodwarning :: { Maybe (Located WarningTxt) }
Alan Zimmerman's avatar
Alan Zimmerman committed
460 461 462 463 464 465
    : '{-# DEPRECATED' strings '#-}'
                      {% ajs (Just (sLL $1 $> $ DeprecatedTxt $ snd $ unLoc $2))
                             (mo $1:mc $1: (fst $ unLoc $2)) }
    | '{-# WARNING' strings '#-}'
                         {% ajs (Just (sLL $1 $> $ WarningTxt $ snd $ unLoc $2))
                                (mo $1:mc $3 : (fst $ unLoc $2)) }
Ian Lynagh's avatar
Ian Lynagh committed
466
    |  {- empty -}                  { Nothing }
467

Alan Zimmerman's avatar
Alan Zimmerman committed
468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486
body    :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
        :  '{'            top '}'      { (mo $1:mc $3:(fst $2)
                                         , snd $2) }
        |      vocurly    top close    { (fst $2, snd $2) }

body2   :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
        :  '{' top '}'                          { (mo $1:mc $3
                                                   :(fst $2), snd $2) }
        |  missing_module_keyword top close     { ([],snd $2) }

top     :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
        : importdecls                   { ([]
                                          ,(reverse $1,[]))}
        | importdecls ';' cvtopdecls    { ([mj AnnSemi $2]
                                          ,(reverse $1,$3))}
        | cvtopdecls                    { ([],([],$1)) }
487 488

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

491 492 493
-----------------------------------------------------------------------------
-- Module declaration & imports only

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
494 495 496
header  :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
                {% fileSrcSpan >>= \ loc ->
Alan Zimmerman's avatar
Alan Zimmerman committed
497 498
                   ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
                          )) [mj AnnModule $2,mj AnnWhere $6] }
499
        | header_body2
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
500
                {% fileSrcSpan >>= \ loc ->
501
                   return (L loc (HsModule Nothing Nothing $1 [] Nothing
502
                          Nothing)) }
503 504

header_body :: { [LImportDecl RdrName] }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
505
        :  '{'            importdecls           { $2 }
506 507 508 509 510
        |      vocurly    importdecls           { $2 }

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

512 513 514
-----------------------------------------------------------------------------
-- The Export List

Alan Zimmerman's avatar
Alan Zimmerman committed
515 516 517 518
maybeexports :: { (Maybe (Located [LIE RdrName])) }
        :  '(' exportlist ')'       {% ams (sLL $1 $> ()) [mo $1,mc $3] >>
                                       return (Just (sLL $1 $> (fromOL $2))) }
        |  {- empty -}              { Nothing }
519

520
exportlist :: { OrdList (LIE RdrName) }
Alan Zimmerman's avatar
Alan Zimmerman committed
521 522 523
        : expdoclist ',' expdoclist   {% addAnnotation (oll $1) AnnComma (gl $2)
                                         >> return ($1 `appOL` $3) }
        | exportlist1                 { $1 }
524

525
exportlist1 :: { OrdList (LIE RdrName) }
Alan Zimmerman's avatar
Alan Zimmerman committed
526 527 528 529 530 531
        : 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 }
532

533 534 535
expdoclist :: { OrdList (LIE RdrName) }
        : exp_doc expdoclist                           { $1 `appOL` $2 }
        | {- empty -}                                  { nilOL }
536

537
exp_doc :: { OrdList (LIE RdrName) }
rodlogic's avatar
rodlogic committed
538 539 540
        : 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))) }
541 542


543 544
   -- No longer allow things like [] and (,,,) to be exported
   -- They are built in syntax, always available
545
export  :: { OrdList (LIE RdrName) }
Alan Zimmerman's avatar
Alan Zimmerman committed
546
        : qcname_ext export_subspec  {% amsu (sLL $1 $> (mkModuleImpExp $1
547
                                                    (snd $ unLoc $2)))
Alan Zimmerman's avatar
Alan Zimmerman committed
548 549 550 551 552 553 554 555 556 557 558 559
                                             (fst $ unLoc $2) }
        |  '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) }
        | '(' '..' ')'            { sLL $1 $> ([mo $1,mc $3,mj AnnDotdot $2]
                                       , ImpExpAll) }
        | '(' ')'                 { sLL $1 $> ([mo $1,mc $2],ImpExpList []) }
        | '(' qcnames ')'         { sLL $1 $> ([mo $1,mc $3],ImpExpList (reverse $2)) }
560

561
qcnames :: { [Located RdrName] }     -- A reversed list
Alan Zimmerman's avatar
Alan Zimmerman committed
562 563
        :  qcnames ',' qcname_ext       {% (aa (head $1) (AnnComma, $2)) >>
                                           return ($3  : $1) }
564
        |  qcname_ext                   { [$1]  }
565

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
566 567
qcname_ext :: { Located RdrName }       -- Variable or data constructor
                                        -- or tagged type constructor
568 569 570
        :  qcname                   {% ams $1 [mj AnnVal $1] }
        |  'type' qcname            {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
                                            [mj AnnType $1,mj AnnVal $2] }
571 572

-- Cannot pull into qcname_ext, as qcname is also used in expression.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
573 574 575
qcname  :: { Located RdrName }  -- Variable or data constructor
        :  qvar                         { $1 }
        |  qcon                         { $1 }
576 577 578 579 580 581 582 583

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

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

importdecls :: { [LImportDecl RdrName] }
Alan Zimmerman's avatar
Alan Zimmerman committed
584 585 586 587 588 589 590
        : importdecls ';' importdecl  {% (aa $3 (AnnSemi, $2)) >>
                                         return ($3 : $1) }
        | importdecls ';'        {% addAnnotation (gl $ head $1) AnnSemi (gl $2)
              -- AZ: can $1 above ever be [] due to the {- empty -} production?
                                    >> return $1 }
        | importdecl             { [$1] }
        | {- empty -}            { [] }
591 592

importdecl :: { LImportDecl RdrName }
593
        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
Alan Zimmerman's avatar
Alan Zimmerman committed
594 595 596 597 598 599 600
                {% ams (L (comb4 $1 $6 (snd $7) $8) $
                  ImportDecl { ideclName = $6, ideclPkgQual = snd $5
                             , ideclSource = snd $2, ideclSafe = snd $3
                             , ideclQualified = snd $4, ideclImplicit = False
                             , ideclAs = unLoc (snd $7)
                             , ideclHiding = unLoc $8 })
                   ((mj AnnImport $1 : fst $2 ++ fst $3 ++ fst $4
601
                                    ++ fst $5 ++ fst $7)) }
Alan Zimmerman's avatar
Alan Zimmerman committed
602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620

maybe_src :: { ([AddAnn],IsBootInterface) }
        : '{-# SOURCE' '#-}'           { ([mo $1,mc $2],True) }
        | {- empty -}                  { ([],False) }

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

maybe_pkg :: { ([AddAnn],Maybe FastString) }
        : STRING                                { ([mj AnnPackageName $1]
                                                  ,Just (getSTRING $1)) }
        | {- empty -}                           { ([],Nothing) }

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

maybeas :: { ([AddAnn],Located (Maybe ModuleName)) }
621 622 623
        : 'as' modid                           { ([mj AnnAs $1,mj AnnVal $2]
                                                 ,sLL $1 $> (Just (unLoc $2))) }
        | {- empty -}                          { ([],noLoc Nothing) }
624

625
maybeimpspec :: { Located (Maybe (Bool, Located [LIE RdrName])) }
Alan Zimmerman's avatar
Alan Zimmerman committed
626 627
        : impspec                  { L (gl $1) (Just (unLoc $1)) }
        | {- empty -}              { noLoc Nothing }
628

629
impspec :: { Located (Bool, Located [LIE RdrName]) }
Alan Zimmerman's avatar
Alan Zimmerman committed
630 631 632 633 634 635
        :  '(' exportlist ')'                 {% ams (sLL $1 $> (False,
                                                        sLL $1 $> $ fromOL $2))
                                                      [mo $1,mc $3] }
        |  'hiding' '(' exportlist ')'        {% ams (sLL $1 $> (True,
                                                        sLL $1 $> $ fromOL $3))
                                                 [mj AnnHiding $1,mo $2,mc $4] }
636 637 638 639

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
640 641
prec    :: { Int }
        : {- empty -}           { 9 }
rodlogic's avatar
rodlogic committed
642
        | INTEGER               {% checkPrecP (sL1 $1 (fromInteger (getINTEGER $1))) }
643

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
644
infix   :: { Located FixityDirection }
rodlogic's avatar
rodlogic committed
645 646 647
        : 'infix'                               { sL1 $1 InfixN  }
        | 'infixl'                              { sL1 $1 InfixL  }
        | 'infixr'                              { sL1 $1 InfixR }
648

Alan Zimmerman's avatar
Alan Zimmerman committed
649 650 651 652
ops     :: { Located (OrdList (Located RdrName)) }
        : ops ',' op              {% addAnnotation (gl $3) AnnComma (gl $2) >>
                                     return (sLL $1 $> (unitOL $3 `appOL` (unLoc $1)))}
        | op                      { sL1 $1 (unitOL $1) }
653 654 655 656

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

657
topdecls :: { OrdList (LHsDecl RdrName) }
Alan Zimmerman's avatar
Alan Zimmerman committed
658 659 660 661 662
        : topdecls ';' topdecl        {% addAnnotation (oll $3) AnnSemi (gl $2)
                                         >> return ($1 `appOL` $3) }
        | topdecls ';'                {% addAnnotation (oll $1) AnnSemi (gl $2)
                                         >> return $1 }
        | topdecl                     { $1 }
663

664
topdecl :: { OrdList (LHsDecl RdrName) }
rodlogic's avatar
rodlogic committed
665 666 667 668 669
        : cl_decl                               { unitOL (sL1 $1 (TyClD (unLoc $1))) }
        | ty_decl                               { unitOL (sL1 $1 (TyClD (unLoc $1))) }
        | inst_decl                             { unitOL (sL1 $1 (InstD (unLoc $1))) }
        | stand_alone_deriving                  { unitOL (sLL $1 $> (DerivD (unLoc $1))) }
        | role_annot                            { unitOL (sL1 $1 (RoleAnnotD (unLoc $1))) }
Alan Zimmerman's avatar
Alan Zimmerman committed
670 671 672 673 674 675 676 677 678 679 680 681 682
        | 'default' '(' comma_types0 ')'    {% amsu (sLL $1 $> $ DefD (DefaultDecl $3))
                                                    [mj AnnDefault $1
                                                    ,mo $2,mc $4] }
        | 'foreign' fdecl                       {% amsu (sLL $1 $> (unLoc $2))
                                                        [mj AnnForeign $1] }
        | '{-# DEPRECATED' deprecations '#-}'   { $2 } -- ++AZ++ TODO
        | '{-# WARNING' warnings '#-}'          { $2 } -- ++AZ++ TODO
        | '{-# RULES' rules '#-}'               { $2 } -- ++AZ++ TODO
        | '{-# VECTORISE' qvar '=' exp '#-}' {% amsu (sLL $1 $> $ VectD (HsVect $2 $4))
                                                    [mo $1,mj AnnEqual $3
                                                    ,mc $5] }
        | '{-# NOVECTORISE' qvar '#-}'       {% amsu (sLL $1 $> $ VectD (HsNoVect $2))
                                                     [mo $1,mc $3] }
683
        | '{-# VECTORISE' 'type' gtycon '#-}'
Alan Zimmerman's avatar
Alan Zimmerman committed
684 685 686 687
                                {% amsu (sLL $1 $> $
                                    VectD (HsVectTypeIn False $3 Nothing))
                                    [mo $1,mj AnnType $2,mc $4] }

688
        | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
Alan Zimmerman's avatar
Alan Zimmerman committed
689 690 691 692
                                {% amsu (sLL $1 $> $
                                    VectD (HsVectTypeIn True $3 Nothing))
                                    [mo $1,mj AnnType $2,mc $4] }

693
        | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
Alan Zimmerman's avatar
Alan Zimmerman committed
694 695 696
                                {% amsu (sLL $1 $> $
                                    VectD (HsVectTypeIn False $3 (Just $5)))
                                    [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
697
        | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
Alan Zimmerman's avatar
Alan Zimmerman committed
698 699 700 701 702 703 704
                                {% amsu (sLL $1 $> $
                                    VectD (HsVectTypeIn True $3 (Just $5)))
                                    [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }

        | '{-# VECTORISE' 'class' gtycon '#-}'
                                         {% amsu (sLL $1 $>  $ VectD (HsVectClassIn $3))
                                                 [mo $1,mj AnnClass $2,mc $4] }
705
        | annotation { unitOL $1 }
706
        | decl_no_th                            { unLoc $1 }
707 708 709

        -- Template Haskell Extension
        -- The $(..) form is one possible form of infixexp
710
        -- but we treat an arbitrary expression just as if
711
        -- it had a $(..) wrapped around it
rodlogic's avatar
rodlogic committed
712
        | infixexp                              { unitOL (sLL $1 $> $ mkSpliceDecl $1) }
713

714 715 716
-- Type classes
--
cl_decl :: { LTyClDecl RdrName }
717
        : 'class' tycl_hdr fds where_cls
Alan Zimmerman's avatar
Alan Zimmerman committed
718 719
                {% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))
                        (mj AnnClass $1: (fst $ unLoc $4)) }
720

721
-- Type declarations (toplevel)
722 723
--
ty_decl :: { LTyClDecl RdrName }
724
           -- ordinary type synonyms
725
        : 'type' type '=' ctypedoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
726 727 728 729 730 731
                -- Note ctype, not sigtype, on the right of '='
                -- We allow an explicit for-all but we don't insert one
                -- in   type Foo a = (b,b)
                -- Instead we just say b is out of scope
                --
                -- Note the use of type for the head; this allows
732
                -- infix type constructors to be declared
Alan Zimmerman's avatar
Alan Zimmerman committed
733 734
                {% amms (mkTySynonym (comb2 $1 $4) $2 $4)
                        [mj AnnType $1,mj AnnEqual $3] }
735 736

           -- type family declarations
737
        | 'type' 'family' type opt_kind_sig where_type_family
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
738 739
                -- Note the use of type for the head; this allows
                -- infix type constructors to be declared
Alan Zimmerman's avatar
Alan Zimmerman committed
740 741 742
                {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $5) $3
                                   (unLoc $4))
                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $5)) }
743

744
          -- ordinary data type or newtype declaration
745
        | data_or_newtype capi_ctype tycl_hdr constrs deriving
Alan Zimmerman's avatar
Alan Zimmerman committed
746 747 748
                {% amms (mkTyData (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
                           Nothing (reverse (snd $ unLoc $4))
                                   (unLoc $5))
749
                                   -- We need the location on tycl_hdr in case
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
750
                                   -- constrs and deriving are both empty
Alan Zimmerman's avatar
Alan Zimmerman committed
751
                        ((fst $ unLoc $1):(fst $ unLoc $4)) }
752

753
          -- ordinary GADT declaration
754
        | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
755 756
                 gadt_constrlist
                 deriving
Alan Zimmerman's avatar
Alan Zimmerman committed
757 758
            {% amms (mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
                            (unLoc $4) (snd $ unLoc $5) (unLoc $6) )
759
                                   -- We need the location on tycl_hdr in case
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
760
                                   -- constrs and deriving are both empty
Alan Zimmerman's avatar
Alan Zimmerman committed
761
                    ((fst $ unLoc $1):(fst $ unLoc $5)) }
762

763
          -- data/newtype family
764
        | 'data' 'family' type opt_kind_sig
Alan Zimmerman's avatar
Alan Zimmerman committed
765 766
                {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (unLoc $4))
                        [mj AnnData $1,mj AnnFamily $2] }
767

768
inst_decl :: { LInstDecl RdrName }
769
        : 'instance' overlap_pragma inst_type where_inst
Alan Zimmerman's avatar
Alan Zimmerman committed
770 771 772 773 774 775 776
       {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
             ; let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
                                     , cid_sigs = sigs, cid_tyfam_insts = ats
                                     , cid_overlap_mode = $2
                                     , cid_datafam_insts = adts }
             ; ams (L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid }))
                   (mj AnnInstance $1 : (fst $ unLoc $4)) } }
777 778

           -- type instance declarations
779
        | 'type' 'instance' ty_fam_inst_eqn
Alan Zimmerman's avatar
Alan Zimmerman committed
780 781
                {% amms (mkTyFamInst (comb2 $1 $3) $3)
                    [mj AnnType $1,mj AnnInstance $2] }
782

783
          -- data/newtype instance declaration
784
        | data_or_newtype 'instance' capi_ctype tycl_hdr constrs deriving
Alan Zimmerman's avatar
Alan Zimmerman committed
785 786 787 788
            {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 $4
                                      Nothing (reverse (snd  $ unLoc $5))
                                              (unLoc $6))
                    ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) }
789

790
          -- GADT instance declaration
791
        | data_or_newtype 'instance' capi_ctype tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
792 793
                 gadt_constrlist
                 deriving
Alan Zimmerman's avatar
Alan Zimmerman committed
794 795 796 797
            {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 $4
                                   (unLoc $5) (snd $ unLoc $6) (unLoc $7))
                    ((fst $ unLoc $1):mj AnnInstance $2
                       :(fst $ unLoc $6)) }
798

799
overlap_pragma :: { Maybe (Located OverlapMode) }
Alan Zimmerman's avatar
Alan Zimmerman committed
800 801 802 803 804 805 806 807
  : '{-# OVERLAPPABLE'    '#-}' {% ajs (Just (sLL $1 $> Overlappable))
                                       [mo $1,mc $2] }
  | '{-# OVERLAPPING'     '#-}' {% ajs (Just (sLL $1 $> Overlapping))
                                       [mo $1,mc $2] }
  | '{-# OVERLAPS'        '#-}' {% ajs (Just (sLL $1 $> Overlaps))
                                       [mo $1,mc $2] }
  | '{-# INCOHERENT'      '#-}' {% ajs (Just (sLL $1 $> Incoherent))
                                       [mo $1,mc $2] }
808
  | {- empty -}                 { Nothing }
809 810


811 812
-- Closed type families

Alan Zimmerman's avatar
Alan Zimmerman committed
813 814
where_type_family :: { Located ([AddAnn],FamilyInfo RdrName) }
        : {- empty -}                      { noLoc ([],OpenTypeFamily) }
815
        | 'where' ty_fam_inst_eqn_list
Alan Zimmerman's avatar
Alan Zimmerman committed
816 817 818 819 820 821 822 823 824 825 826 827
               { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
                    ,ClosedTypeFamily (reverse (snd $ unLoc $2))) }

ty_fam_inst_eqn_list :: { Located ([AddAnn],[LTyFamInstEqn RdrName]) }
        :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ([mo $1,mc $3]
                                                ,unLoc $2) }
        | vocurly ty_fam_inst_eqns close   { let L loc _ = $2 in
                                             L loc ([],unLoc $2) }
        |     '{' '..' '}'                 { sLL $1 $> ([mo $1,mj AnnDotdot $2
                                                 ,mc $3],[]) }
        | vocurly '..' close               { let L loc _ = $2 in
                                             L loc ([mj AnnDotdot $2],[]) }
828 829

ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
Alan Zimmerman's avatar
Alan Zimmerman committed
830 831 832 833 834 835
        : ty_fam_inst_eqns ';' ty_fam_inst_eqn
                                      {% addAnnotation (gl $3) AnnSemi (gl $2)
                                         >> return (sLL $1 $> ($3 : unLoc $1)) }
        | ty_fam_inst_eqns ';'        {% addAnnotation (gl $1) AnnSemi (gl $2)
                                         >> return (sLL $1 $>  (unLoc $1)) }
        | ty_fam_inst_eqn             { sLL $1 $> [$1] }
836 837 838 839 840

ty_fam_inst_eqn :: { LTyFamInstEqn RdrName }
        : type '=' ctype
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
841
              {% do { eqn <- mkTyFamInstEqn $1 $3
Alan Zimmerman's avatar
Alan Zimmerman committed
842
                    ; aa (sLL $1 $> eqn) (AnnEqual, $2) } }
843

844
-- Associated type family declarations
845 846 847 848 849 850
--
-- * They have a different syntax than on the toplevel (no family special
--   identifier).
--
-- * They also need to be separate from instances; otherwise, data family
--   declarations without a kind signature cause parsing conflicts with empty
851
--   data declarations.
852
--
853
at_decl_cls :: { LHsDecl RdrName }
854 855
        :  -- data family declarations, with optional 'family' keyword
          'data' opt_family type opt_kind_sig
Alan Zimmerman's avatar
Alan Zimmerman committed
856 857 858
                {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
                                                  (unLoc $4)))
                        (mj AnnData $1:$2) }
859 860 861 862

           -- type family declarations, with optional 'family' keyword
           -- (can't use opt_instance because you get shift/reduce errors
        | 'type' type opt_kind_sig
Alan Zimmerman's avatar
Alan Zimmerman committed
863 864 865
               {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $2 $3)
                                                  OpenTypeFamily $2 (unLoc $3)))
                       [mj AnnType $1] }
866
        | 'type' 'family' type opt_kind_sig
Alan Zimmerman's avatar
Alan Zimmerman committed
867 868 869
               {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4)
                                                  OpenTypeFamily $3 (unLoc $4)))
                       [mj AnnType $1,mj AnnFamily $2] }
870 871

           -- default type instances, with optional 'instance' keyword
872
        | 'type' ty_fam_inst_eqn
Alan Zimmerman's avatar
Alan Zimmerman committed
873 874
                {% amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) $2))
                        [mj AnnType $1] }
875
        | 'type' 'instance' ty_fam_inst_eqn
Alan Zimmerman's avatar
Alan Zimmerman committed
876 877
                {% amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) $3))
                        [mj AnnType $1,mj AnnInstance $2] }
878

Alan Zimmerman's avatar
Alan Zimmerman committed
879 880 881
opt_family   :: { [AddAnn] }
              : {- empty -}   { [] }
              | 'family'      { [mj AnnFamily $1] }
882 883

-- Associated type instances
884
--
885
at_decl_inst :: { LInstDecl RdrName }
886
           -- type instance declarations
887
        : 'type' ty_fam_inst_eqn
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
888 889
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
Alan Zimmerman's avatar
Alan Zimmerman committed
890 891
                {% amms (mkTyFamInst (comb2 $1 $2) $2)
                        [mj AnnType $1] }
892 893

        -- data/newtype instance declaration
894
        | data_or_newtype capi_ctype tycl_hdr constrs deriving
Alan Zimmerman's avatar
Alan Zimmerman committed
895 896 897 898
               {% amms (mkDataFamInst (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
                                    Nothing (reverse (snd $ unLoc $4))
                                            (unLoc $5))
                       ((fst $ unLoc $1):(fst $ unLoc $4)) }
899 900

        -- GADT instance declaration
901
        | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
902 903
                 gadt_constrlist
                 deriving
Alan Zimmerman's avatar
Alan Zimmerman committed
904 905 906
                {% amms (mkDataFamInst (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2
                                $3 (unLoc $4) (snd $ unLoc $5) (unLoc $6))
                        ((fst $ unLoc $1):(fst $ unLoc $5)) }
907

Alan Zimmerman's avatar
Alan Zimmerman committed
908 909 910
data_or_newtype :: { Located (AddAnn,NewOrData) }
        : 'data'        { sL1 $1 (mj AnnData    $1,DataType) }
        | 'newtype'     { sL1 $1 (mj AnnNewtype $1,NewType) }
911

912
opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) }
Alan Zimmerman's avatar
Alan Zimmerman committed
913 914
        :                             { noLoc Nothing }
        | '::' kind                   {% ajl (sLL $1 $> (Just $2)) AnnDcolon (gl $1) }
915

916
-- tycl_hdr parses the header of a class or data type decl,
917
-- which takes the form
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
918 919 920 921
--      T a b
--      Eq a => T a
--      (Eq a, Ord b) => T a b
--      T Int [a]                       -- for associated types
922
-- Rather a lot of inlining here, else we get reduce/reduce errors
923
tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
Alan Zimmerman's avatar
Alan Zimmerman committed
924 925 926 927 928 929
        : context '=>' type         {% return (L (comb2 $1 $2) (unLoc $1))
                                       >>= \c@(L l _) ->
                                         (addAnnotation l AnnDarrow (gl $2))
                                       >> (return (sLL $1 $> (Just c, $3)))
                                    }
        | type                      { sL1 $1 (Nothing, $1) }
930

931 932
capi_ctype :: { Maybe (Located CType) }
capi_ctype : '{-# CTYPE' STRING STRING '#-}'
Alan Zimmerman's avatar
Alan Zimmerman committed
933 934 935 936
                       {% ajs (Just (sLL $1 $> (CType (Just (Header (getSTRING $2)))
                                        (getSTRING $3))))
                              [mo $1,mj AnnHeader $2,mj AnnVal $3,mc $4] }

937
           | '{-# CTYPE'        STRING '#-}'
Alan Zimmerman's avatar
Alan Zimmerman committed
938 939 940 941
                       {% ajs (Just (sLL $1 $> (CType Nothing  (getSTRING $2))))
                              [mo $1,mj AnnVal $2,mc $3] }

           |           { Nothing }
942

943 944 945 946 947
-----------------------------------------------------------------------------
-- Stand-alone deriving

-- Glasgow extension: stand-alone deriving declarations
stand_alone_deriving :: { LDerivDecl RdrName }
Alan Zimmerman's avatar
Alan Zimmerman committed
948 949 950
  : 'deriving' 'instance' overlap_pragma inst_type
                         {% ams (sLL $1 $> (DerivDecl $4 $3))
                                [mj AnnDeriving $1,mj AnnInstance $2] }
951

952 953 954 955 956
-----------------------------------------------------------------------------
-- Role annotations

role_annot :: { LRoleAnnotDecl RdrName }
role_annot : 'type' 'role' oqtycon maybe_roles
Alan Zimmerman's avatar
Alan Zimmerman committed
957 958
          {% amms (mkRoleAnnotDecl (comb3 $1 $3 $4) $3 (reverse (unLoc $4)))
                  [mj AnnType $1,mj AnnRole $2] }
959 960 961 962 963 964 965

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

roles :: { Located [Located (Maybe FastString)] }
rodlogic's avatar
rodlogic committed
966 967
roles : role             { sLL $1 $> [$1] }
      | roles role       { sLL $1 $> $ $2 : unLoc $1 }
968 969 970

-- read it in as a varid for better error messages
role :: { Located (Maybe FastString) }
rodlogic's avatar
rodlogic committed
971 972
role : VARID             { sL1 $1 $ Just $ getVARID $1 }
     | '_'               { sL1 $1 Nothing }
973

Gergő Érdi's avatar
Gergő Érdi committed
974 975 976 977
-- Pattern synonyms

-- Glasgow extension: pattern synonyms
pattern_synonym_decl :: { LHsDecl RdrName }
978
        : 'pattern' pattern_synonym_lhs '=' pat
Alan Zimmerman's avatar
Alan Zimmerman committed
979 980 981 982 983
         {%ams ( let (name, args) = $2
                 in sLL $1 $> . ValD $ mkPatSynBind name args $4
                                                    ImplicitBidirectional)
               [mj AnnPattern $1,mj AnnEqual $3]
         }
984
        | 'pattern' pattern_synonym_lhs '<-' pat
Alan Zimmerman's avatar
Alan Zimmerman committed
985 986 987
         {%ams (let (name, args) = $2
                in sLL $1 $> . ValD $ mkPatSynBind name args $4 Unidirectional)
               [mj AnnPattern $1,mj AnnLarrow $3] }
988 989
        | 'pattern' pattern_synonym_lhs '<-' pat where_decls
            {% do { let (name, args) = $2
Alan Zimmerman's avatar
Alan Zimmerman committed
990 991 992 993 994
                  ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
                  ; ams (sLL $1 $> . ValD $
                           mkPatSynBind name args $4 (ExplicitBidirectional mg))
                        (mj AnnPattern $1:mj AnnLarrow $3:(fst $ unLoc $5))