Parser.y 107 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
75

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

rodlogic's avatar
rodlogic committed
79 80 81 82 83 84
-- 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 )
85 86 87
}

{-
88
-----------------------------------------------------------------------------
Gabor Greif's avatar
Gabor Greif committed
89 90 91 92 93 94 95
12 October 2012

Conflicts: 43 shift/reduce
           1 reduce/reduce

-----------------------------------------------------------------------------
24 February 2006
96 97 98 99 100 101 102 103 104

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

105 106 107 108 109 110 111 112 113 114 115
-----------------------------------------------------------------------------
31 December 2006

Conflicts: 34 shift/reduce
           1 reduce/reduce

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

  -=chak

116 117 118 119 120 121 122 123 124 125 126
-----------------------------------------------------------------------------
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

127 128 129 130 131 132 133 134 135 136 137
-----------------------------------------------------------------------------
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

138
-----------------------------------------------------------------------------
139
Conflicts: 38 shift/reduce (1.25)
140

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
141 142 143
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
144

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
145 146
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)
147

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
148 149 150
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: -<, >-, -<<, >>-
151 152


chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
153 154 155 156
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
157
    or
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
158 159
          case v of
            (x::T -> T) -> ..   -- Rhs is ...
ross's avatar
ross committed
160

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
167 168 169 170
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.
171

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
172 173 174 175
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
176

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
177 178 179 180 181 182 183
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'.
184

185 186
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
187
  follows. Shift parses as if the 'module' keyword follows.
188

189 190 191
-- ---------------------------------------------------------------------------
-- Adding location info

rodlogic's avatar
rodlogic committed
192 193 194 195
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.
196 197 198

They each add a SrcSpan to their argument.

rodlogic's avatar
rodlogic committed
199
   sL0  adds 'noSrcSpan', used for empty productions
200
     -- This doesn't seem to work anymore -=chak
201

rodlogic's avatar
rodlogic committed
202
   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
203
        from that token.
204

rodlogic's avatar
rodlogic committed
205
   sLL  for a production with >1 token on the lhs.  Makes up a SrcSpan from
206 207 208
        the first and last tokens.

