2 -- ---------------------------------------------------------------------------
3 -- (c) The University of Glasgow 1997-2003
7 -- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
8 -- ---------------------------------------------------------------------------
11 module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
14 #define INCLUDE #include
15 INCLUDE "HsVersions.h"
19 import HscTypes ( IsBootInterface, DeprecTxt )
22 import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
23 listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
24 import Type ( funTyCon )
25 import ForeignCall ( Safety(..), CExportSpec(..), CLabelString,
26 CCallConv(..), CCallTarget(..), defaultCCallConv
28 import OccName ( varName, dataName, tcClsName, tvName )
29 import DataCon ( DataCon, dataConName )
30 import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
31 SrcSpan, combineLocs, srcLocFile,
34 import StaticFlags ( opt_SccProfilingOn, opt_Hpc )
35 import Type ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
36 import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
37 Activation(..), defaultInlineSpec )
40 import {-# SOURCE #-} HaddockLex hiding ( Token )
44 import Maybes ( orElse )
47 import Control.Monad ( unless )
50 import Control.Monad ( mplus )
54 -----------------------------------------------------------------------------
57 Conflicts: 33 shift/reduce
60 The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
61 would think the two should never occur in the same context.
65 -----------------------------------------------------------------------------
68 Conflicts: 34 shift/reduce
71 The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
72 would think the two should never occur in the same context.
76 -----------------------------------------------------------------------------
79 Conflicts: 32 shift/reduce
82 The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
83 would think the two should never occur in the same context.
87 -----------------------------------------------------------------------------
90 Conflicts: 37 shift/reduce
93 The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
94 would think the two should never occur in the same context.
98 -----------------------------------------------------------------------------
99 Conflicts: 38 shift/reduce (1.25)
101 10 for abiguity in 'if x then y else z + 1' [State 178]
102 (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
103 10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
105 1 for ambiguity in 'if x then y else z :: T' [State 178]
106 (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
108 4 for ambiguity in 'if x then y else z -< e' [State 178]
109 (shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
110 There are four such operators: -<, >-, -<<, >>-
113 2 for ambiguity in 'case v of { x :: T -> T ... } ' [States 11, 253]
114 Which of these two is intended?
116 (x::T) -> T -- Rhs is T
119 (x::T -> T) -> .. -- Rhs is ...
121 10 for ambiguity in 'e :: a `b` c'. Does this mean [States 11, 253]
124 As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases
125 Same duplication between states 11 and 253 as the previous case
127 1 for ambiguity in 'let ?x ...' [State 329]
128 the parser can't tell whether the ?x is the lhs of a normal binding or
129 an implicit binding. Fortunately resolving as shift gives it the only
130 sensible meaning, namely the lhs of an implicit binding.
132 1 for ambiguity in '{-# RULES "name" [ ... #-} [State 382]
133 we don't know whether the '[' starts the activation or not: it
134 might be the start of the declaration with the activation being
135 empty. --SDM 1/4/2002
137 1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 474]
138 since 'forall' is a valid variable name, we don't know whether
139 to treat a forall on the input as the beginning of a quantifier
140 or the beginning of the rule itself. Resolving to shift means
141 it's always treated as a quantifier, hence the above is disallowed.
142 This saves explicitly defining a grammar for the rule lhs that
143 doesn't include 'forall'.
145 1 for ambiguity when the source file starts with "-- | doc". We need another
146 token of lookahead to determine if a top declaration or the 'module' keyword
147 follows. Shift parses as if the 'module' keyword follows.
149 -- ---------------------------------------------------------------------------
150 -- Adding location info
152 This is done in a stylised way using the three macros below, L0, L1
153 and LL. Each of these macros can be thought of as having type
155 L0, L1, LL :: a -> Located a
157 They each add a SrcSpan to their argument.
159 L0 adds 'noSrcSpan', used for empty productions
160 -- This doesn't seem to work anymore -=chak
162 L1 for a production with a single token on the lhs. Grabs the SrcSpan
165 LL for a production with >1 token on the lhs. Makes up a SrcSpan from
166 the first and last tokens.
168 These suffice for the majority of cases. However, we must be
169 especially careful with empty productions: LL won't work if the first
170 or last token on the lhs can represent an empty span. In these cases,
171 we have to calculate the span using more of the tokens from the lhs, eg.
173 | 'newtype' tycl_hdr '=' newconstr deriving
175 (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
177 We provide comb3 and comb4 functions which are useful in such cases.
179 Be careful: there's no checking that you actually got this right, the
180 only symptom will be that the SrcSpans of your syntax will be
184 * We must expand these macros *before* running Happy, which is why this file is
185 * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
187 #define L0 L noSrcSpan
188 #define L1 sL (getLoc $1)
189 #define LL sL (comb2 $1 $>)
191 -- -----------------------------------------------------------------------------
196 '_' { L _ ITunderscore } -- Haskell keywords
198 'case' { L _ ITcase }
199 'class' { L _ ITclass }
200 'data' { L _ ITdata }
201 'default' { L _ ITdefault }
202 'deriving' { L _ ITderiving }
203 'derive' { L _ ITderive }
205 'else' { L _ ITelse }
206 'hiding' { L _ IThiding }
208 'import' { L _ ITimport }
210 'infix' { L _ ITinfix }
211 'infixl' { L _ ITinfixl }
212 'infixr' { L _ ITinfixr }
213 'instance' { L _ ITinstance }
215 'module' { L _ ITmodule }
216 'newtype' { L _ ITnewtype }
218 'qualified' { L _ ITqualified }
219 'then' { L _ ITthen }
220 'type' { L _ ITtype }
221 'where' { L _ ITwhere }
222 '_scc_' { L _ ITscc } -- ToDo: remove
224 'forall' { L _ ITforall } -- GHC extension keywords
225 'foreign' { L _ ITforeign }
226 'export' { L _ ITexport }
227 'label' { L _ ITlabel }
228 'dynamic' { L _ ITdynamic }
229 'safe' { L _ ITsafe }
230 'threadsafe' { L _ ITthreadsafe }
231 'unsafe' { L _ ITunsafe }
233 'family' { L _ ITfamily }
234 'stdcall' { L _ ITstdcallconv }
235 'ccall' { L _ ITccallconv }
236 'dotnet' { L _ ITdotnet }
237 'proc' { L _ ITproc } -- for arrow notation extension
238 'rec' { L _ ITrec } -- for arrow notation extension
240 '{-# INLINE' { L _ (ITinline_prag _) }
241 '{-# SPECIALISE' { L _ ITspec_prag }
242 '{-# SPECIALISE_INLINE' { L _ (ITspec_inline_prag _) }
243 '{-# SOURCE' { L _ ITsource_prag }
244 '{-# RULES' { L _ ITrules_prag }
245 '{-# CORE' { L _ ITcore_prag } -- hdaume: annotated core
246 '{-# SCC' { L _ ITscc_prag }
247 '{-# GENERATED' { L _ ITgenerated_prag }
248 '{-# DEPRECATED' { L _ ITdeprecated_prag }
249 '{-# UNPACK' { L _ ITunpack_prag }
250 '#-}' { L _ ITclose_prag }
252 '..' { L _ ITdotdot } -- reserved symbols
254 '::' { L _ ITdcolon }
258 '<-' { L _ ITlarrow }
259 '->' { L _ ITrarrow }
262 '=>' { L _ ITdarrow }
266 '-<' { L _ ITlarrowtail } -- for arrow notation
267 '>-' { L _ ITrarrowtail } -- for arrow notation
268 '-<<' { L _ ITLarrowtail } -- for arrow notation
269 '>>-' { L _ ITRarrowtail } -- for arrow notation
272 '{' { L _ ITocurly } -- special symbols
274 '{|' { L _ ITocurlybar }
275 '|}' { L _ ITccurlybar }
276 vocurly { L _ ITvocurly } -- virtual open curly (from layout)
277 vccurly { L _ ITvccurly } -- virtual close curly (from layout)
280 '[:' { L _ ITopabrack }
281 ':]' { L _ ITcpabrack }
284 '(#' { L _ IToubxparen }
285 '#)' { L _ ITcubxparen }
286 '(|' { L _ IToparenbar }
287 '|)' { L _ ITcparenbar }
290 '`' { L _ ITbackquote }
292 VARID { L _ (ITvarid _) } -- identifiers
293 CONID { L _ (ITconid _) }
294 VARSYM { L _ (ITvarsym _) }
295 CONSYM { L _ (ITconsym _) }
296 QVARID { L _ (ITqvarid _) }
297 QCONID { L _ (ITqconid _) }
298 QVARSYM { L _ (ITqvarsym _) }
299 QCONSYM { L _ (ITqconsym _) }
301 IPDUPVARID { L _ (ITdupipvarid _) } -- GHC extension
303 CHAR { L _ (ITchar _) }
304 STRING { L _ (ITstring _) }
305 INTEGER { L _ (ITinteger _) }
306 RATIONAL { L _ (ITrational _) }
308 PRIMCHAR { L _ (ITprimchar _) }
309 PRIMSTRING { L _ (ITprimstring _) }
310 PRIMINTEGER { L _ (ITprimint _) }
311 PRIMFLOAT { L _ (ITprimfloat _) }
312 PRIMDOUBLE { L _ (ITprimdouble _) }
314 DOCNEXT { L _ (ITdocCommentNext _) }
315 DOCPREV { L _ (ITdocCommentPrev _) }
316 DOCNAMED { L _ (ITdocCommentNamed _) }
317 DOCSECTION { L _ (ITdocSection _ _) }
318 DOCOPTIONS { L _ (ITdocOptions _) }
321 '[|' { L _ ITopenExpQuote }
322 '[p|' { L _ ITopenPatQuote }
323 '[t|' { L _ ITopenTypQuote }
324 '[d|' { L _ ITopenDecQuote }
325 '|]' { L _ ITcloseQuote }
326 TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
327 '$(' { L _ ITparenEscape } -- $( exp )
328 TH_VAR_QUOTE { L _ ITvarQuote } -- 'x
329 TH_TY_QUOTE { L _ ITtyQuote } -- ''T
331 %monad { P } { >>= } { return }
332 %lexer { lexer } { L _ ITeof }
333 %name parseModule module
334 %name parseStmt maybe_stmt
335 %name parseIdentifier identifier
336 %name parseType ctype
337 %partial parseHeader header
338 %tokentype { (Located Token) }
341 -----------------------------------------------------------------------------
342 -- Identifiers; one of the entry points
343 identifier :: { Located RdrName }
349 -----------------------------------------------------------------------------
352 -- The place for module deprecation is really too restrictive, but if it
353 -- was allowed at its natural place just before 'module', we get an ugly
354 -- s/r conflict with the second alternative. Another solution would be the
355 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
356 -- either, and DEPRECATED is only expected to be used by people who really
357 -- know what they are doing. :-)
359 module :: { Located (HsModule RdrName) }
360 : optdoc 'module' modid maybemoddeprec maybeexports 'where' body
361 {% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) ->
362 return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
364 | missing_module_keyword top close
365 {% fileSrcSpan >>= \ loc ->
366 return (L loc (HsModule Nothing Nothing
367 (fst $2) (snd $2) Nothing Nothing emptyHaddockModInfo
370 optdoc :: { (Maybe String, HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
371 : moduleheader { (Nothing, fst $1, snd $1) }
372 | docoptions { (Just $1, emptyHaddockModInfo, Nothing)}
373 | docoptions moduleheader { (Just $1, fst $2, snd $2) }
374 | moduleheader docoptions { (Just $2, fst $1, snd $1) }
375 | {- empty -} { (Nothing, emptyHaddockModInfo, Nothing) }
377 missing_module_keyword :: { () }
378 : {- empty -} {% pushCurrentContext }
380 maybemoddeprec :: { Maybe DeprecTxt }
381 : '{-# DEPRECATED' STRING '#-}' { Just (getSTRING $2) }
382 | {- empty -} { Nothing }
384 body :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
386 | vocurly top close { $2 }
388 top :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
389 : importdecls { (reverse $1,[]) }
390 | importdecls ';' cvtopdecls { (reverse $1,$3) }
391 | cvtopdecls { ([],$1) }
393 cvtopdecls :: { [LHsDecl RdrName] }
394 : topdecls { cvTopDecls $1 }
396 -----------------------------------------------------------------------------
397 -- Module declaration & imports only
399 header :: { Located (HsModule RdrName) }
400 : optdoc 'module' modid maybemoddeprec maybeexports 'where' header_body
401 {% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) ->
402 return (L loc (HsModule (Just $3) $5 $7 [] $4
404 | missing_module_keyword importdecls
405 {% fileSrcSpan >>= \ loc ->
406 return (L loc (HsModule Nothing Nothing $2 [] Nothing
407 Nothing emptyHaddockModInfo Nothing)) }
409 header_body :: { [LImportDecl RdrName] }
410 : '{' importdecls { $2 }
411 | vocurly importdecls { $2 }
413 -----------------------------------------------------------------------------
416 maybeexports :: { Maybe [LIE RdrName] }
417 : '(' exportlist ')' { Just $2 }
418 | {- empty -} { Nothing }
420 exportlist :: { [LIE RdrName] }
421 : expdoclist ',' expdoclist { $1 ++ $3 }
424 exportlist1 :: { [LIE RdrName] }
425 : expdoclist export expdoclist ',' exportlist { $1 ++ ($2 : $3) ++ $5 }
426 | expdoclist export expdoclist { $1 ++ ($2 : $3) }
429 expdoclist :: { [LIE RdrName] }
430 : exp_doc expdoclist { $1 : $2 }
433 exp_doc :: { LIE RdrName }
434 : docsection { L1 (case (unLoc $1) of (n, doc) -> IEGroup n doc) }
435 | docnamed { L1 (IEDocNamed ((fst . unLoc) $1)) }
436 | docnext { L1 (IEDoc (unLoc $1)) }
438 -- No longer allow things like [] and (,,,) to be exported
439 -- They are built in syntax, always available
440 export :: { LIE RdrName }
441 : qvar { L1 (IEVar (unLoc $1)) }
442 | oqtycon { L1 (IEThingAbs (unLoc $1)) }
443 | oqtycon '(' '..' ')' { LL (IEThingAll (unLoc $1)) }
444 | oqtycon '(' ')' { LL (IEThingWith (unLoc $1) []) }
445 | oqtycon '(' qcnames ')' { LL (IEThingWith (unLoc $1) (reverse $3)) }
446 | 'module' modid { LL (IEModuleContents (unLoc $2)) }
448 qcnames :: { [RdrName] }
449 : qcnames ',' qcname_ext { unLoc $3 : $1 }
450 | qcname_ext { [unLoc $1] }
452 qcname_ext :: { Located RdrName } -- Variable or data constructor
453 -- or tagged type constructor
455 | 'type' qcon { sL (comb2 $1 $2)
456 (setRdrNameSpace (unLoc $2)
459 -- Cannot pull into qcname_ext, as qcname is also used in expression.
460 qcname :: { Located RdrName } -- Variable or data constructor
464 -----------------------------------------------------------------------------
465 -- Import Declarations
467 -- import decls can be *empty*, or even just a string of semicolons
468 -- whereas topdecls must contain at least one topdecl.
470 importdecls :: { [LImportDecl RdrName] }
471 : importdecls ';' importdecl { $3 : $1 }
472 | importdecls ';' { $1 }
473 | importdecl { [ $1 ] }
476 importdecl :: { LImportDecl RdrName }
477 : 'import' maybe_src optqualified modid maybeas maybeimpspec
478 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
480 maybe_src :: { IsBootInterface }
481 : '{-# SOURCE' '#-}' { True }
482 | {- empty -} { False }
484 optqualified :: { Bool }
485 : 'qualified' { True }
486 | {- empty -} { False }
488 maybeas :: { Located (Maybe ModuleName) }
489 : 'as' modid { LL (Just (unLoc $2)) }
490 | {- empty -} { noLoc Nothing }
492 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
493 : impspec { L1 (Just (unLoc $1)) }
494 | {- empty -} { noLoc Nothing }
496 impspec :: { Located (Bool, [LIE RdrName]) }
497 : '(' exportlist ')' { LL (False, $2) }
498 | 'hiding' '(' exportlist ')' { LL (True, $3) }
500 -----------------------------------------------------------------------------
501 -- Fixity Declarations
505 | INTEGER {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
507 infix :: { Located FixityDirection }
508 : 'infix' { L1 InfixN }
509 | 'infixl' { L1 InfixL }
510 | 'infixr' { L1 InfixR }
512 ops :: { Located [Located RdrName] }
513 : ops ',' op { LL ($3 : unLoc $1) }
516 -----------------------------------------------------------------------------
517 -- Top-Level Declarations
519 topdecls :: { OrdList (LHsDecl RdrName) }
520 : topdecls ';' topdecl { $1 `appOL` $3 }
521 | topdecls ';' { $1 }
524 topdecl :: { OrdList (LHsDecl RdrName) }
525 : cl_decl { unitOL (L1 (TyClD (unLoc $1))) }
526 | ty_decl { unitOL (L1 (TyClD (unLoc $1))) }
527 | 'instance' inst_type where_inst
528 { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
530 unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs ats)))}
531 | stand_alone_deriving { unitOL (LL (DerivD (unLoc $1))) }
532 | 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
533 | 'foreign' fdecl { unitOL (LL (unLoc $2)) }
534 | '{-# DEPRECATED' deprecations '#-}' { $2 }
535 | '{-# RULES' rules '#-}' { $2 }
538 -- Template Haskell Extension
539 | '$(' exp ')' { unitOL (LL $ SpliceD (SpliceDecl $2)) }
540 | TH_ID_SPLICE { unitOL (LL $ SpliceD (SpliceDecl $
541 L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
546 cl_decl :: { LTyClDecl RdrName }
547 : 'class' tycl_hdr fds where_cls
548 {% do { let { (binds, sigs, ats, docs) =
549 cvBindsAndSigs (unLoc $4)
550 ; (ctxt, tc, tvs, tparms) = unLoc $2}
551 ; checkTyVars tparms -- only type vars allowed
553 ; return $ L (comb4 $1 $2 $3 $4)
554 (mkClassDecl (ctxt, tc, tvs)
555 (unLoc $3) sigs binds ats docs) } }
557 -- Type declarations (toplevel)
559 ty_decl :: { LTyClDecl RdrName }
560 -- ordinary type synonyms
561 : 'type' type '=' ctype
562 -- Note ctype, not sigtype, on the right of '='
563 -- We allow an explicit for-all but we don't insert one
564 -- in type Foo a = (b,b)
565 -- Instead we just say b is out of scope
567 -- Note the use of type for the head; this allows
568 -- infix type constructors to be declared
569 {% do { (tc, tvs, _) <- checkSynHdr $2 False
570 ; return (L (comb2 $1 $4)
571 (TySynonym tc tvs Nothing $4))
574 -- type family declarations
575 | 'type' 'family' type opt_kind_sig
576 -- Note the use of type for the head; this allows
577 -- infix type constructors to be declared
579 {% do { (tc, tvs, _) <- checkSynHdr $3 False
580 ; return (L (comb3 $1 $3 $4)
581 (TyFamily TypeFamily tc tvs (unLoc $4)))
584 -- type instance declarations
585 | 'type' 'instance' type '=' ctype
586 -- Note the use of type for the head; this allows
587 -- infix type constructors and type patterns
589 {% do { (tc, tvs, typats) <- checkSynHdr $3 True
590 ; return (L (comb2 $1 $5)
591 (TySynonym tc tvs (Just typats) $5))
594 -- ordinary data type or newtype declaration
595 | data_or_newtype tycl_hdr constrs deriving
596 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
597 ; checkTyVars tparms -- no type pattern
599 L (comb4 $1 $2 $3 $4)
600 -- We need the location on tycl_hdr in case
601 -- constrs and deriving are both empty
602 (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
603 Nothing (reverse (unLoc $3)) (unLoc $4)) } }
605 -- ordinary GADT declaration
606 | data_or_newtype tycl_hdr opt_kind_sig
607 'where' gadt_constrlist
609 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
610 ; checkTyVars tparms -- can have type pats
612 L (comb4 $1 $2 $4 $5)
613 (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
614 (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
616 -- data/newtype family
617 | data_or_newtype 'family' tycl_hdr opt_kind_sig
618 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
619 ; checkTyVars tparms -- no type pattern
620 ; unless (null (unLoc ctxt)) $ -- and no context
621 parseError (getLoc ctxt)
622 "A family declaration cannot have a context"
625 (TyFamily (DataFamily (unLoc $1)) tc tvs
628 -- data/newtype instance declaration
629 | data_or_newtype 'instance' tycl_hdr constrs deriving
630 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
631 -- can have type pats
633 L (comb4 $1 $3 $4 $5)
634 -- We need the location on tycl_hdr in case
635 -- constrs and deriving are both empty
636 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
637 Nothing (reverse (unLoc $4)) (unLoc $5)) } }
639 -- GADT instance declaration
640 | data_or_newtype 'instance' tycl_hdr opt_kind_sig
641 'where' gadt_constrlist
643 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
644 -- can have type pats
646 L (comb4 $1 $3 $6 $7)
647 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
648 (unLoc $4) (reverse (unLoc $6)) (unLoc $7)) } }
650 -- Associate type family declarations
652 -- * They have a different syntax than on the toplevel (no family special
655 -- * They also need to be separate from instances; otherwise, data family
656 -- declarations without a kind signature cause parsing conflicts with empty
657 -- data declarations.
659 at_decl_cls :: { LTyClDecl RdrName }
660 -- type family declarations
661 : 'type' type opt_kind_sig
662 -- Note the use of type for the head; this allows
663 -- infix type constructors to be declared
665 {% do { (tc, tvs, _) <- checkSynHdr $2 False
666 ; return (L (comb3 $1 $2 $3)
667 (TyFamily TypeFamily tc tvs (unLoc $3)))
670 -- default type instance
671 | 'type' type '=' ctype
672 -- Note the use of type for the head; this allows
673 -- infix type constructors and type patterns
675 {% do { (tc, tvs, typats) <- checkSynHdr $2 True
676 ; return (L (comb2 $1 $4)
677 (TySynonym tc tvs (Just typats) $4))
680 -- data/newtype family declaration
681 | data_or_newtype tycl_hdr opt_kind_sig
682 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
683 ; checkTyVars tparms -- no type pattern
684 ; unless (null (unLoc ctxt)) $ -- and no context
685 parseError (getLoc ctxt)
686 "A family declaration cannot have a context"
689 (TyFamily (DataFamily (unLoc $1)) tc tvs
693 -- Associate type instances
695 at_decl_inst :: { LTyClDecl RdrName }
696 -- type instance declarations
697 : 'type' type '=' ctype
698 -- Note the use of type for the head; this allows
699 -- infix type constructors and type patterns
701 {% do { (tc, tvs, typats) <- checkSynHdr $2 True
702 ; return (L (comb2 $1 $4)
703 (TySynonym tc tvs (Just typats) $4))
706 -- data/newtype instance declaration
707 | data_or_newtype tycl_hdr constrs deriving
708 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
709 -- can have type pats
711 L (comb4 $1 $2 $3 $4)
712 -- We need the location on tycl_hdr in case
713 -- constrs and deriving are both empty
714 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
715 Nothing (reverse (unLoc $3)) (unLoc $4)) } }
717 -- GADT instance declaration
718 | data_or_newtype tycl_hdr opt_kind_sig
719 'where' gadt_constrlist
721 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
722 -- can have type pats
724 L (comb4 $1 $2 $5 $6)
725 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
726 (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
728 data_or_newtype :: { Located NewOrData }
729 : 'data' { L1 DataType }
730 | 'newtype' { L1 NewType }
732 opt_kind_sig :: { Located (Maybe Kind) }
734 | '::' kind { LL (Just (unLoc $2)) }
736 -- tycl_hdr parses the header of a class or data type decl,
737 -- which takes the form
740 -- (Eq a, Ord b) => T a b
741 -- T Int [a] -- for associated types
742 -- Rather a lot of inlining here, else we get reduce/reduce errors
743 tycl_hdr :: { Located (LHsContext RdrName,
745 [LHsTyVarBndr RdrName],
747 : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
748 | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
750 -----------------------------------------------------------------------------
751 -- Stand-alone deriving
753 -- Glasgow extension: stand-alone deriving declarations
754 stand_alone_deriving :: { LDerivDecl RdrName }
755 : 'derive' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
757 -----------------------------------------------------------------------------
758 -- Nested declarations
760 -- Declaration in class bodies
762 decl_cls :: { Located (OrdList (LHsDecl RdrName)) }
763 decl_cls : at_decl_cls { LL (unitOL (L1 (TyClD (unLoc $1)))) }
766 decls_cls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
767 : decls_cls ';' decl_cls { LL (unLoc $1 `appOL` unLoc $3) }
768 | decls_cls ';' { LL (unLoc $1) }
770 | {- empty -} { noLoc nilOL }
774 :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
775 : '{' decls_cls '}' { LL (unLoc $2) }
776 | vocurly decls_cls close { $2 }
780 where_cls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
781 -- No implicit parameters
782 -- May have type declarations
783 : 'where' decllist_cls { LL (unLoc $2) }
784 | {- empty -} { noLoc nilOL }
786 -- Declarations in instance bodies
788 decl_inst :: { Located (OrdList (LHsDecl RdrName)) }
789 decl_inst : at_decl_inst { LL (unitOL (L1 (TyClD (unLoc $1)))) }
792 decls_inst :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
793 : decls_inst ';' decl_inst { LL (unLoc $1 `appOL` unLoc $3) }
794 | decls_inst ';' { LL (unLoc $1) }
796 | {- empty -} { noLoc nilOL }
799 :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
800 : '{' decls_inst '}' { LL (unLoc $2) }
801 | vocurly decls_inst close { $2 }
805 where_inst :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
806 -- No implicit parameters
807 -- May have type declarations
808 : 'where' decllist_inst { LL (unLoc $2) }
809 | {- empty -} { noLoc nilOL }
811 -- Declarations in binding groups other than classes and instances
813 decls :: { Located (OrdList (LHsDecl RdrName)) }
814 : decls ';' decl { LL (unLoc $1 `appOL` unLoc $3) }
815 | decls ';' { LL (unLoc $1) }
817 | {- empty -} { noLoc nilOL }
819 decllist :: { Located (OrdList (LHsDecl RdrName)) }
820 : '{' decls '}' { LL (unLoc $2) }
821 | vocurly decls close { $2 }
823 -- Binding groups other than those of class and instance declarations
825 binds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
826 -- No type declarations
827 : decllist { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
828 | '{' dbinds '}' { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
829 | vocurly dbinds close { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
831 wherebinds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
832 -- No type declarations
833 : 'where' binds { LL (unLoc $2) }
834 | {- empty -} { noLoc emptyLocalBinds }
837 -----------------------------------------------------------------------------
838 -- Transformation Rules
840 rules :: { OrdList (LHsDecl RdrName) }
841 : rules ';' rule { $1 `snocOL` $3 }
844 | {- empty -} { nilOL }
846 rule :: { LHsDecl RdrName }
847 : STRING activation rule_forall infixexp '=' exp
848 { LL $ RuleD (HsRule (getSTRING $1)
849 ($2 `orElse` AlwaysActive)
850 $3 $4 placeHolderNames $6 placeHolderNames) }
852 activation :: { Maybe Activation }
853 : {- empty -} { Nothing }
854 | explicit_activation { Just $1 }
856 explicit_activation :: { Activation } -- In brackets
857 : '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
858 | '[' '~' INTEGER ']' { ActiveBefore (fromInteger (getINTEGER $3)) }
860 rule_forall :: { [RuleBndr RdrName] }
861 : 'forall' rule_var_list '.' { $2 }
864 rule_var_list :: { [RuleBndr RdrName] }
866 | rule_var rule_var_list { $1 : $2 }
868 rule_var :: { RuleBndr RdrName }
869 : varid { RuleBndr $1 }
870 | '(' varid '::' ctype ')' { RuleBndrSig $2 $4 }
872 -----------------------------------------------------------------------------
873 -- Deprecations (c.f. rules)
875 deprecations :: { OrdList (LHsDecl RdrName) }
876 : deprecations ';' deprecation { $1 `appOL` $3 }
877 | deprecations ';' { $1 }
879 | {- empty -} { nilOL }
881 -- SUP: TEMPORARY HACK, not checking for `module Foo'
882 deprecation :: { OrdList (LHsDecl RdrName) }
884 { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
888 -----------------------------------------------------------------------------
889 -- Foreign import and export declarations
891 fdecl :: { LHsDecl RdrName }
892 fdecl : 'import' callconv safety fspec
893 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
894 | 'import' callconv fspec
895 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
897 | 'export' callconv fspec
898 {% mkExport $2 (unLoc $3) >>= return.LL }
900 callconv :: { CallConv }
901 : 'stdcall' { CCall StdCallConv }
902 | 'ccall' { CCall CCallConv }
903 | 'dotnet' { DNCall }
906 : 'unsafe' { PlayRisky }
907 | 'safe' { PlaySafe False }
908 | 'threadsafe' { PlaySafe True }
910 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
911 : STRING var '::' sigtypedoc { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
912 | var '::' sigtypedoc { LL (noLoc nilFS, $1, $3) }
913 -- if the entity string is missing, it defaults to the empty string;
914 -- the meaning of an empty entity string depends on the calling
917 -----------------------------------------------------------------------------
920 opt_sig :: { Maybe (LHsType RdrName) }
921 : {- empty -} { Nothing }
922 | '::' sigtype { Just $2 }
924 opt_asig :: { Maybe (LHsType RdrName) }
925 : {- empty -} { Nothing }
926 | '::' atype { Just $2 }
928 sigtypes1 :: { [LHsType RdrName] }
930 | sigtype ',' sigtypes1 { $1 : $3 }
932 sigtype :: { LHsType RdrName }
933 : ctype { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
934 -- Wrap an Implicit forall if there isn't one there already
936 sigtypedoc :: { LHsType RdrName }
937 : ctypedoc { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
938 -- Wrap an Implicit forall if there isn't one there already
940 sig_vars :: { Located [Located RdrName] }
941 : sig_vars ',' var { LL ($3 : unLoc $1) }
944 -----------------------------------------------------------------------------
947 infixtype :: { LHsType RdrName }
948 : btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
949 | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
951 infixtypedoc :: { LHsType RdrName }
953 | infixtype docprev { LL $ HsDocTy $1 $2 }
955 gentypedoc :: { LHsType RdrName }
958 | infixtypedoc { $1 }
959 | btype '->' ctypedoc { LL $ HsFunTy $1 $3 }
960 | btypedoc '->' ctypedoc { LL $ HsFunTy $1 $3 }
962 ctypedoc :: { LHsType RdrName }
963 : 'forall' tv_bndrs '.' ctypedoc { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
964 | context '=>' gentypedoc { LL $ mkImplicitHsForAllTy $1 $3 }
965 -- A type of form (context => type) is an *implicit* HsForAllTy
968 strict_mark :: { Located HsBang }
969 : '!' { L1 HsStrict }
970 | '{-# UNPACK' '#-}' '!' { LL HsUnbox }
972 -- A ctype is a for-all type
973 ctype :: { LHsType RdrName }
974 : 'forall' tv_bndrs '.' ctype { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
975 | context '=>' type { LL $ mkImplicitHsForAllTy $1 $3 }
976 -- A type of form (context => type) is an *implicit* HsForAllTy
979 -- We parse a context as a btype so that we don't get reduce/reduce
980 -- errors in ctype. The basic problem is that
982 -- looks so much like a tuple type. We can't tell until we find the =>
984 -- We have the t1 ~ t2 form here and in gentype, to permit an individual
985 -- equational constraint without parenthesis.
986 context :: { LHsContext RdrName }
987 : btype '~' btype {% checkContext
988 (LL $ HsPredTy (HsEqualP $1 $3)) }
989 | btype {% checkContext $1 }
991 type :: { LHsType RdrName }
992 : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
995 gentype :: { LHsType RdrName }
997 | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
998 | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
999 | btype '->' ctype { LL $ HsFunTy $1 $3 }
1000 | btype '~' btype { LL $ HsPredTy (HsEqualP $1 $3) }
1002 btype :: { LHsType RdrName }
1003 : btype atype { LL $ HsAppTy $1 $2 }
1006 btypedoc :: { LHsType RdrName }
1007 : btype atype docprev { LL $ HsDocTy (L (comb2 $1 $2) (HsAppTy $1 $2)) $3 }
1008 | atype docprev { LL $ HsDocTy $1 $2 }
1010 atype :: { LHsType RdrName }
1011 : gtycon { L1 (HsTyVar (unLoc $1)) }
1012 | tyvar { L1 (HsTyVar (unLoc $1)) }
1013 | strict_mark atype { LL (HsBangTy (unLoc $1) $2) }
1014 | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) }
1015 | '(#' comma_types1 '#)' { LL $ HsTupleTy Unboxed $2 }
1016 | '[' ctype ']' { LL $ HsListTy $2 }
1017 | '[:' ctype ':]' { LL $ HsPArrTy $2 }
1018 | '(' ctype ')' { LL $ HsParTy $2 }
1019 | '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) }
1021 | INTEGER { L1 (HsNumTy (getINTEGER $1)) }
1023 -- An inst_type is what occurs in the head of an instance decl
1024 -- e.g. (Foo a, Gaz b) => Wibble a b
1025 -- It's kept as a single type, with a MonoDictTy at the right
1026 -- hand corner, for convenience.
1027 inst_type :: { LHsType RdrName }
1028 : sigtype {% checkInstType $1 }
1030 inst_types1 :: { [LHsType RdrName] }
1031 : inst_type { [$1] }
1032 | inst_type ',' inst_types1 { $1 : $3 }
1034 comma_types0 :: { [LHsType RdrName] }
1035 : comma_types1 { $1 }
1036 | {- empty -} { [] }
1038 comma_types1 :: { [LHsType RdrName] }
1040 | ctype ',' comma_types1 { $1 : $3 }
1042 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1043 : tv_bndr tv_bndrs { $1 : $2 }
1044 | {- empty -} { [] }
1046 tv_bndr :: { LHsTyVarBndr RdrName }
1047 : tyvar { L1 (UserTyVar (unLoc $1)) }
1048 | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2)
1051 fds :: { Located [Located ([RdrName], [RdrName])] }
1052 : {- empty -} { noLoc [] }
1053 | '|' fds1 { LL (reverse (unLoc $2)) }
1055 fds1 :: { Located [Located ([RdrName], [RdrName])] }
1056 : fds1 ',' fd { LL ($3 : unLoc $1) }
1059 fd :: { Located ([RdrName], [RdrName]) }
1060 : varids0 '->' varids0 { L (comb3 $1 $2 $3)
1061 (reverse (unLoc $1), reverse (unLoc $3)) }
1063 varids0 :: { Located [RdrName] }
1064 : {- empty -} { noLoc [] }
1065 | varids0 tyvar { LL (unLoc $2 : unLoc $1) }
1067 -----------------------------------------------------------------------------
1070 kind :: { Located Kind }
1072 | akind '->' kind { LL (mkArrowKind (unLoc $1) (unLoc $3)) }
1074 akind :: { Located Kind }
1075 : '*' { L1 liftedTypeKind }
1076 | '!' { L1 unliftedTypeKind }
1077 | '(' kind ')' { LL (unLoc $2) }
1080 -----------------------------------------------------------------------------
1081 -- Datatype declarations
1083 gadt_constrlist :: { Located [LConDecl RdrName] }
1084 : '{' gadt_constrs '}' { LL (unLoc $2) }
1085 | vocurly gadt_constrs close { $2 }
1087 gadt_constrs :: { Located [LConDecl RdrName] }
1088 : gadt_constrs ';' gadt_constr { LL ($3 : unLoc $1) }
1089 | gadt_constrs ';' { $1 }
1090 | gadt_constr { L1 [$1] }
1092 -- We allow the following forms:
1093 -- C :: Eq a => a -> T a
1094 -- C :: forall a. Eq a => !a -> T a
1095 -- D { x,y :: a } :: T a
1096 -- forall a. Eq a => D { x,y :: a } :: T a
1098 gadt_constr :: { LConDecl RdrName }
1100 { LL (mkGadtDecl $1 $3) }
1101 -- Syntax: Maybe merge the record stuff with the single-case above?
1102 -- (to kill the mostly harmless reduce/reduce error)
1103 -- XXX revisit audreyt
1104 | constr_stuff_record '::' sigtype
1105 { let (con,details) = unLoc $1 in
1106 LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing) }
1108 | forall context '=>' constr_stuff_record '::' sigtype
1109 { let (con,details) = unLoc $4 in
1110 LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6) Nothing ) }
1111 | forall constr_stuff_record '::' sigtype
1112 { let (con,details) = unLoc $2 in
1113 LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4) Nothing) }
1117 constrs :: { Located [LConDecl RdrName] }
1118 : {- empty; a GHC extension -} { noLoc [] }
1119 | maybe_docnext '=' constrs1 { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
1121 constrs1 :: { Located [LConDecl RdrName] }
1122 : constrs1 maybe_docnext '|' maybe_docprev constr { LL (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4) }
1123 | constr { L1 [$1] }
1125 constr :: { LConDecl RdrName }
1126 : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1127 { let (con,details) = unLoc $5 in
1128 L (comb4 $2 $3 $4 $5) (ConDecl con Explicit (unLoc $2) $3 details ResTyH98 ($1 `mplus` $6)) }
1129 | maybe_docnext forall constr_stuff maybe_docprev
1130 { let (con,details) = unLoc $3 in
1131 L (comb2 $2 $3) (ConDecl con Explicit (unLoc $2) (noLoc []) details ResTyH98 ($1 `mplus` $4)) }
1133 forall :: { Located [LHsTyVarBndr RdrName] }
1134 : 'forall' tv_bndrs '.' { LL $2 }
1135 | {- empty -} { noLoc [] }
1137 constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
1138 -- We parse the constructor declaration
1140 -- as a btype (treating C as a type constructor) and then convert C to be
1141 -- a data constructor. Reason: it might continue like this:
1143 -- in which case C really would be a type constructor. We can't resolve this
1144 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
1145 : btype {% mkPrefixCon $1 [] >>= return.LL }
1146 | oqtycon '{' '}' {% mkRecCon $1 [] >>= return.LL }
1147 | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL }
1148 | btype conop btype { LL ($2, InfixCon $1 $3) }
1150 constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
1151 : oqtycon '{' '}' {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
1152 | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
1154 fielddecls :: { [([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName))] }
1155 : fielddecl maybe_docnext ',' maybe_docprev fielddecls { addFieldDoc (unLoc $1) $4 : addFieldDocs $5 $2 }
1156 | fielddecl { [unLoc $1] }
1158 fielddecl :: { Located ([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName)) }
1159 : maybe_docnext sig_vars '::' ctype maybe_docprev { L (comb3 $2 $3 $4) (reverse (unLoc $2), $4, $1 `mplus` $5) }
1161 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1162 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1163 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1164 -- We don't allow a context, but that's sorted out by the type checker.
1165 deriving :: { Located (Maybe [LHsType RdrName]) }
1166 : {- empty -} { noLoc Nothing }
1167 | 'deriving' qtycon {% do { let { L loc tv = $2 }
1168 ; p <- checkInstType (L loc (HsTyVar tv))
1169 ; return (LL (Just [p])) } }
1170 | 'deriving' '(' ')' { LL (Just []) }
1171 | 'deriving' '(' inst_types1 ')' { LL (Just $3) }
1172 -- Glasgow extension: allow partial
1173 -- applications in derivings
1175 -----------------------------------------------------------------------------
1176 -- Value definitions
1178 {- There's an awkward overlap with a type signature. Consider
1179 f :: Int -> Int = ...rhs...
1180 Then we can't tell whether it's a type signature or a value
1181 definition with a result signature until we see the '='.
1182 So we have to inline enough to postpone reductions until we know.
1186 ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1187 instead of qvar, we get another shift/reduce-conflict. Consider the
1190 { (^^) :: Int->Int ; } Type signature; only var allowed
1192 { (^^) :: Int->Int = ... ; } Value defn with result signature;
1193 qvar allowed (because of instance decls)
1195 We can't tell whether to reduce var to qvar until after we've read the signatures.
1198 docdecl :: { LHsDecl RdrName }
1199 : docdecld { L1 (DocD (unLoc $1)) }
1201 docdecld :: { LDocDecl RdrName }
1202 : docnext { L1 (DocCommentNext (unLoc $1)) }
1203 | docprev { L1 (DocCommentPrev (unLoc $1)) }
1204 | docnamed { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
1205 | docsection { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
1207 decl :: { Located (OrdList (LHsDecl RdrName)) }
1209 | '!' aexp rhs {% do { pat <- checkPattern $2;
1210 return (LL $ unitOL $ LL $ ValD (
1211 PatBind (LL $ BangPat pat) (unLoc $3)
1212 placeHolderType placeHolderNames)) } }
1213 | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3;
1214 return (LL $ unitOL (LL $ ValD r)) } }
1215 | docdecl { LL $ unitOL $1 }
1217 rhs :: { Located (GRHSs RdrName) }
1218 : '=' exp wherebinds { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
1219 | gdrhs wherebinds { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) }
1221 gdrhs :: { Located [LGRHS RdrName] }
1222 : gdrhs gdrh { LL ($2 : unLoc $1) }
1225 gdrh :: { LGRHS RdrName }
1226 : '|' quals '=' exp { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
1228 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
1229 : infixexp '::' sigtypedoc
1230 {% do s <- checkValSig $1 $3;
1231 return (LL $ unitOL (LL $ SigD s)) }
1232 -- See the above notes for why we need infixexp here
1233 | var ',' sig_vars '::' sigtypedoc
1234 { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
1235 | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
1237 | '{-# INLINE' activation qvar '#-}'
1238 { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
1239 | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
1240 { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
1242 | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
1243 { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
1245 | '{-# SPECIALISE' 'instance' inst_type '#-}'
1246 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
1248 -----------------------------------------------------------------------------
1251 exp :: { LHsExpr RdrName }
1252 : infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
1253 | infixexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
1254 | infixexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
1255 | infixexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
1256 | infixexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
1259 infixexp :: { LHsExpr RdrName }
1261 | infixexp qop exp10 { LL (OpApp $1 $2 (panic "fixity") $3) }
1263 exp10 :: { LHsExpr RdrName }
1264 : '\\' apat apats opt_asig '->' exp
1265 { LL $ HsLam (mkMatchGroup [LL $ Match ($2:$3) $4
1268 | 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
1269 | 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 }
1270 | 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
1271 | '-' fexp { LL $ mkHsNegApp $2 }
1273 | 'do' stmtlist {% let loc = comb2 $1 $2 in
1274 checkDo loc (unLoc $2) >>= \ (stmts,body) ->
1275 return (L loc (mkHsDo DoExpr stmts body)) }
1276 | 'mdo' stmtlist {% let loc = comb2 $1 $2 in
1277 checkDo loc (unLoc $2) >>= \ (stmts,body) ->
1278 return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
1279 | scc_annot exp { LL $ if opt_SccProfilingOn
1280 then HsSCC (unLoc $1) $2
1282 | hpc_annot exp { LL $ if opt_Hpc
1283 then HsTickPragma (unLoc $1) $2
1286 | 'proc' aexp '->' exp
1287 {% checkPattern $2 >>= \ p ->
1288 return (LL $ HsProc p (LL $ HsCmdTop $4 []
1289 placeHolderType undefined)) }
1290 -- TODO: is LL right here?
1292 | '{-# CORE' STRING '#-}' exp { LL $ HsCoreAnn (getSTRING $2) $4 }
1293 -- hdaume: core annotation
1296 scc_annot :: { Located FastString }
1297 : '_scc_' STRING { LL $ getSTRING $2 }
1298 | '{-# SCC' STRING '#-}' { LL $ getSTRING $2 }
1300 hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
1301 : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
1302 { LL $ (getSTRING $2
1303 ,( fromInteger $ getINTEGER $3
1304 , fromInteger $ getINTEGER $5
1306 ,( fromInteger $ getINTEGER $7
1307 , fromInteger $ getINTEGER $9
1312 fexp :: { LHsExpr RdrName }
1313 : fexp aexp { LL $ HsApp $1 $2 }
1316 aexp :: { LHsExpr RdrName }
1317 : qvar '@' aexp { LL $ EAsPat $1 $3 }
1318 | '~' aexp { LL $ ELazyPat $2 }
1321 aexp1 :: { LHsExpr RdrName }
1322 : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
1327 -- Here was the syntax for type applications that I was planning
1328 -- but there are difficulties (e.g. what order for type args)
1329 -- so it's not enabled yet.
1330 -- But this case *is* used for the left hand side of a generic definition,
1331 -- which is parsed as an expression before being munged into a pattern
1332 | qcname '{|' gentype '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1333 (sL (getLoc $3) (HsType $3)) }
1335 aexp2 :: { LHsExpr RdrName }
1336 : ipvar { L1 (HsIPVar $! unLoc $1) }
1337 | qcname { L1 (HsVar $! unLoc $1) }
1338 | literal { L1 (HsLit $! unLoc $1) }
1339 -- This will enable overloaded strings permanently. Normally the renamer turns HsString
1340 -- into HsOverLit when -foverloaded-strings is on.
1341 -- | STRING { L1 (HsOverLit $! mkHsIsString (getSTRING $1)) }
1342 | INTEGER { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
1343 | RATIONAL { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
1344 | '(' exp ')' { LL (HsPar $2) }
1345 | '(' texp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1346 | '(#' texps '#)' { LL $ ExplicitTuple (reverse $2) Unboxed }
1347 | '[' list ']' { LL (unLoc $2) }
1348 | '[:' parr ':]' { LL (unLoc $2) }
1349 | '(' infixexp qop ')' { LL $ SectionL $2 $3 }
1350 | '(' qopm infixexp ')' { LL $ SectionR $2 $3 }
1351 | '_' { L1 EWildPat }
1353 -- Template Haskell Extension
1354 | TH_ID_SPLICE { L1 $ HsSpliceE (mkHsSplice
1355 (L1 $ HsVar (mkUnqual varName
1356 (getTH_ID_SPLICE $1)))) } -- $x
1357 | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
1359 | TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
1360 | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
1361 | TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
1362 | TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) }
1363 | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
1364 | '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
1365 | '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
1366 return (LL $ HsBracket (PatBr p)) }
1367 | '[d|' cvtopbody '|]' {% checkDecBrGroup $2 >>= \g ->
1368 return (LL $ HsBracket (DecBr g)) }
1370 -- arrow notation extension
1371 | '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
1373 cmdargs :: { [LHsCmdTop RdrName] }
1374 : cmdargs acmd { $2 : $1 }
1375 | {- empty -} { [] }
1377 acmd :: { LHsCmdTop RdrName }
1378 : aexp2 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1380 cvtopbody :: { [LHsDecl RdrName] }
1381 : '{' cvtopdecls0 '}' { $2 }
1382 | vocurly cvtopdecls0 close { $2 }
1384 cvtopdecls0 :: { [LHsDecl RdrName] }
1385 : {- empty -} { [] }
1388 texp :: { LHsExpr RdrName }
1390 | qopm infixexp { LL $ SectionR $1 $2 }
1391 -- The second production is really here only for bang patterns
1394 texps :: { [LHsExpr RdrName] }
1395 : texps ',' texp { $3 : $1 }
1399 -----------------------------------------------------------------------------
1402 -- The rules below are little bit contorted to keep lexps left-recursive while
1403 -- avoiding another shift/reduce-conflict.
1405 list :: { LHsExpr RdrName }
1406 : texp { L1 $ ExplicitList placeHolderType [$1] }
1407 | lexps { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1408 | texp '..' { LL $ ArithSeq noPostTcExpr (From $1) }
1409 | texp ',' exp '..' { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
1410 | texp '..' exp { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
1411 | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1412 | texp pquals { sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
1414 lexps :: { Located [LHsExpr RdrName] }
1415 : lexps ',' texp { LL ($3 : unLoc $1) }
1416 | texp ',' texp { LL [$3,$1] }
1418 -----------------------------------------------------------------------------
1419 -- List Comprehensions
1421 pquals :: { Located [LStmt RdrName] } -- Either a singleton ParStmt,
1422 -- or a reversed list of Stmts
1423 : pquals1 { case unLoc $1 of
1425 qss -> L1 [L1 (ParStmt stmtss)]
1427 stmtss = [ (reverse qs, undefined)
1431 pquals1 :: { Located [[LStmt RdrName]] }
1432 : pquals1 '|' quals { LL (unLoc $3 : unLoc $1) }
1433 | '|' quals { L (getLoc $2) [unLoc $2] }
1435 quals :: { Located [LStmt RdrName] }
1436 : quals ',' qual { LL ($3 : unLoc $1) }
1439 -----------------------------------------------------------------------------
1440 -- Parallel array expressions
1442 -- The rules below are little bit contorted; see the list case for details.
1443 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1444 -- Moreover, we allow explicit arrays with no element (represented by the nil
1445 -- constructor in the list case).
1447 parr :: { LHsExpr RdrName }
1448 : { noLoc (ExplicitPArr placeHolderType []) }
1449 | texp { L1 $ ExplicitPArr placeHolderType [$1] }
1450 | lexps { L1 $ ExplicitPArr placeHolderType
1451 (reverse (unLoc $1)) }
1452 | texp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
1453 | texp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1454 | texp pquals { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
1456 -- We are reusing `lexps' and `pquals' from the list case.
1458 -----------------------------------------------------------------------------
1459 -- Case alternatives
1461 altslist :: { Located [LMatch RdrName] }
1462 : '{' alts '}' { LL (reverse (unLoc $2)) }
1463 | vocurly alts close { L (getLoc $2) (reverse (unLoc $2)) }
1465 alts :: { Located [LMatch RdrName] }
1466 : alts1 { L1 (unLoc $1) }
1467 | ';' alts { LL (unLoc $2) }
1469 alts1 :: { Located [LMatch RdrName] }
1470 : alts1 ';' alt { LL ($3 : unLoc $1) }
1471 | alts1 ';' { LL (unLoc $1) }
1474 alt :: { LMatch RdrName }
1475 : pat opt_sig alt_rhs { LL (Match [$1] $2 (unLoc $3)) }
1477 alt_rhs :: { Located (GRHSs RdrName) }
1478 : ralt wherebinds { LL (GRHSs (unLoc $1) (unLoc $2)) }
1480 ralt :: { Located [LGRHS RdrName] }
1481 : '->' exp { LL (unguardedRHS $2) }
1482 | gdpats { L1 (reverse (unLoc $1)) }
1484 gdpats :: { Located [LGRHS RdrName] }
1485 : gdpats gdpat { LL ($2 : unLoc $1) }
1488 gdpat :: { LGRHS RdrName }
1489 : '|' quals '->' exp { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
1491 -- 'pat' recognises a pattern, including one with a bang at the top
1492 -- e.g. "!x" or "!(x,y)" or "C a b" etc
1493 -- Bangs inside are parsed as infix operator applications, so that
1494 -- we parse them right when bang-patterns are off
1495 pat :: { LPat RdrName }
1496 pat : infixexp {% checkPattern $1 }
1497 | '!' aexp {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1499 apat :: { LPat RdrName }
1500 apat : aexp {% checkPattern $1 }
1501 | '!' aexp {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1503 apats :: { [LPat RdrName] }
1504 : apat apats { $1 : $2 }
1505 | {- empty -} { [] }
1507 -----------------------------------------------------------------------------
1508 -- Statement sequences
1510 stmtlist :: { Located [LStmt RdrName] }
1511 : '{' stmts '}' { LL (unLoc $2) }
1512 | vocurly stmts close { $2 }
1514 -- do { ;; s ; s ; ; s ;; }
1515 -- The last Stmt should be an expression, but that's hard to enforce
1516 -- here, because we need too much lookahead if we see do { e ; }
1517 -- So we use ExprStmts throughout, and switch the last one over
1518 -- in ParseUtils.checkDo instead
1519 stmts :: { Located [LStmt RdrName] }
1520 : stmt stmts_help { LL ($1 : unLoc $2) }
1521 | ';' stmts { LL (unLoc $2) }
1522 | {- empty -} { noLoc [] }
1524 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1525 : ';' stmts { LL (unLoc $2) }
1526 | {- empty -} { noLoc [] }
1528 -- For typing stmts at the GHCi prompt, where
1529 -- the input may consist of just comments.
1530 maybe_stmt :: { Maybe (LStmt RdrName) }
1532 | {- nothing -} { Nothing }
1534 stmt :: { LStmt RdrName }
1536 -- What is this next production doing? I have no clue! SLPJ Dec06
1537 | infixexp '->' exp {% checkPattern $3 >>= \p ->
1538 return (LL $ mkBindStmt p $1) }
1539 | 'rec' stmtlist { LL $ mkRecStmt (unLoc $2) }
1541 qual :: { LStmt RdrName }
1542 : pat '<-' exp { LL $ mkBindStmt $1 $3 }
1543 | exp { L1 $ mkExprStmt $1 }
1544 | 'let' binds { LL $ LetStmt (unLoc $2) }
1546 -----------------------------------------------------------------------------
1547 -- Record Field Update/Construction
1549 fbinds :: { HsRecordBinds RdrName }
1550 : fbinds1 { HsRecordBinds (reverse $1) }
1551 | {- empty -} { HsRecordBinds [] }
1553 fbinds1 :: { [(Located id, LHsExpr id)] }
1554 : fbinds1 ',' fbind { $3 : $1 }
1557 fbind :: { (Located RdrName, LHsExpr RdrName) }
1558 : qvar '=' exp { ($1,$3) }
1560 -----------------------------------------------------------------------------
1561 -- Implicit Parameter Bindings
1563 dbinds :: { Located [LIPBind RdrName] }
1564 : dbinds ';' dbind { LL ($3 : unLoc $1) }
1565 | dbinds ';' { LL (unLoc $1) }
1567 -- | {- empty -} { [] }
1569 dbind :: { LIPBind RdrName }
1570 dbind : ipvar '=' exp { LL (IPBind (unLoc $1) $3) }
1572 ipvar :: { Located (IPName RdrName) }
1573 : IPDUPVARID { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
1575 -----------------------------------------------------------------------------
1578 depreclist :: { Located [RdrName] }
1579 depreclist : deprec_var { L1 [unLoc $1] }
1580 | deprec_var ',' depreclist { LL (unLoc $1 : unLoc $3) }
1582 deprec_var :: { Located RdrName }
1583 deprec_var : var { $1 }
1586 -----------------------------------------
1587 -- Data constructors
1588 qcon :: { Located RdrName }
1590 | '(' qconsym ')' { LL (unLoc $2) }
1591 | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
1592 -- The case of '[:' ':]' is part of the production `parr'
1594 con :: { Located RdrName }
1596 | '(' consym ')' { LL (unLoc $2) }
1597 | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
1599 sysdcon :: { Located DataCon } -- Wired in data constructors
1600 : '(' ')' { LL unitDataCon }
1601 | '(' commas ')' { LL $ tupleCon Boxed $2 }
1602 | '[' ']' { LL nilDataCon }
1604 conop :: { Located RdrName }
1606 | '`' conid '`' { LL (unLoc $2) }
1608 qconop :: { Located RdrName }
1610 | '`' qconid '`' { LL (unLoc $2) }
1612 -----------------------------------------------------------------------------
1613 -- Type constructors
1615 gtycon :: { Located RdrName } -- A "general" qualified tycon
1617 | '(' ')' { LL $ getRdrName unitTyCon }
1618 | '(' commas ')' { LL $ getRdrName (tupleTyCon Boxed $2) }
1619 | '(' '->' ')' { LL $ getRdrName funTyCon }
1620 | '[' ']' { LL $ listTyCon_RDR }
1621 | '[:' ':]' { LL $ parrTyCon_RDR }
1623 oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon
1625 | '(' qtyconsym ')' { LL (unLoc $2) }
1627 qtyconop :: { Located RdrName } -- Qualified or unqualified
1629 | '`' qtycon '`' { LL (unLoc $2) }
1631 qtycon :: { Located RdrName } -- Qualified or unqualified
1632 : QCONID { L1 $! mkQual tcClsName (getQCONID $1) }
1635 tycon :: { Located RdrName } -- Unqualified
1636 : CONID { L1 $! mkUnqual tcClsName (getCONID $1) }
1638 qtyconsym :: { Located RdrName }
1639 : QCONSYM { L1 $! mkQual tcClsName (getQCONSYM $1) }
1642 tyconsym :: { Located RdrName }
1643 : CONSYM { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1645 -----------------------------------------------------------------------------
1648 op :: { Located RdrName } -- used in infix decls
1652 varop :: { Located RdrName }
1654 | '`' varid '`' { LL (unLoc $2) }
1656 qop :: { LHsExpr RdrName } -- used in sections
1657 : qvarop { L1 $ HsVar (unLoc $1) }
1658 | qconop { L1 $ HsVar (unLoc $1) }
1660 qopm :: { LHsExpr RdrName } -- used in sections
1661 : qvaropm { L1 $ HsVar (unLoc $1) }
1662 | qconop { L1 $ HsVar (unLoc $1) }
1664 qvarop :: { Located RdrName }
1666 | '`' qvarid '`' { LL (unLoc $2) }
1668 qvaropm :: { Located RdrName }
1669 : qvarsym_no_minus { $1 }
1670 | '`' qvarid '`' { LL (unLoc $2) }
1672 -----------------------------------------------------------------------------
1675 tyvar :: { Located RdrName }
1676 tyvar : tyvarid { $1 }
1677 | '(' tyvarsym ')' { LL (unLoc $2) }
1679 tyvarop :: { Located RdrName }
1680 tyvarop : '`' tyvarid '`' { LL (unLoc $2) }
1683 tyvarid :: { Located RdrName }
1684 : VARID { L1 $! mkUnqual tvName (getVARID $1) }
1685 | special_id { L1 $! mkUnqual tvName (unLoc $1) }
1686 | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") }
1687 | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") }
1688 | 'threadsafe' { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1690 tyvarsym :: { Located RdrName }
1691 -- Does not include "!", because that is used for strictness marks
1692 -- or ".", because that separates the quantified type vars from the rest
1693 -- or "*", because that's used for kinds
1694 tyvarsym : VARSYM { L1 $! mkUnqual tvName (getVARSYM $1) }
1696 -----------------------------------------------------------------------------
1699 var :: { Located RdrName }
1701 | '(' varsym ')' { LL (unLoc $2) }
1703 qvar :: { Located RdrName }
1705 | '(' varsym ')' { LL (unLoc $2) }
1706 | '(' qvarsym1 ')' { LL (unLoc $2) }
1707 -- We've inlined qvarsym here so that the decision about
1708 -- whether it's a qvar or a var can be postponed until
1709 -- *after* we see the close paren.
1711 qvarid :: { Located RdrName }
1713 | QVARID { L1 $ mkQual varName (getQVARID $1) }
1715 varid :: { Located RdrName }
1716 : varid_no_unsafe { $1 }
1717 | 'unsafe' { L1 $! mkUnqual varName FSLIT("unsafe") }
1718 | 'safe' { L1 $! mkUnqual varName FSLIT("safe") }
1719 | 'threadsafe' { L1 $! mkUnqual varName FSLIT("threadsafe") }
1721 varid_no_unsafe :: { Located RdrName }
1722 : VARID { L1 $! mkUnqual varName (getVARID $1) }
1723 | special_id { L1 $! mkUnqual varName (unLoc $1) }
1724 | 'forall' { L1 $! mkUnqual varName FSLIT("forall") }
1725 | 'family' { L1 $! mkUnqual varName FSLIT("family") }
1727 qvarsym :: { Located RdrName }
1731 qvarsym_no_minus :: { Located RdrName }
1732 : varsym_no_minus { $1 }
1735 qvarsym1 :: { Located RdrName }
1736 qvarsym1 : QVARSYM { L1 $ mkQual varName (getQVARSYM $1) }
1738 varsym :: { Located RdrName }
1739 : varsym_no_minus { $1 }
1740 | '-' { L1 $ mkUnqual varName FSLIT("-") }
1742 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1743 : VARSYM { L1 $ mkUnqual varName (getVARSYM $1) }
1744 | special_sym { L1 $ mkUnqual varName (unLoc $1) }
1747 -- These special_ids are treated as keywords in various places,
1748 -- but as ordinary ids elsewhere. 'special_id' collects all these
1749 -- except 'unsafe', 'forall', and 'family' whose treatment differs
1750 -- depending on context
1751 special_id :: { Located FastString }
1753 : 'as' { L1 FSLIT("as") }
1754 | 'qualified' { L1 FSLIT("qualified") }
1755 | 'hiding' { L1 FSLIT("hiding") }
1756 | 'derive' { L1 FSLIT("derive") }
1757 | 'export' { L1 FSLIT("export") }
1758 | 'label' { L1 FSLIT("label") }
1759 | 'dynamic' { L1 FSLIT("dynamic") }
1760 | 'stdcall' { L1 FSLIT("stdcall") }
1761 | 'ccall' { L1 FSLIT("ccall") }
1763 special_sym :: { Located FastString }
1764 special_sym : '!' { L1 FSLIT("!") }
1765 | '.' { L1 FSLIT(".") }
1766 | '*' { L1 FSLIT("*") }
1768 -----------------------------------------------------------------------------
1769 -- Data constructors
1771 qconid :: { Located RdrName } -- Qualified or unqualified
1773 | QCONID { L1 $ mkQual dataName (getQCONID $1) }
1775 conid :: { Located RdrName }
1776 : CONID { L1 $ mkUnqual dataName (getCONID $1) }
1778 qconsym :: { Located RdrName } -- Qualified or unqualified
1780 | QCONSYM { L1 $ mkQual dataName (getQCONSYM $1) }
1782 consym :: { Located RdrName }
1783 : CONSYM { L1 $ mkUnqual dataName (getCONSYM $1) }
1785 -- ':' means only list cons
1786 | ':' { L1 $ consDataCon_RDR }
1789 -----------------------------------------------------------------------------
1792 literal :: { Located HsLit }
1793 : CHAR { L1 $ HsChar $ getCHAR $1 }
1794 | STRING { L1 $ HsString $ getSTRING $1 }
1795 | PRIMINTEGER { L1 $ HsIntPrim $ getPRIMINTEGER $1 }
1796 | PRIMCHAR { L1 $ HsCharPrim $ getPRIMCHAR $1 }
1797 | PRIMSTRING { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1798 | PRIMFLOAT { L1 $ HsFloatPrim $ getPRIMFLOAT $1 }
1799 | PRIMDOUBLE { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1801 -----------------------------------------------------------------------------
1805 : vccurly { () } -- context popped in lexer.
1806 | error {% popContext }
1808 -----------------------------------------------------------------------------
1809 -- Miscellaneous (mostly renamings)
1811 modid :: { Located ModuleName }
1812 : CONID { L1 $ mkModuleNameFS (getCONID $1) }
1813 | QCONID { L1 $ let (mod,c) = getQCONID $1 in
1816 (unpackFS mod ++ '.':unpackFS c))
1820 : commas ',' { $1 + 1 }
1823 -----------------------------------------------------------------------------
1824 -- Documentation comments
1826 docnext :: { LHsDoc RdrName }
1827 : DOCNEXT {% case parseHaddockParagraphs (tokenise (getDOCNEXT $1)) of {
1828 Left err -> parseError (getLoc $1) err;
1829 Right doc -> return (L1 doc) } }
1831 docprev :: { LHsDoc RdrName }
1832 : DOCPREV {% case parseHaddockParagraphs (tokenise (getDOCPREV $1)) of {
1833 Left err -> parseError (getLoc $1) err;
1834 Right doc -> return (L1 doc) } }
1836 docnamed :: { Located (String, (HsDoc RdrName)) }
1838 let string = getDOCNAMED $1
1839 (name, rest) = break isSpace string
1840 in case parseHaddockParagraphs (tokenise rest) of {
1841 Left err -> parseError (getLoc $1) err;
1842 Right doc -> return (L1 (name, doc)) } }
1844 docsection :: { Located (n, HsDoc RdrName) }
1845 : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
1846 case parseHaddockString (tokenise doc) of {
1847 Left err -> parseError (getLoc $1) err;
1848 Right doc -> return (L1 (n, doc)) } }
1850 docoptions :: { String }
1851 : DOCOPTIONS { getDOCOPTIONS $1 }
1853 moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
1854 : DOCNEXT {% let string = getDOCNEXT $1 in
1855 case parseModuleHeader string of {
1856 Right (str, info) ->
1857 case parseHaddockParagraphs (tokenise str) of {
1858 Left err -> parseError (getLoc $1) err;
1859 Right doc -> return (info, Just doc);
1861 Left err -> parseError (getLoc $1) err
1864 maybe_docprev :: { Maybe (LHsDoc RdrName) }
1865 : docprev { Just $1 }
1866 | {- empty -} { Nothing }
1868 maybe_docnext :: { Maybe (LHsDoc RdrName) }
1869 : docnext { Just $1 }
1870 | {- empty -} { Nothing }
1874 happyError = srcParseFail
1876 getVARID (L _ (ITvarid x)) = x
1877 getCONID (L _ (ITconid x)) = x
1878 getVARSYM (L _ (ITvarsym x)) = x
1879 getCONSYM (L _ (ITconsym x)) = x
1880 getQVARID (L _ (ITqvarid x)) = x
1881 getQCONID (L _ (ITqconid x)) = x
1882 getQVARSYM (L _ (ITqvarsym x)) = x
1883 getQCONSYM (L _ (ITqconsym x)) = x
1884 getIPDUPVARID (L _ (ITdupipvarid x)) = x
1885 getCHAR (L _ (ITchar x)) = x
1886 getSTRING (L _ (ITstring x)) = x
1887 getINTEGER (L _ (ITinteger x)) = x
1888 getRATIONAL (L _ (ITrational x)) = x
1889 getPRIMCHAR (L _ (ITprimchar x)) = x
1890 getPRIMSTRING (L _ (ITprimstring x)) = x
1891 getPRIMINTEGER (L _ (ITprimint x)) = x
1892 getPRIMFLOAT (L _ (ITprimfloat x)) = x
1893 getPRIMDOUBLE (L _ (ITprimdouble x)) = x
1894 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1895 getINLINE (L _ (ITinline_prag b)) = b
1896 getSPEC_INLINE (L _ (ITspec_inline_prag b)) = b
1898 getDOCNEXT (L _ (ITdocCommentNext x)) = x
1899 getDOCPREV (L _ (ITdocCommentPrev x)) = x
1900 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
1901 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
1902 getDOCOPTIONS (L _ (ITdocOptions x)) = x
1904 -- Utilities for combining source spans
1905 comb2 :: Located a -> Located b -> SrcSpan
1908 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1909 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1911 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1912 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1913 combineSrcSpans (getLoc c) (getLoc d)
1915 -- strict constructor version:
1917 sL :: SrcSpan -> a -> Located a
1918 sL span a = span `seq` L span a
1920 -- Make a source location for the file. We're a bit lazy here and just
1921 -- make a point SrcSpan at line 1, column 0. Strictly speaking we should
1922 -- try to find the span of the whole file (ToDo).
1923 fileSrcSpan :: P SrcSpan
1926 let loc = mkSrcLoc (srcLocFile l) 1 0;
1927 return (mkSrcSpan loc loc)