These suffice for the majority of cases.  However, we must be
rodlogic's avatar
rodlogic committed
209
especially careful with empty productions: sLL won't work if the first
210 211 212
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
213 214 215
        | 'newtype' tycl_hdr '=' newconstr deriving
                { L (comb3 $1 $4 $5)
                    (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
216 217 218 219 220 221 222 223 224 225 226 227

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
228 229
 '_'            { L _ ITunderscore }            -- Haskell keywords
 'as'           { L _ ITas }
230 231 232
 'case'         { L _ ITcase }
 'class'        { L _ ITclass }
 'data'         { L _ ITdata }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
 '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 }
257
 'label'        { L _ ITlabel }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
258 259
 'dynamic'      { L _ ITdynamic }
 'safe'         { L _ ITsafe }
260
 'interruptible' { L _ ITinterruptible }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
261 262 263
 'unsafe'       { L _ ITunsafe }
 'mdo'          { L _ ITmdo }
 'family'       { L _ ITfamily }
264
 'role'         { L _ ITrole }
265 266
 'stdcall'      { L _ ITstdcallconv }
 'ccall'        { L _ ITccallconv }
267
 'capi'         { L _ ITcapiconv }
268
 'prim'         { L _ ITprimcallconv }
thoughtpolice's avatar
thoughtpolice committed
269
 'javascript'   { L _ ITjavascriptcallconv }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
270 271
 'proc'         { L _ ITproc }          -- for arrow notation extension
 'rec'          { L _ ITrec }           -- for arrow notation extension
272 273 274
 '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
275
 'pattern'      { L _ ITpattern } -- for pattern synonyms
276

277 278
 '{-# INLINE'             { L _ (ITinline_prag _ _) }
 '{-# SPECIALISE'         { L _ ITspec_prag }
279
 '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
280 281 282
 '{-# SOURCE'                                   { L _ ITsource_prag }
 '{-# RULES'                                    { L _ ITrules_prag }
 '{-# CORE'                                     { L _ ITcore_prag }              -- hdaume: annotated core
283 284 285 286 287
 '{-# SCC'                { L _ ITscc_prag }
 '{-# GENERATED'          { L _ ITgenerated_prag }
 '{-# DEPRECATED'         { L _ ITdeprecated_prag }
 '{-# WARNING'            { L _ ITwarning_prag }
 '{-# UNPACK'             { L _ ITunpack_prag }
288
 '{-# NOUNPACK'           { L _ ITnounpack_prag }
289
 '{-# ANN'                { L _ ITann_prag }
290 291
 '{-# VECTORISE'          { L _ ITvect_prag }
 '{-# VECTORISE_SCALAR'   { L _ ITvect_scalar_prag }
292
 '{-# NOVECTORISE'        { L _ ITnovect_prag }
293
 '{-# MINIMAL'            { L _ ITminimal_prag }
294
 '{-# CTYPE'              { L _ ITctype }
295 296 297
 '{-# OVERLAPPING'        { L _ IToverlapping_prag }
 '{-# OVERLAPPABLE'       { L _ IToverlappable_prag }
 '{-# OVERLAPS'           { L _ IToverlaps_prag }
298
 '{-# INCOHERENT'         { L _ ITincoherent_prag }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
299 300 301 302 303 304 305
 '#-}'                                          { L _ ITclose_prag }

 '..'           { L _ ITdotdot }                        -- reserved symbols
 ':'            { L _ ITcolon }
 '::'           { L _ ITdcolon }
 '='            { L _ ITequal }
 '\\'           { L _ ITlam }
306
 'lcase'        { L _ ITlcase }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339
 '|'            { 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
340
 SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
341 342 343 344 345 346 347 348 349

 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  _) }
350 351
 PREFIXQVARSYM  { L _ (ITprefixqvarsym  _) }
 PREFIXQCONSYM  { L _ (ITprefixqconsym  _) }
352

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
353 354 355 356 357 358
 IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
360 361 362 363 364 365 366 367 368 369 370
 PRIMCHAR       { L _ (ITprimchar   _) }
 PRIMSTRING     { L _ (ITprimstring _) }
 PRIMINTEGER    { L _ (ITprimint    _) }
 PRIMWORD       { L _ (ITprimword  _) }
 PRIMFLOAT      { L _ (ITprimfloat  _) }
 PRIMDOUBLE     { L _ (ITprimdouble _) }

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

372 373 374 375 376
-- Template Haskell
'[|'            { L _ ITopenExpQuote  }
'[p|'           { L _ ITopenPatQuote  }
'[t|'           { L _ ITopenTypQuote  }
'[d|'           { L _ ITopenDecQuote  }
377
'|]'            { L _ ITcloseQuote    }
378 379
'[||'           { L _ ITopenTExpQuote   }
'||]'           { L _ ITcloseTExpQuote  }
380
TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
381
'$('            { L _ ITparenEscape   }     -- $( exp )
382 383
TH_ID_TY_SPLICE { L _ (ITidTyEscape _)  }   -- $$x
'$$('           { L _ ITparenTyEscape   }   -- $$( exp )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
384 385
TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
386
TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
387 388 389

%monad { P } { >>= } { return }
%lexer { lexer } { L _ ITeof }
390 391 392
%tokentype { (Located Token) }

-- Exported parsers
393
%name parseModule module
394 395 396 397 398 399
%name parseImport importdecl
%name parseStatement stmt
%name parseDeclaration topdecl
%name parseExpression exp
%name parseTypeSignature sigdecl
%name parseFullStmt   stmt
400 401
%name parseStmt   maybe_stmt
%name parseIdentifier  identifier
402
%name parseType ctype
403
%partial parseHeader header
404 405
%%

406 407 408
-----------------------------------------------------------------------------
-- Identifiers; one of the entry points
identifier :: { Located RdrName }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
409 410 411 412
        : qvar                          { $1 }
        | qcon                          { $1 }
        | qvarop                        { $1 }
        | qconop                        { $1 }
rodlogic's avatar
rodlogic committed
413
    | '(' '->' ')'      { sLL $1 $> $ getRdrName funTyCon }
414

415 416 417 418 419 420 421 422 423 424
-----------------------------------------------------------------------------
-- Module Header

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
425 426 427 428
module  :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 $1
429
                          ) )}
430
        | body2
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
431 432
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule Nothing Nothing
433 434
                          (fst $1) (snd $1) Nothing Nothing
                          )) }
435

436
maybedocheader :: { Maybe LHsDocString }
437
        : moduleheader            { $1 }
438
        | {- empty -}             { Nothing }
439 440

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

Ian Lynagh's avatar
Ian Lynagh committed
443
maybemodwarning :: { Maybe WarningTxt }
444 445
    : '{-# DEPRECATED' strings '#-}' { Just (DeprecatedTxt $ unLoc $2) }
    | '{-# WARNING' strings '#-}'    { Just (WarningTxt $ unLoc $2) }
Ian Lynagh's avatar
Ian Lynagh committed
446
    |  {- empty -}                  { Nothing }
447

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
448 449 450
body    :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
        :  '{'            top '}'               { $2 }
        |      vocurly    top close             { $2 }
451

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
452 453 454
body2   :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
        :  '{' top '}'                          { $2 }
        |  missing_module_keyword top close     { $2 }
455

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
456 457 458 459
top     :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
        : importdecls                           { (reverse $1,[]) }
        | importdecls ';' cvtopdecls            { (reverse $1,$3) }
        | cvtopdecls                            { ([],$1) }
460 461

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

464 465 466
-----------------------------------------------------------------------------
-- Module declaration & imports only

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
467 468 469 470
header  :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule (Just $3) $5 $7 [] $4 $1
471
                          ))}
472
        | header_body2
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
473
                {% fileSrcSpan >>= \ loc ->
474
                   return (L loc (HsModule Nothing Nothing $1 [] Nothing
475
                          Nothing)) }
476 477

header_body :: { [LImportDecl RdrName] }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
478
        :  '{'            importdecls           { $2 }
479 480 481 482 483
        |      vocurly    importdecls           { $2 }

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

485 486 487 488
-----------------------------------------------------------------------------
-- The Export List

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

492 493
exportlist :: { OrdList (LIE RdrName) }
        : expdoclist ',' expdoclist             { $1 `appOL` $3 }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
494
        | exportlist1                           { $1 }
495

496 497 498
exportlist1 :: { OrdList (LIE RdrName) }
        : expdoclist export expdoclist ',' exportlist1 { $1 `appOL` $2 `appOL` $3 `appOL` $5 }
        | expdoclist export expdoclist                 { $1 `appOL` $2 `appOL` $3 }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
499
        | expdoclist                                   { $1 }
500

501 502 503
expdoclist :: { OrdList (LIE RdrName) }
        : exp_doc expdoclist                           { $1 `appOL` $2 }
        | {- empty -}                                  { nilOL }
504

505
exp_doc :: { OrdList (LIE RdrName) }
rodlogic's avatar
rodlogic committed
506 507 508
        : 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))) }
509 510


511 512
   -- No longer allow things like [] and (,,,) to be exported
   -- They are built in syntax, always available
513
export  :: { OrdList (LIE RdrName) }
rodlogic's avatar
rodlogic committed
514
        : qcname_ext export_subspec     { unitOL (sLL $1 $> (mkModuleImpExp (unLoc $1)
515
                                                                     (unLoc $2))) }
rodlogic's avatar
rodlogic committed
516 517
        |  'module' modid               { unitOL (sLL $1 $> (IEModuleContents (unLoc $2))) }
        |  'pattern' qcon               { unitOL (sLL $1 $> (IEVar (unLoc $2))) }
518

519
export_subspec :: { Located ImpExpSubSpec }
rodlogic's avatar
rodlogic committed
520 521 522 523
        : {- empty -}                   { sL0 ImpExpAbs }
        | '(' '..' ')'                  { sLL $1 $> ImpExpAll }
        | '(' ')'                       { sLL $1 $> (ImpExpList []) }
        | '(' qcnames ')'               { sLL $1 $> (ImpExpList (reverse $2)) }
524

525
qcnames :: { [RdrName] }     -- A reversed list
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
526 527
        :  qcnames ',' qcname_ext       { unLoc $3 : $1 }
        |  qcname_ext                   { [unLoc $1]  }
528

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
529 530 531
qcname_ext :: { Located RdrName }       -- Variable or data constructor
                                        -- or tagged type constructor
        :  qcname                       { $1 }
rodlogic's avatar
rodlogic committed
532
        |  'type' qcname                {% mkTypeImpExp (sLL $1 $> (unLoc $2)) }
533 534

-- 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
535 536 537
qcname  :: { Located RdrName }  -- Variable or data constructor
        :  qvar                         { $1 }
        |  qcon                         { $1 }
538 539 540 541 542 543 544 545

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

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

importdecls :: { [LImportDecl RdrName] }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
546 547 548 549
        : importdecls ';' importdecl            { $3 : $1 }
        | importdecls ';'                       { $1 }
        | importdecl                            { [ $1 ] }
        | {- empty -}                           { [] }
550 551

importdecl :: { LImportDecl RdrName }
552
        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
553
                { L (comb4 $1 $6 $7 $8) $
554 555 556 557
                  ImportDecl { ideclName = $6, ideclPkgQual = $5
                             , ideclSource = $2, ideclSafe = $3
                             , ideclQualified = $4, ideclImplicit = False
                             , ideclAs = unLoc $7, ideclHiding = unLoc $8 } }
558 559

maybe_src :: { IsBootInterface }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
560 561
        : '{-# SOURCE' '#-}'                    { True }
        | {- empty -}                           { False }
562

563
maybe_safe :: { Bool }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
564 565
        : 'safe'                                { True }
        | {- empty -}                           { False }
566

567 568 569 570
maybe_pkg :: { Maybe FastString }
        : STRING                                { Just (getSTRING $1) }
        | {- empty -}                           { Nothing }

571
optqualified :: { Bool }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
572 573
        : 'qualified'                           { True  }
        | {- empty -}                           { False }
574

Simon Marlow's avatar
Simon Marlow committed
575
maybeas :: { Located (Maybe ModuleName) }
rodlogic's avatar
rodlogic committed
576
        : 'as' modid                            { sLL $1 $> (Just (unLoc $2)) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
577
        | {- empty -}                           { noLoc Nothing }
578 579

maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
rodlogic's avatar
rodlogic committed
580
        : impspec                               { sL1 $1 (Just (unLoc $1)) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
581
        | {- empty -}                           { noLoc Nothing }
582 583

impspec :: { Located (Bool, [LIE RdrName]) }
rodlogic's avatar
rodlogic committed
584 585
        :  '(' exportlist ')'                   { sLL $1 $> (False, fromOL $2) }
        |  'hiding' '(' exportlist ')'          { sLL $1 $> (True,  fromOL $3) }
586 587 588 589

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
590 591
prec    :: { Int }
        : {- empty -}           { 9 }
rodlogic's avatar
rodlogic committed
592
        | INTEGER               {% checkPrecP (sL1 $1 (fromInteger (getINTEGER $1))) }
593

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
594
infix   :: { Located FixityDirection }
rodlogic's avatar
rodlogic committed
595 596 597
        : 'infix'                               { sL1 $1 InfixN  }
        | 'infixl'                              { sL1 $1 InfixL  }
        | 'infixr'                              { sL1 $1 InfixR }
598

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
599
ops     :: { Located [Located RdrName] }
rodlogic's avatar
rodlogic committed
600 601
        : ops ',' op                            { sLL $1 $> ($3 : unLoc $1) }
        | op                                    { sL1 $1 [$1] }
602 603 604 605

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

606
topdecls :: { OrdList (LHsDecl RdrName) }
607 608 609
        : topdecls ';' topdecl                  { $1 `appOL` $3 }
        | topdecls ';'                          { $1 }
        | topdecl                               { $1 }
610

611
topdecl :: { OrdList (LHsDecl RdrName) }
rodlogic's avatar
rodlogic committed
612 613 614 615 616 617 618
        : 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))) }
        | 'default' '(' comma_types0 ')'        { unitOL (sLL $1 $> $ DefD (DefaultDecl $3)) }
        | 'foreign' fdecl                       { unitOL (sLL $1 $> (unLoc $2)) }
619 620
        | '{-# DEPRECATED' deprecations '#-}'   { $2 }
        | '{-# WARNING' warnings '#-}'          { $2 }
621
        | '{-# RULES' rules '#-}'               { $2 }
rodlogic's avatar
rodlogic committed
622 623
        | '{-# VECTORISE' qvar '=' exp '#-}'    { unitOL $ sLL $1 $> $ VectD (HsVect       $2 $4) }
        | '{-# NOVECTORISE' qvar '#-}'          { unitOL $ sLL $1 $> $ VectD (HsNoVect     $2) }
624
        | '{-# VECTORISE' 'type' gtycon '#-}'
rodlogic's avatar
rodlogic committed
625
                                                { unitOL $ sLL $1 $> $
626
                                                    VectD (HsVectTypeIn False $3 Nothing) }
627
        | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
rodlogic's avatar
rodlogic committed
628
                                                { unitOL $ sLL $1 $> $
629
                                                    VectD (HsVectTypeIn True $3 Nothing) }
630
        | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
rodlogic's avatar
rodlogic committed
631
                                                { unitOL $ sLL $1 $> $
632
                                                    VectD (HsVectTypeIn False $3 (Just $5)) }
633
        | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
rodlogic's avatar
rodlogic committed
634
                                                { unitOL $ sLL $1 $> $
635
                                                    VectD (HsVectTypeIn True $3 (Just $5)) }
rodlogic's avatar
rodlogic committed
636
        | '{-# VECTORISE' 'class' gtycon '#-}'  { unitOL $ sLL $1 $> $ VectD (HsVectClassIn $3) }
637
        | annotation { unitOL $1 }
638
        | decl_no_th                            { unLoc $1 }
639 640 641

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

646 647 648
-- Type classes
--
cl_decl :: { LTyClDecl RdrName }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
649
        : 'class' tycl_hdr fds where_cls        {% mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 $4 }
650

651
-- Type declarations (toplevel)
652 653
--
ty_decl :: { LTyClDecl RdrName }
654
           -- ordinary type synonyms
655
        : 'type' type '=' ctypedoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
656 657 658 659 660 661
                -- 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
662
                -- infix type constructors to be declared
663
                {% mkTySynonym (comb2 $1 $4) $2 $4 }
664 665

           -- type family declarations
666
        | 'type' 'family' type opt_kind_sig where_type_family
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
667 668
                -- Note the use of type for the head; this allows
                -- infix type constructors to be declared
669
                {% mkFamDecl (comb4 $1 $3 $4 $5) (unLoc $5) $3 (unLoc $4) }
670

671
          -- ordinary data type or newtype declaration
672
        | data_or_newtype capi_ctype tycl_hdr constrs deriving
673
                {% mkTyData (comb4 $1 $3 $4 $5) (unLoc $1) $2 $3
674
                            Nothing (reverse (unLoc $4)) (unLoc $5) }
675
                                   -- We need the location on tycl_hdr in case
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
676
                                   -- constrs and deriving are both empty
677

678
          -- ordinary GADT declaration
679
        | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
680 681
                 gadt_constrlist
                 deriving
682
                {% mkTyData (comb4 $1 $3 $5 $6) (unLoc $1) $2 $3
683
                            (unLoc $4) (unLoc $5) (unLoc $6) }
684
                                   -- We need the location on tycl_hdr in case
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
685
                                   -- constrs and deriving are both empty
686

687
          -- data/newtype family
688
        | 'data' 'family' type opt_kind_sig
689
                {% mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (unLoc $4) }
690

691
inst_decl :: { LInstDecl RdrName }
692 693 694
        : 'instance' overlap_pragma inst_type where_inst
                 { let (binds, sigs, _, ats, adts, _) = cvBindsAndSigs (unLoc $4) in
                   let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
695
                                         , cid_sigs = sigs, cid_tyfam_insts = ats
696
                                         , cid_overlap_mode = $2
697
                                         , cid_datafam_insts = adts }
698
                   in L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid }) }
699 700

           -- type instance declarations
701
        | 'type' 'instance' ty_fam_inst_eqn
702
                {% mkTyFamInst (comb2 $1 $3) $3 }
703

704
          -- data/newtype instance declaration
705 706 707
        | data_or_newtype 'instance' capi_ctype tycl_hdr constrs deriving
                {% mkDataFamInst (comb4 $1 $4 $5 $6) (unLoc $1) $3 $4
                                      Nothing (reverse (unLoc $5)) (unLoc $6) }
708

709
          -- GADT instance declaration
710
        | data_or_newtype 'instance' capi_ctype tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
711 712
                 gadt_constrlist
                 deriving
713 714
                {% mkDataFamInst (comb4 $1 $4 $6 $7) (unLoc $1) $3 $4
                                     (unLoc $5) (unLoc $6) (unLoc $7) }
715

716
overlap_pragma :: { Maybe OverlapMode }
717 718 719 720 721
  : '{-# OVERLAPPABLE'    '#-}' { Just Overlappable }
  | '{-# OVERLAPPING'     '#-}' { Just Overlapping }
  | '{-# OVERLAPS'        '#-}' { Just Overlaps }
  | '{-# INCOHERENT'      '#-}' { Just Incoherent }
  | {- empty -}                 { Nothing }
722 723


724 725 726 727 728
-- Closed type families

where_type_family :: { Located (FamilyInfo RdrName) }
        : {- empty -}                      { noLoc OpenTypeFamily }
        | 'where' ty_fam_inst_eqn_list
rodlogic's avatar
rodlogic committed
729
               { sLL $1 $> (ClosedTypeFamily (reverse (unLoc $2))) }
730 731

ty_fam_inst_eqn_list :: { Located [LTyFamInstEqn RdrName] }
rodlogic's avatar
rodlogic committed
732
        :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> (unLoc $2) }
733
        | vocurly ty_fam_inst_eqns close   { $2 }
rodlogic's avatar
rodlogic committed
734
        |     '{' '..' '}'                 { sLL $1 $> [] }
735
        | vocurly '..' close               { let L loc _ = $2 in L loc [] }
736 737

ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
rodlogic's avatar
rodlogic committed
738 739 740
        : ty_fam_inst_eqns ';' ty_fam_inst_eqn   { sLL $1 $> ($3 : unLoc $1) }
        | ty_fam_inst_eqns ';'                   { sLL $1 $> (unLoc $1) }
        | ty_fam_inst_eqn                        { sLL $1 $> [$1] }
741 742 743 744 745

ty_fam_inst_eqn :: { LTyFamInstEqn RdrName }
        : type '=' ctype
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
746
              {% do { eqn <- mkTyFamInstEqn $1 $3
rodlogic's avatar
rodlogic committed
747
                    ; return (sLL $1 $> eqn) } }
748

749
-- Associated type family declarations
750 751 752 753 754 755
--
-- * 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
756
--   data declarations.
757
--
758
at_decl_cls :: { LHsDecl RdrName }
759 760 761 762 763 764 765 766 767 768 769 770
        :  -- data family declarations, with optional 'family' keyword
          'data' opt_family type opt_kind_sig
                {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3 (unLoc $4)) }

           -- type family declarations, with optional 'family' keyword
           -- (can't use opt_instance because you get shift/reduce errors
        | 'type' type opt_kind_sig
                {% liftM mkTyClD (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily $2 (unLoc $3)) }
        | 'type' 'family' type opt_kind_sig
                {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily $3 (unLoc $4)) }

           -- default type instances, with optional 'instance' keyword
771
        | 'type' ty_fam_inst_eqn
772 773 774 775 776 777 778
                {% liftM mkInstD (mkTyFamInst (comb2 $1 $2) $2) }
        | 'type' 'instance' ty_fam_inst_eqn
                {% liftM mkInstD (mkTyFamInst (comb2 $1 $3) $3) }

opt_family   :: { () }
              : {- empty -}   { () }
              | 'family'      { () }
779 780

-- Associated type instances
781
--
782
at_decl_inst :: { LInstDecl RdrName }
783
           -- type instance declarations
784
        : 'type' ty_fam_inst_eqn
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
785 786
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
787
                {% mkTyFamInst (comb2 $1 $2) $2 }
788 789

        -- data/newtype instance declaration
790 791
        | data_or_newtype capi_ctype tycl_hdr constrs deriving
                {% mkDataFamInst (comb4 $1 $3 $4 $5) (unLoc $1) $2 $3
792
                                 Nothing (reverse (unLoc $4)) (unLoc $5) }
793 794

        -- GADT instance declaration
795
        | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
796 797
                 gadt_constrlist
                 deriving
798
                {% mkDataFamInst (comb4 $1 $3 $5 $6) (unLoc $1) $2 $3
799
                                 (unLoc $4) (unLoc $5) (unLoc $6) }
800

801
data_or_newtype :: { Located NewOrData }
rodlogic's avatar
rodlogic committed
802 803
        : 'data'        { sL1 $1 DataType }
        | 'newtype'     { sL1 $1 NewType }
804

805
opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
806
        :                               { noLoc Nothing }
rodlogic's avatar
rodlogic committed
807
        | '::' kind                     { sLL $1 $> (Just $2) }
808

809
-- tycl_hdr parses the header of a class or data type decl,
810
-- which takes the form
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
811 812 813 814
--      T a b
--      Eq a => T a
--      (Eq a, Ord b) => T a b
--      T Int [a]                       -- for associated types
815
-- Rather a lot of inlining here, else we get reduce/reduce errors
816
tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
rodlogic's avatar
rodlogic committed
817 818
        : context '=>' type             { sLL $1 $> (Just $1, $3) }
        | type                          { sL1 $1 (Nothing, $1) }
819

820
capi_ctype :: { Maybe CType }
821 822
capi_ctype : '{-# CTYPE' STRING STRING '#-}' { Just (CType (Just (Header (getSTRING $2))) (getSTRING $3)) }
           | '{-# CTYPE'        STRING '#-}' { Just (CType Nothing                        (getSTRING $2)) }
823
           |                                 { Nothing }
824

825 826 827 828 829
-----------------------------------------------------------------------------
-- Stand-alone deriving

-- Glasgow extension: stand-alone deriving declarations
stand_alone_deriving :: { LDerivDecl RdrName }
rodlogic's avatar
rodlogic committed
830
  : 'deriving' 'instance' overlap_pragma inst_type { sLL $1 $> (DerivDecl $4 $3) }
831

832 833 834 835 836 837 838 839 840 841 842 843 844
-----------------------------------------------------------------------------
-- Role annotations

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

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

roles :: { Located [Located (Maybe FastString)] }
rodlogic's avatar
rodlogic committed
845 846
roles : role             { sLL $1 $> [$1] }
      | roles role       { sLL $1 $> $ $2 : unLoc $1 }
847 848 849

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

Gergő Érdi's avatar
Gergő Érdi committed
853 854 855 856
-- Pattern synonyms

-- Glasgow extension: pattern synonyms
pattern_synonym_decl :: { LHsDecl RdrName }
857 858
        : 'pattern' pat '=' pat
            {% do { (name, args) <- splitPatSyn $2
rodlogic's avatar
rodlogic committed
859
                  ; return $ sLL $1 $> . ValD $ mkPatSynBind name args $4 ImplicitBidirectional
860 861 862
                  }}
        | 'pattern' pat '<-' pat
            {% do { (name, args) <- splitPatSyn $2
rodlogic's avatar
rodlogic committed
863
                  ; return $ sLL $1 $> . ValD $ mkPatSynBind name args $4 Unidirectional
864
                  }}
865 866 867
        | 'pattern' pat '<-' pat where_decls
            {% do { (name, args) <- splitPatSyn $2
                  ; mg <- toPatSynMatchGroup name $5
rodlogic's avatar
rodlogic committed
868
                  ; return $ sLL $1 $> . ValD $
869 870 871 872 873 874
                    mkPatSynBind name args $4 (ExplicitBidirectional mg)
                  }}

where_decls :: { Located (OrdList (LHsDecl RdrName)) }
        : 'where' '{' decls '}'       { $3 }
        | 'where' vocurly decls close { $3 }
Gergő Érdi's avatar
Gergő Érdi committed
875 876 877 878 879

vars0 :: { [Located RdrName] }
        : {- empty -}                 { [] }
        | varid vars0                 { $1 : $2 }

880 881 882
-----------------------------------------------------------------------------
-- Nested declarations

883
-- Declaration in class bodies
884
--
885
decl_cls  :: { Located (OrdList (LHsDecl RdrName)) }
rodlogic's avatar
rodlogic committed
886
decl_cls  : at_decl_cls                 { sLL $1 $> (unitOL $1) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
887
          | decl                        { $1 }
888

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
889
          -- A 'default' signature used with the generic-programming extension
890 891
          | 'default' infixexp '::' sigtypedoc
                    {% do { (TypeSig l ty) <- checkValSig $2 $4
rodlogic's avatar
rodlogic committed
892
                          ; return (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (GenericSig l ty))) } }
893

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
894
decls_cls :: { Located (OrdList (LHsDecl RdrName)) }    -- Reversed
rodlogic's avatar
rodlogic committed
895 896
          : decls_cls ';' decl_cls      { sLL $1 $> (unLoc $1 `appOL` unLoc $3) }
          | decls_cls ';'               { sLL $1 $> (unLoc $1) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
897 898
          | decl_cls                    { $1 }
          | {- empty -}                 { noLoc nilOL }
899 900


chak@cse.unsw.edu.au.'s avatar