2 -- ---------------------------------------------------------------------------
3 -- (c) The University of Glasgow 1997-2003
7 -- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
8 -- ---------------------------------------------------------------------------
12 -- The above warning supression flag is a temporary kludge.
13 -- While working on this module you are encouraged to remove it and fix
14 -- any warnings in the module. See
15 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
18 {-# OPTIONS_GHC -O0 -fno-ignore-interface-pragmas #-}
20 Careful optimisation of the parser: we don't want to throw everything
21 at it, because that takes too long and doesn't buy much, but we do want
22 to inline certain key external functions, so we instruct GHC not to
23 throw away inlinings as it would normally do in -O0 mode.
26 module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
31 import HscTypes ( IsBootInterface, DeprecTxt )
34 import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
35 unboxedSingletonTyCon, unboxedSingletonDataCon,
36 listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
37 import Type ( funTyCon )
38 import ForeignCall ( Safety(..), CExportSpec(..), CLabelString,
39 CCallConv(..), CCallTarget(..), defaultCCallConv
41 import OccName ( varName, dataName, tcClsName, tvName )
42 import DataCon ( DataCon, dataConName )
43 import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
44 SrcSpan, combineLocs, srcLocFile,
47 import StaticFlags ( opt_SccProfilingOn, opt_Hpc )
48 import Type ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
49 import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
50 Activation(..), defaultInlineSpec )
54 import {-# SOURCE #-} HaddockLex hiding ( Token )
58 import Maybes ( orElse )
61 import Control.Monad ( unless )
64 import Control.Monad ( mplus )
68 -----------------------------------------------------------------------------
71 Conflicts: 33 shift/reduce
74 The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
75 would think the two should never occur in the same context.
79 -----------------------------------------------------------------------------
82 Conflicts: 34 shift/reduce
85 The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
86 would think the two should never occur in the same context.
90 -----------------------------------------------------------------------------
93 Conflicts: 32 shift/reduce
96 The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
97 would think the two should never occur in the same context.
101 -----------------------------------------------------------------------------
104 Conflicts: 37 shift/reduce
107 The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
108 would think the two should never occur in the same context.
112 -----------------------------------------------------------------------------
113 Conflicts: 38 shift/reduce (1.25)
115 10 for abiguity in 'if x then y else z + 1' [State 178]
116 (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
117 10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
119 1 for ambiguity in 'if x then y else z :: T' [State 178]
120 (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
122 4 for ambiguity in 'if x then y else z -< e' [State 178]
123 (shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
124 There are four such operators: -<, >-, -<<, >>-
127 2 for ambiguity in 'case v of { x :: T -> T ... } ' [States 11, 253]
128 Which of these two is intended?
130 (x::T) -> T -- Rhs is T
133 (x::T -> T) -> .. -- Rhs is ...
135 10 for ambiguity in 'e :: a `b` c'. Does this mean [States 11, 253]
138 As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases
139 Same duplication between states 11 and 253 as the previous case
141 1 for ambiguity in 'let ?x ...' [State 329]
142 the parser can't tell whether the ?x is the lhs of a normal binding or
143 an implicit binding. Fortunately resolving as shift gives it the only
144 sensible meaning, namely the lhs of an implicit binding.
146 1 for ambiguity in '{-# RULES "name" [ ... #-} [State 382]
147 we don't know whether the '[' starts the activation or not: it
148 might be the start of the declaration with the activation being
149 empty. --SDM 1/4/2002
151 1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 474]
152 since 'forall' is a valid variable name, we don't know whether
153 to treat a forall on the input as the beginning of a quantifier
154 or the beginning of the rule itself. Resolving to shift means
155 it's always treated as a quantifier, hence the above is disallowed.
156 This saves explicitly defining a grammar for the rule lhs that
157 doesn't include 'forall'.
159 1 for ambiguity when the source file starts with "-- | doc". We need another
160 token of lookahead to determine if a top declaration or the 'module' keyword
161 follows. Shift parses as if the 'module' keyword follows.
163 -- ---------------------------------------------------------------------------
164 -- Adding location info
166 This is done in a stylised way using the three macros below, L0, L1
167 and LL. Each of these macros can be thought of as having type
169 L0, L1, LL :: a -> Located a
171 They each add a SrcSpan to their argument.
173 L0 adds 'noSrcSpan', used for empty productions
174 -- This doesn't seem to work anymore -=chak
176 L1 for a production with a single token on the lhs. Grabs the SrcSpan
179 LL for a production with >1 token on the lhs. Makes up a SrcSpan from
180 the first and last tokens.
182 These suffice for the majority of cases. However, we must be
183 especially careful with empty productions: LL won't work if the first
184 or last token on the lhs can represent an empty span. In these cases,
185 we have to calculate the span using more of the tokens from the lhs, eg.
187 | 'newtype' tycl_hdr '=' newconstr deriving
189 (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
191 We provide comb3 and comb4 functions which are useful in such cases.
193 Be careful: there's no checking that you actually got this right, the
194 only symptom will be that the SrcSpans of your syntax will be
198 * We must expand these macros *before* running Happy, which is why this file is
199 * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
201 #define L0 L noSrcSpan
202 #define L1 sL (getLoc $1)
203 #define LL sL (comb2 $1 $>)
205 -- -----------------------------------------------------------------------------
210 '_' { L _ ITunderscore } -- Haskell keywords
212 'case' { L _ ITcase }
213 'class' { L _ ITclass }
214 'data' { L _ ITdata }
215 'default' { L _ ITdefault }
216 'deriving' { L _ ITderiving }
218 'else' { L _ ITelse }
219 'hiding' { L _ IThiding }
221 'import' { L _ ITimport }
223 'infix' { L _ ITinfix }
224 'infixl' { L _ ITinfixl }
225 'infixr' { L _ ITinfixr }
226 'instance' { L _ ITinstance }
228 'module' { L _ ITmodule }
229 'newtype' { L _ ITnewtype }
231 'qualified' { L _ ITqualified }
232 'then' { L _ ITthen }
233 'type' { L _ ITtype }
234 'where' { L _ ITwhere }
235 '_scc_' { L _ ITscc } -- ToDo: remove
237 'forall' { L _ ITforall } -- GHC extension keywords
238 'foreign' { L _ ITforeign }
239 'export' { L _ ITexport }
240 'label' { L _ ITlabel }
241 'dynamic' { L _ ITdynamic }
242 'safe' { L _ ITsafe }
243 'threadsafe' { L _ ITthreadsafe }
244 'unsafe' { L _ ITunsafe }
246 'family' { L _ ITfamily }
247 'stdcall' { L _ ITstdcallconv }
248 'ccall' { L _ ITccallconv }
249 'dotnet' { L _ ITdotnet }
250 'proc' { L _ ITproc } -- for arrow notation extension
251 'rec' { L _ ITrec } -- for arrow notation extension
252 'group' { L _ ITgroup } -- for list transform extension
253 'by' { L _ ITby } -- for list transform extension
254 'using' { L _ ITusing } -- for list transform extension
256 '{-# INLINE' { L _ (ITinline_prag _) }
257 '{-# SPECIALISE' { L _ ITspec_prag }
258 '{-# SPECIALISE_INLINE' { L _ (ITspec_inline_prag _) }
259 '{-# SOURCE' { L _ ITsource_prag }
260 '{-# RULES' { L _ ITrules_prag }
261 '{-# CORE' { L _ ITcore_prag } -- hdaume: annotated core
262 '{-# SCC' { L _ ITscc_prag }
263 '{-# GENERATED' { L _ ITgenerated_prag }
264 '{-# DEPRECATED' { L _ ITdeprecated_prag }
265 '{-# UNPACK' { L _ ITunpack_prag }
266 '#-}' { L _ ITclose_prag }
268 '..' { L _ ITdotdot } -- reserved symbols
270 '::' { L _ ITdcolon }
274 '<-' { L _ ITlarrow }
275 '->' { L _ ITrarrow }
278 '=>' { L _ ITdarrow }
282 '-<' { L _ ITlarrowtail } -- for arrow notation
283 '>-' { L _ ITrarrowtail } -- for arrow notation
284 '-<<' { L _ ITLarrowtail } -- for arrow notation
285 '>>-' { L _ ITRarrowtail } -- for arrow notation
288 '{' { L _ ITocurly } -- special symbols
290 '{|' { L _ ITocurlybar }
291 '|}' { L _ ITccurlybar }
292 vocurly { L _ ITvocurly } -- virtual open curly (from layout)
293 vccurly { L _ ITvccurly } -- virtual close curly (from layout)
296 '[:' { L _ ITopabrack }
297 ':]' { L _ ITcpabrack }
300 '(#' { L _ IToubxparen }
301 '#)' { L _ ITcubxparen }
302 '(|' { L _ IToparenbar }
303 '|)' { L _ ITcparenbar }
306 '`' { L _ ITbackquote }
308 VARID { L _ (ITvarid _) } -- identifiers
309 CONID { L _ (ITconid _) }
310 VARSYM { L _ (ITvarsym _) }
311 CONSYM { L _ (ITconsym _) }
312 QVARID { L _ (ITqvarid _) }
313 QCONID { L _ (ITqconid _) }
314 QVARSYM { L _ (ITqvarsym _) }
315 QCONSYM { L _ (ITqconsym _) }
317 IPDUPVARID { L _ (ITdupipvarid _) } -- GHC extension
319 CHAR { L _ (ITchar _) }
320 STRING { L _ (ITstring _) }
321 INTEGER { L _ (ITinteger _) }
322 RATIONAL { L _ (ITrational _) }
324 PRIMCHAR { L _ (ITprimchar _) }
325 PRIMSTRING { L _ (ITprimstring _) }
326 PRIMINTEGER { L _ (ITprimint _) }
327 PRIMWORD { L _ (ITprimword _) }
328 PRIMFLOAT { L _ (ITprimfloat _) }
329 PRIMDOUBLE { L _ (ITprimdouble _) }
331 DOCNEXT { L _ (ITdocCommentNext _) }
332 DOCPREV { L _ (ITdocCommentPrev _) }
333 DOCNAMED { L _ (ITdocCommentNamed _) }
334 DOCSECTION { L _ (ITdocSection _ _) }
337 '[|' { L _ ITopenExpQuote }
338 '[p|' { L _ ITopenPatQuote }
339 '[t|' { L _ ITopenTypQuote }
340 '[d|' { L _ ITopenDecQuote }
341 '|]' { L _ ITcloseQuote }
342 TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
343 '$(' { L _ ITparenEscape } -- $( exp )
344 TH_VAR_QUOTE { L _ ITvarQuote } -- 'x
345 TH_TY_QUOTE { L _ ITtyQuote } -- ''T
346 TH_QUASIQUOTE { L _ (ITquasiQuote _) }
348 %monad { P } { >>= } { return }
349 %lexer { lexer } { L _ ITeof }
350 %name parseModule module
351 %name parseStmt maybe_stmt
352 %name parseIdentifier identifier
353 %name parseType ctype
354 %partial parseHeader header
355 %tokentype { (Located Token) }
358 -----------------------------------------------------------------------------
359 -- Identifiers; one of the entry points
360 identifier :: { Located RdrName }
365 | '(' '->' ')' { LL $ getRdrName funTyCon }
367 -----------------------------------------------------------------------------
370 -- The place for module deprecation is really too restrictive, but if it
371 -- was allowed at its natural place just before 'module', we get an ugly
372 -- s/r conflict with the second alternative. Another solution would be the
373 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
374 -- either, and DEPRECATED is only expected to be used by people who really
375 -- know what they are doing. :-)
377 module :: { Located (HsModule RdrName) }
378 : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' body
379 {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
380 return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
383 {% fileSrcSpan >>= \ loc ->
384 return (L loc (HsModule Nothing Nothing
385 (fst $1) (snd $1) Nothing emptyHaddockModInfo
388 maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
389 : moduleheader { $1 }
390 | {- empty -} { (emptyHaddockModInfo, Nothing) }
392 missing_module_keyword :: { () }
393 : {- empty -} {% pushCurrentContext }
395 maybemoddeprec :: { Maybe DeprecTxt }
396 : '{-# DEPRECATED' STRING '#-}' { Just (getSTRING $2) }
397 | {- empty -} { Nothing }
399 body :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
401 | vocurly top close { $2 }
403 body2 :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
405 | missing_module_keyword top close { $2 }
407 top :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
408 : importdecls { (reverse $1,[]) }
409 | importdecls ';' cvtopdecls { (reverse $1,$3) }
410 | cvtopdecls { ([],$1) }
412 cvtopdecls :: { [LHsDecl RdrName] }
413 : topdecls { cvTopDecls $1 }
415 -----------------------------------------------------------------------------
416 -- Module declaration & imports only
418 header :: { Located (HsModule RdrName) }
419 : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' header_body
420 {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
421 return (L loc (HsModule (Just $3) $5 $7 [] $4
423 | missing_module_keyword importdecls
424 {% fileSrcSpan >>= \ loc ->
425 return (L loc (HsModule Nothing Nothing $2 [] Nothing
426 emptyHaddockModInfo Nothing)) }
428 header_body :: { [LImportDecl RdrName] }
429 : '{' importdecls { $2 }
430 | vocurly importdecls { $2 }
432 -----------------------------------------------------------------------------
435 maybeexports :: { Maybe [LIE RdrName] }
436 : '(' exportlist ')' { Just $2 }
437 | {- empty -} { Nothing }
439 exportlist :: { [LIE RdrName] }
440 : expdoclist ',' expdoclist { $1 ++ $3 }
443 exportlist1 :: { [LIE RdrName] }
444 : expdoclist export expdoclist ',' exportlist { $1 ++ ($2 : $3) ++ $5 }
445 | expdoclist export expdoclist { $1 ++ ($2 : $3) }
448 expdoclist :: { [LIE RdrName] }
449 : exp_doc expdoclist { $1 : $2 }
452 exp_doc :: { LIE RdrName }
453 : docsection { L1 (case (unLoc $1) of (n, doc) -> IEGroup n doc) }
454 | docnamed { L1 (IEDocNamed ((fst . unLoc) $1)) }
455 | docnext { L1 (IEDoc (unLoc $1)) }
457 -- No longer allow things like [] and (,,,) to be exported
458 -- They are built in syntax, always available
459 export :: { LIE RdrName }
460 : qvar { L1 (IEVar (unLoc $1)) }
461 | oqtycon { L1 (IEThingAbs (unLoc $1)) }
462 | oqtycon '(' '..' ')' { LL (IEThingAll (unLoc $1)) }
463 | oqtycon '(' ')' { LL (IEThingWith (unLoc $1) []) }
464 | oqtycon '(' qcnames ')' { LL (IEThingWith (unLoc $1) (reverse $3)) }
465 | 'module' modid { LL (IEModuleContents (unLoc $2)) }
467 qcnames :: { [RdrName] }
468 : qcnames ',' qcname_ext { unLoc $3 : $1 }
469 | qcname_ext { [unLoc $1] }
471 qcname_ext :: { Located RdrName } -- Variable or data constructor
472 -- or tagged type constructor
474 | 'type' qcon { sL (comb2 $1 $2)
475 (setRdrNameSpace (unLoc $2)
478 -- Cannot pull into qcname_ext, as qcname is also used in expression.
479 qcname :: { Located RdrName } -- Variable or data constructor
483 -----------------------------------------------------------------------------
484 -- Import Declarations
486 -- import decls can be *empty*, or even just a string of semicolons
487 -- whereas topdecls must contain at least one topdecl.
489 importdecls :: { [LImportDecl RdrName] }
490 : importdecls ';' importdecl { $3 : $1 }
491 | importdecls ';' { $1 }
492 | importdecl { [ $1 ] }
495 importdecl :: { LImportDecl RdrName }
496 : 'import' maybe_src optqualified modid maybeas maybeimpspec
497 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
499 maybe_src :: { IsBootInterface }
500 : '{-# SOURCE' '#-}' { True }
501 | {- empty -} { False }
503 optqualified :: { Bool }
504 : 'qualified' { True }
505 | {- empty -} { False }
507 maybeas :: { Located (Maybe ModuleName) }
508 : 'as' modid { LL (Just (unLoc $2)) }
509 | {- empty -} { noLoc Nothing }
511 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
512 : impspec { L1 (Just (unLoc $1)) }
513 | {- empty -} { noLoc Nothing }
515 impspec :: { Located (Bool, [LIE RdrName]) }
516 : '(' exportlist ')' { LL (False, $2) }
517 | 'hiding' '(' exportlist ')' { LL (True, $3) }
519 -----------------------------------------------------------------------------
520 -- Fixity Declarations
524 | INTEGER {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
526 infix :: { Located FixityDirection }
527 : 'infix' { L1 InfixN }
528 | 'infixl' { L1 InfixL }
529 | 'infixr' { L1 InfixR }
531 ops :: { Located [Located RdrName] }
532 : ops ',' op { LL ($3 : unLoc $1) }
535 -----------------------------------------------------------------------------
536 -- Top-Level Declarations
538 topdecls :: { OrdList (LHsDecl RdrName) }
539 : topdecls ';' topdecl { $1 `appOL` $3 }
540 | topdecls ';' { $1 }
543 topdecl :: { OrdList (LHsDecl RdrName) }
544 : cl_decl { unitOL (L1 (TyClD (unLoc $1))) }
545 | ty_decl { unitOL (L1 (TyClD (unLoc $1))) }
546 | 'instance' inst_type where_inst
547 { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
549 unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs ats)))}
550 | stand_alone_deriving { unitOL (LL (DerivD (unLoc $1))) }
551 | 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
552 | 'foreign' fdecl { unitOL (LL (unLoc $2)) }
553 | '{-# DEPRECATED' deprecations '#-}' { $2 }
554 | '{-# RULES' rules '#-}' { $2 }
557 -- Template Haskell Extension
558 | '$(' exp ')' { unitOL (LL $ SpliceD (SpliceDecl $2)) }
559 | TH_ID_SPLICE { unitOL (LL $ SpliceD (SpliceDecl $
560 L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
565 cl_decl :: { LTyClDecl RdrName }
566 : 'class' tycl_hdr fds where_cls
567 {% do { let { (binds, sigs, ats, docs) =
568 cvBindsAndSigs (unLoc $4)
569 ; (ctxt, tc, tvs, tparms) = unLoc $2}
570 ; checkTyVars tparms -- only type vars allowed
572 ; return $ L (comb4 $1 $2 $3 $4)
573 (mkClassDecl (ctxt, tc, tvs)
574 (unLoc $3) sigs binds ats docs) } }
576 -- Type declarations (toplevel)
578 ty_decl :: { LTyClDecl RdrName }
579 -- ordinary type synonyms
580 : 'type' type '=' ctype
581 -- Note ctype, not sigtype, on the right of '='
582 -- We allow an explicit for-all but we don't insert one
583 -- in type Foo a = (b,b)
584 -- Instead we just say b is out of scope
586 -- Note the use of type for the head; this allows
587 -- infix type constructors to be declared
588 {% do { (tc, tvs, _) <- checkSynHdr $2 False
589 ; return (L (comb2 $1 $4)
590 (TySynonym tc tvs Nothing $4))
593 -- type family declarations
594 | 'type' 'family' type opt_kind_sig
595 -- Note the use of type for the head; this allows
596 -- infix type constructors to be declared
598 {% do { (tc, tvs, _) <- checkSynHdr $3 False
599 ; return (L (comb3 $1 $3 $4)
600 (TyFamily TypeFamily tc tvs (unLoc $4)))
603 -- type instance declarations
604 | 'type' 'instance' type '=' ctype
605 -- Note the use of type for the head; this allows
606 -- infix type constructors and type patterns
608 {% do { (tc, tvs, typats) <- checkSynHdr $3 True
609 ; return (L (comb2 $1 $5)
610 (TySynonym tc tvs (Just typats) $5))
613 -- ordinary data type or newtype declaration
614 | data_or_newtype tycl_hdr constrs deriving
615 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
616 ; checkTyVars tparms -- no type pattern
618 sL (comb4 $1 $2 $3 $4)
619 -- We need the location on tycl_hdr in case
620 -- constrs and deriving are both empty
621 (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
622 Nothing (reverse (unLoc $3)) (unLoc $4)) } }
624 -- ordinary GADT declaration
625 | data_or_newtype tycl_hdr opt_kind_sig
626 'where' gadt_constrlist
628 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
629 ; checkTyVars tparms -- can have type pats
631 sL (comb4 $1 $2 $4 $5)
632 (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
633 (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
635 -- data/newtype family
636 | 'data' 'family' tycl_hdr opt_kind_sig
637 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
638 ; checkTyVars tparms -- no type pattern
639 ; unless (null (unLoc ctxt)) $ -- and no context
640 parseError (getLoc ctxt)
641 "A family declaration cannot have a context"
644 (TyFamily DataFamily tc tvs (unLoc $4)) } }
646 -- data/newtype instance declaration
647 | data_or_newtype 'instance' tycl_hdr constrs deriving
648 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
649 -- can have type pats
651 L (comb4 $1 $3 $4 $5)
652 -- We need the location on tycl_hdr in case
653 -- constrs and deriving are both empty
654 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
655 Nothing (reverse (unLoc $4)) (unLoc $5)) } }
657 -- GADT instance declaration
658 | data_or_newtype 'instance' tycl_hdr opt_kind_sig
659 'where' gadt_constrlist
661 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
662 -- can have type pats
664 L (comb4 $1 $3 $6 $7)
665 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
666 (unLoc $4) (reverse (unLoc $6)) (unLoc $7)) } }
668 -- Associate type family declarations
670 -- * They have a different syntax than on the toplevel (no family special
673 -- * They also need to be separate from instances; otherwise, data family
674 -- declarations without a kind signature cause parsing conflicts with empty
675 -- data declarations.
677 at_decl_cls :: { LTyClDecl RdrName }
678 -- type family declarations
679 : 'type' type opt_kind_sig
680 -- Note the use of type for the head; this allows
681 -- infix type constructors to be declared
683 {% do { (tc, tvs, _) <- checkSynHdr $2 False
684 ; return (L (comb3 $1 $2 $3)
685 (TyFamily TypeFamily tc tvs (unLoc $3)))
688 -- default type instance
689 | 'type' type '=' ctype
690 -- Note the use of type for the head; this allows
691 -- infix type constructors and type patterns
693 {% do { (tc, tvs, typats) <- checkSynHdr $2 True
694 ; return (L (comb2 $1 $4)
695 (TySynonym tc tvs (Just typats) $4))
698 -- data/newtype family declaration
699 | 'data' tycl_hdr opt_kind_sig
700 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
701 ; checkTyVars tparms -- no type pattern
702 ; unless (null (unLoc ctxt)) $ -- and no context
703 parseError (getLoc ctxt)
704 "A family declaration cannot have a context"
707 (TyFamily DataFamily tc tvs (unLoc $3))
710 -- Associate type instances
712 at_decl_inst :: { LTyClDecl RdrName }
713 -- type instance declarations
714 : 'type' type '=' ctype
715 -- Note the use of type for the head; this allows
716 -- infix type constructors and type patterns
718 {% do { (tc, tvs, typats) <- checkSynHdr $2 True
719 ; return (L (comb2 $1 $4)
720 (TySynonym tc tvs (Just typats) $4))
723 -- data/newtype instance declaration
724 | data_or_newtype tycl_hdr constrs deriving
725 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
726 -- can have type pats
728 L (comb4 $1 $2 $3 $4)
729 -- We need the location on tycl_hdr in case
730 -- constrs and deriving are both empty
731 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
732 Nothing (reverse (unLoc $3)) (unLoc $4)) } }
734 -- GADT instance declaration
735 | data_or_newtype tycl_hdr opt_kind_sig
736 'where' gadt_constrlist
738 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
739 -- can have type pats
741 L (comb4 $1 $2 $5 $6)
742 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
743 (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
745 data_or_newtype :: { Located NewOrData }
746 : 'data' { L1 DataType }
747 | 'newtype' { L1 NewType }
749 opt_kind_sig :: { Located (Maybe Kind) }
751 | '::' kind { LL (Just (unLoc $2)) }
753 -- tycl_hdr parses the header of a class or data type decl,
754 -- which takes the form
757 -- (Eq a, Ord b) => T a b
758 -- T Int [a] -- for associated types
759 -- Rather a lot of inlining here, else we get reduce/reduce errors
760 tycl_hdr :: { Located (LHsContext RdrName,
762 [LHsTyVarBndr RdrName],
764 : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
765 | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
767 -----------------------------------------------------------------------------
768 -- Stand-alone deriving
770 -- Glasgow extension: stand-alone deriving declarations
771 stand_alone_deriving :: { LDerivDecl RdrName }
772 : 'deriving' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
774 -----------------------------------------------------------------------------
775 -- Nested declarations
777 -- Declaration in class bodies
779 decl_cls :: { Located (OrdList (LHsDecl RdrName)) }
780 decl_cls : at_decl_cls { LL (unitOL (L1 (TyClD (unLoc $1)))) }
783 decls_cls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
784 : decls_cls ';' decl_cls { LL (unLoc $1 `appOL` unLoc $3) }
785 | decls_cls ';' { LL (unLoc $1) }
787 | {- empty -} { noLoc nilOL }
791 :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
792 : '{' decls_cls '}' { LL (unLoc $2) }
793 | vocurly decls_cls close { $2 }
797 where_cls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
798 -- No implicit parameters
799 -- May have type declarations
800 : 'where' decllist_cls { LL (unLoc $2) }
801 | {- empty -} { noLoc nilOL }
803 -- Declarations in instance bodies
805 decl_inst :: { Located (OrdList (LHsDecl RdrName)) }
806 decl_inst : at_decl_inst { LL (unitOL (L1 (TyClD (unLoc $1)))) }
809 decls_inst :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
810 : decls_inst ';' decl_inst { LL (unLoc $1 `appOL` unLoc $3) }
811 | decls_inst ';' { LL (unLoc $1) }
813 | {- empty -} { noLoc nilOL }
816 :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
817 : '{' decls_inst '}' { LL (unLoc $2) }
818 | vocurly decls_inst close { $2 }
822 where_inst :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
823 -- No implicit parameters
824 -- May have type declarations
825 : 'where' decllist_inst { LL (unLoc $2) }
826 | {- empty -} { noLoc nilOL }
828 -- Declarations in binding groups other than classes and instances
830 decls :: { Located (OrdList (LHsDecl RdrName)) }
831 : decls ';' decl { let { this = unLoc $3;
833 these = rest `appOL` this }
834 in rest `seq` this `seq` these `seq`
836 | decls ';' { LL (unLoc $1) }
838 | {- empty -} { noLoc nilOL }
840 decllist :: { Located (OrdList (LHsDecl RdrName)) }
841 : '{' decls '}' { LL (unLoc $2) }
842 | vocurly decls close { $2 }
844 -- Binding groups other than those of class and instance declarations
846 binds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
847 -- No type declarations
848 : decllist { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
849 | '{' dbinds '}' { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
850 | vocurly dbinds close { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
852 wherebinds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
853 -- No type declarations
854 : 'where' binds { LL (unLoc $2) }
855 | {- empty -} { noLoc emptyLocalBinds }
858 -----------------------------------------------------------------------------
859 -- Transformation Rules
861 rules :: { OrdList (LHsDecl RdrName) }
862 : rules ';' rule { $1 `snocOL` $3 }
865 | {- empty -} { nilOL }
867 rule :: { LHsDecl RdrName }
868 : STRING activation rule_forall infixexp '=' exp
869 { LL $ RuleD (HsRule (getSTRING $1)
870 ($2 `orElse` AlwaysActive)
871 $3 $4 placeHolderNames $6 placeHolderNames) }
873 activation :: { Maybe Activation }
874 : {- empty -} { Nothing }
875 | explicit_activation { Just $1 }
877 explicit_activation :: { Activation } -- In brackets
878 : '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
879 | '[' '~' INTEGER ']' { ActiveBefore (fromInteger (getINTEGER $3)) }
881 rule_forall :: { [RuleBndr RdrName] }
882 : 'forall' rule_var_list '.' { $2 }
885 rule_var_list :: { [RuleBndr RdrName] }
887 | rule_var rule_var_list { $1 : $2 }
889 rule_var :: { RuleBndr RdrName }
890 : varid { RuleBndr $1 }
891 | '(' varid '::' ctype ')' { RuleBndrSig $2 $4 }
893 -----------------------------------------------------------------------------
894 -- Deprecations (c.f. rules)
896 deprecations :: { OrdList (LHsDecl RdrName) }
897 : deprecations ';' deprecation { $1 `appOL` $3 }
898 | deprecations ';' { $1 }
900 | {- empty -} { nilOL }
902 -- SUP: TEMPORARY HACK, not checking for `module Foo'
903 deprecation :: { OrdList (LHsDecl RdrName) }
905 { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
909 -----------------------------------------------------------------------------
910 -- Foreign import and export declarations
912 fdecl :: { LHsDecl RdrName }
913 fdecl : 'import' callconv safety fspec
914 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
915 | 'import' callconv fspec
916 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
918 | 'export' callconv fspec
919 {% mkExport $2 (unLoc $3) >>= return.LL }
921 callconv :: { CallConv }
922 : 'stdcall' { CCall StdCallConv }
923 | 'ccall' { CCall CCallConv }
924 | 'dotnet' { DNCall }
927 : 'unsafe' { PlayRisky }
928 | 'safe' { PlaySafe False }
929 | 'threadsafe' { PlaySafe True }
931 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
932 : STRING var '::' sigtypedoc { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
933 | var '::' sigtypedoc { LL (noLoc nilFS, $1, $3) }
934 -- if the entity string is missing, it defaults to the empty string;
935 -- the meaning of an empty entity string depends on the calling
938 -----------------------------------------------------------------------------
941 opt_sig :: { Maybe (LHsType RdrName) }
942 : {- empty -} { Nothing }
943 | '::' sigtype { Just $2 }
945 opt_asig :: { Maybe (LHsType RdrName) }
946 : {- empty -} { Nothing }
947 | '::' atype { Just $2 }
949 sigtypes1 :: { [LHsType RdrName] }
951 | sigtype ',' sigtypes1 { $1 : $3 }
953 sigtype :: { LHsType RdrName }
954 : ctype { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
955 -- Wrap an Implicit forall if there isn't one there already
957 sigtypedoc :: { LHsType RdrName }
958 : ctypedoc { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
959 -- Wrap an Implicit forall if there isn't one there already
961 sig_vars :: { Located [Located RdrName] }
962 : sig_vars ',' var { LL ($3 : unLoc $1) }
965 -----------------------------------------------------------------------------
968 infixtype :: { LHsType RdrName }
969 : btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
970 | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
972 infixtypedoc :: { LHsType RdrName }
974 | infixtype docprev { LL $ HsDocTy $1 $2 }
976 gentypedoc :: { LHsType RdrName }
979 | infixtypedoc { $1 }
980 | btype '->' ctypedoc { LL $ HsFunTy $1 $3 }
981 | btypedoc '->' ctypedoc { LL $ HsFunTy $1 $3 }
983 ctypedoc :: { LHsType RdrName }
984 : 'forall' tv_bndrs '.' ctypedoc { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
985 | context '=>' ctypedoc { LL $ mkImplicitHsForAllTy $1 $3 }
986 -- A type of form (context => type) is an *implicit* HsForAllTy
989 strict_mark :: { Located HsBang }
990 : '!' { L1 HsStrict }
991 | '{-# UNPACK' '#-}' '!' { LL HsUnbox }
993 -- A ctype is a for-all type
994 ctype :: { LHsType RdrName }
995 : 'forall' tv_bndrs '.' ctype { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
996 | context '=>' type { LL $ mkImplicitHsForAllTy $1 $3 }
997 -- A type of form (context => type) is an *implicit* HsForAllTy
1000 -- We parse a context as a btype so that we don't get reduce/reduce
1001 -- errors in ctype. The basic problem is that
1003 -- looks so much like a tuple type. We can't tell until we find the =>
1005 -- We have the t1 ~ t2 form here and in gentype, to permit an individual
1006 -- equational constraint without parenthesis.
1007 context :: { LHsContext RdrName }
1008 : btype '~' btype {% checkContext
1009 (LL $ HsPredTy (HsEqualP $1 $3)) }
1010 | btype {% checkContext $1 }
1012 type :: { LHsType RdrName }
1013 : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
1016 gentype :: { LHsType RdrName }
1018 | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
1019 | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
1020 | btype '->' ctype { LL $ HsFunTy $1 $3 }
1021 | btype '~' btype { LL $ HsPredTy (HsEqualP $1 $3) }
1023 btype :: { LHsType RdrName }
1024 : btype atype { LL $ HsAppTy $1 $2 }
1027 btypedoc :: { LHsType RdrName }
1028 : btype atype docprev { LL $ HsDocTy (L (comb2 $1 $2) (HsAppTy $1 $2)) $3 }
1029 | atype docprev { LL $ HsDocTy $1 $2 }
1031 atype :: { LHsType RdrName }
1032 : gtycon { L1 (HsTyVar (unLoc $1)) }
1033 | tyvar { L1 (HsTyVar (unLoc $1)) }
1034 | strict_mark atype { LL (HsBangTy (unLoc $1) $2) }
1035 | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) }
1036 | '(#' comma_types1 '#)' { LL $ HsTupleTy Unboxed $2 }
1037 | '[' ctype ']' { LL $ HsListTy $2 }
1038 | '[:' ctype ':]' { LL $ HsPArrTy $2 }
1039 | '(' ctype ')' { LL $ HsParTy $2 }
1040 | '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) }
1042 | INTEGER { L1 (HsNumTy (getINTEGER $1)) }
1044 -- An inst_type is what occurs in the head of an instance decl
1045 -- e.g. (Foo a, Gaz b) => Wibble a b
1046 -- It's kept as a single type, with a MonoDictTy at the right
1047 -- hand corner, for convenience.
1048 inst_type :: { LHsType RdrName }
1049 : sigtype {% checkInstType $1 }
1051 inst_types1 :: { [LHsType RdrName] }
1052 : inst_type { [$1] }
1053 | inst_type ',' inst_types1 { $1 : $3 }
1055 comma_types0 :: { [LHsType RdrName] }
1056 : comma_types1 { $1 }
1057 | {- empty -} { [] }
1059 comma_types1 :: { [LHsType RdrName] }
1061 | ctype ',' comma_types1 { $1 : $3 }
1063 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1064 : tv_bndr tv_bndrs { $1 : $2 }
1065 | {- empty -} { [] }
1067 tv_bndr :: { LHsTyVarBndr RdrName }
1068 : tyvar { L1 (UserTyVar (unLoc $1)) }
1069 | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2)
1072 fds :: { Located [Located ([RdrName], [RdrName])] }
1073 : {- empty -} { noLoc [] }
1074 | '|' fds1 { LL (reverse (unLoc $2)) }
1076 fds1 :: { Located [Located ([RdrName], [RdrName])] }
1077 : fds1 ',' fd { LL ($3 : unLoc $1) }
1080 fd :: { Located ([RdrName], [RdrName]) }
1081 : varids0 '->' varids0 { L (comb3 $1 $2 $3)
1082 (reverse (unLoc $1), reverse (unLoc $3)) }
1084 varids0 :: { Located [RdrName] }
1085 : {- empty -} { noLoc [] }
1086 | varids0 tyvar { LL (unLoc $2 : unLoc $1) }
1088 -----------------------------------------------------------------------------
1091 kind :: { Located Kind }
1093 | akind '->' kind { LL (mkArrowKind (unLoc $1) (unLoc $3)) }
1095 akind :: { Located Kind }
1096 : '*' { L1 liftedTypeKind }
1097 | '!' { L1 unliftedTypeKind }
1098 | '(' kind ')' { LL (unLoc $2) }
1101 -----------------------------------------------------------------------------
1102 -- Datatype declarations
1104 gadt_constrlist :: { Located [LConDecl RdrName] }
1105 : '{' gadt_constrs '}' { LL (unLoc $2) }
1106 | vocurly gadt_constrs close { $2 }
1108 gadt_constrs :: { Located [LConDecl RdrName] }
1109 : gadt_constrs ';' gadt_constr { LL ($3 : unLoc $1) }
1110 | gadt_constrs ';' { $1 }
1111 | gadt_constr { L1 [$1] }
1113 -- We allow the following forms:
1114 -- C :: Eq a => a -> T a
1115 -- C :: forall a. Eq a => !a -> T a
1116 -- D { x,y :: a } :: T a
1117 -- forall a. Eq a => D { x,y :: a } :: T a
1119 gadt_constr :: { LConDecl RdrName }
1121 { LL (mkGadtDecl $1 $3) }
1122 -- Syntax: Maybe merge the record stuff with the single-case above?
1123 -- (to kill the mostly harmless reduce/reduce error)
1124 -- XXX revisit audreyt
1125 | constr_stuff_record '::' sigtype
1126 { let (con,details) = unLoc $1 in
1127 LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing) }
1129 | forall context '=>' constr_stuff_record '::' sigtype
1130 { let (con,details) = unLoc $4 in
1131 LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6) Nothing ) }
1132 | forall constr_stuff_record '::' sigtype
1133 { let (con,details) = unLoc $2 in
1134 LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4) Nothing) }
1138 constrs :: { Located [LConDecl RdrName] }
1139 : {- empty; a GHC extension -} { noLoc [] }
1140 | maybe_docnext '=' constrs1 { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
1142 constrs1 :: { Located [LConDecl RdrName] }
1143 : constrs1 maybe_docnext '|' maybe_docprev constr { LL (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4) }
1144 | constr { L1 [$1] }
1146 constr :: { LConDecl RdrName }
1147 : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1148 { let (con,details) = unLoc $5 in
1149 L (comb4 $2 $3 $4 $5) (ConDecl con Explicit (unLoc $2) $3 details ResTyH98 ($1 `mplus` $6)) }
1150 | maybe_docnext forall constr_stuff maybe_docprev
1151 { let (con,details) = unLoc $3 in
1152 L (comb2 $2 $3) (ConDecl con Explicit (unLoc $2) (noLoc []) details ResTyH98 ($1 `mplus` $4)) }
1154 forall :: { Located [LHsTyVarBndr RdrName] }
1155 : 'forall' tv_bndrs '.' { LL $2 }
1156 | {- empty -} { noLoc [] }
1158 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1159 -- We parse the constructor declaration
1161 -- as a btype (treating C as a type constructor) and then convert C to be
1162 -- a data constructor. Reason: it might continue like this:
1164 -- in which case C really would be a type constructor. We can't resolve this
1165 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
1166 : btype {% mkPrefixCon $1 [] >>= return.LL }
1167 | oqtycon '{' '}' {% mkRecCon $1 [] >>= return.LL }
1168 | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL }
1169 | btype conop btype { LL ($2, InfixCon $1 $3) }
1171 constr_stuff_record :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1172 : oqtycon '{' '}' {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
1173 | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
1175 fielddecls :: { [([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName))] }
1176 : fielddecl maybe_docnext ',' maybe_docprev fielddecls { addFieldDoc (unLoc $1) $4 : addFieldDocs $5 $2 }
1177 | fielddecl { [unLoc $1] }
1179 fielddecl :: { Located ([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName)) }
1180 : maybe_docnext sig_vars '::' ctype maybe_docprev { L (comb3 $2 $3 $4) (reverse (unLoc $2), $4, $1 `mplus` $5) }
1182 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1183 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1184 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1185 -- We don't allow a context, but that's sorted out by the type checker.
1186 deriving :: { Located (Maybe [LHsType RdrName]) }
1187 : {- empty -} { noLoc Nothing }
1188 | 'deriving' qtycon {% do { let { L loc tv = $2 }
1189 ; p <- checkInstType (L loc (HsTyVar tv))
1190 ; return (LL (Just [p])) } }
1191 | 'deriving' '(' ')' { LL (Just []) }
1192 | 'deriving' '(' inst_types1 ')' { LL (Just $3) }
1193 -- Glasgow extension: allow partial
1194 -- applications in derivings
1196 -----------------------------------------------------------------------------
1197 -- Value definitions
1199 {- There's an awkward overlap with a type signature. Consider
1200 f :: Int -> Int = ...rhs...
1201 Then we can't tell whether it's a type signature or a value
1202 definition with a result signature until we see the '='.
1203 So we have to inline enough to postpone reductions until we know.
1207 ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1208 instead of qvar, we get another shift/reduce-conflict. Consider the
1211 { (^^) :: Int->Int ; } Type signature; only var allowed
1213 { (^^) :: Int->Int = ... ; } Value defn with result signature;
1214 qvar allowed (because of instance decls)
1216 We can't tell whether to reduce var to qvar until after we've read the signatures.
1219 docdecl :: { LHsDecl RdrName }
1220 : docdecld { L1 (DocD (unLoc $1)) }
1222 docdecld :: { LDocDecl RdrName }
1223 : docnext { L1 (DocCommentNext (unLoc $1)) }
1224 | docprev { L1 (DocCommentPrev (unLoc $1)) }
1225 | docnamed { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
1226 | docsection { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
1228 decl :: { Located (OrdList (LHsDecl RdrName)) }
1230 | '!' aexp rhs {% do { pat <- checkPattern $2;
1231 return (LL $ unitOL $ LL $ ValD (
1232 PatBind (LL $ BangPat pat) (unLoc $3)
1233 placeHolderType placeHolderNames)) } }
1234 | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3;
1235 let { l = comb2 $1 $> };
1236 return $! (sL l (unitOL $! (sL l $ ValD r))) } }
1237 | docdecl { LL $ unitOL $1 }
1239 rhs :: { Located (GRHSs RdrName) }
1240 : '=' exp wherebinds { sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
1241 | gdrhs wherebinds { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) }
1243 gdrhs :: { Located [LGRHS RdrName] }
1244 : gdrhs gdrh { LL ($2 : unLoc $1) }
1247 gdrh :: { LGRHS RdrName }
1248 : '|' guardquals '=' exp { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
1250 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
1251 : infixexp '::' sigtypedoc
1252 {% do s <- checkValSig $1 $3;
1253 return (LL $ unitOL (LL $ SigD s)) }
1254 -- See the above notes for why we need infixexp here
1255 | var ',' sig_vars '::' sigtypedoc
1256 { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
1257 | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
1259 | '{-# INLINE' activation qvar '#-}'
1260 { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
1261 | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
1262 { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
1264 | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
1265 { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
1267 | '{-# SPECIALISE' 'instance' inst_type '#-}'
1268 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
1270 -----------------------------------------------------------------------------
1273 exp :: { LHsExpr RdrName }
1274 : infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
1275 | infixexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
1276 | infixexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
1277 | infixexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
1278 | infixexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
1281 infixexp :: { LHsExpr RdrName }
1283 | infixexp qop exp10 { LL (OpApp $1 $2 (panic "fixity") $3) }
1285 exp10 :: { LHsExpr RdrName }
1286 : '\\' apat apats opt_asig '->' exp
1287 { LL $ HsLam (mkMatchGroup [LL $ Match ($2:$3) $4
1290 | 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
1291 | 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 }
1292 | 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
1293 | '-' fexp { LL $ NegApp $2 noSyntaxExpr }
1295 | 'do' stmtlist {% let loc = comb2 $1 $2 in
1296 checkDo loc (unLoc $2) >>= \ (stmts,body) ->
1297 return (L loc (mkHsDo DoExpr stmts body)) }
1298 | 'mdo' stmtlist {% let loc = comb2 $1 $2 in
1299 checkDo loc (unLoc $2) >>= \ (stmts,body) ->
1300 return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
1301 | scc_annot exp { LL $ if opt_SccProfilingOn
1302 then HsSCC (unLoc $1) $2
1304 | hpc_annot exp { LL $ if opt_Hpc
1305 then HsTickPragma (unLoc $1) $2
1308 | 'proc' aexp '->' exp
1309 {% checkPattern $2 >>= \ p ->
1310 return (LL $ HsProc p (LL $ HsCmdTop $4 []
1311 placeHolderType undefined)) }
1312 -- TODO: is LL right here?
1314 | '{-# CORE' STRING '#-}' exp { LL $ HsCoreAnn (getSTRING $2) $4 }
1315 -- hdaume: core annotation
1318 scc_annot :: { Located FastString }
1319 : '_scc_' STRING {% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
1320 ( do scc <- getSCC $2; return $ LL scc ) }
1321 | '{-# SCC' STRING '#-}' {% do scc <- getSCC $2; return $ LL scc }
1323 hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
1324 : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
1325 { LL $ (getSTRING $2
1326 ,( fromInteger $ getINTEGER $3
1327 , fromInteger $ getINTEGER $5
1329 ,( fromInteger $ getINTEGER $7
1330 , fromInteger $ getINTEGER $9
1335 fexp :: { LHsExpr RdrName }
1336 : fexp aexp { LL $ HsApp $1 $2 }
1339 aexp :: { LHsExpr RdrName }
1340 : qvar '@' aexp { LL $ EAsPat $1 $3 }
1341 | '~' aexp { LL $ ELazyPat $2 }
1344 aexp1 :: { LHsExpr RdrName }
1345 : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) $3
1349 -- Here was the syntax for type applications that I was planning
1350 -- but there are difficulties (e.g. what order for type args)
1351 -- so it's not enabled yet.
1352 -- But this case *is* used for the left hand side of a generic definition,
1353 -- which is parsed as an expression before being munged into a pattern
1354 | qcname '{|' gentype '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1355 (sL (getLoc $3) (HsType $3)) }
1357 aexp2 :: { LHsExpr RdrName }
1358 : ipvar { L1 (HsIPVar $! unLoc $1) }
1359 | qcname { L1 (HsVar $! unLoc $1) }
1360 | literal { L1 (HsLit $! unLoc $1) }
1361 -- This will enable overloaded strings permanently. Normally the renamer turns HsString
1362 -- into HsOverLit when -foverloaded-strings is on.
1363 -- | STRING { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRING $1) placeHolderType) }
1364 | INTEGER { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGER $1) placeHolderType) }
1365 | RATIONAL { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) }
1366 -- N.B.: sections get parsed by these next two productions.
1367 -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't correct Haskell98
1368 -- (you'd have to write '((+ 3), (4 -))')
1369 -- but the less cluttered version fell out of having texps.
1370 | '(' texp ')' { LL (HsPar $2) }
1371 | '(' texp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1372 | '(#' texps '#)' { LL $ ExplicitTuple (reverse $2) Unboxed }
1373 | '[' list ']' { LL (unLoc $2) }
1374 | '[:' parr ':]' { LL (unLoc $2) }
1375 | '_' { L1 EWildPat }
1377 -- Template Haskell Extension
1378 | TH_ID_SPLICE { L1 $ HsSpliceE (mkHsSplice
1379 (L1 $ HsVar (mkUnqual varName
1380 (getTH_ID_SPLICE $1)))) } -- $x
1381 | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
1383 | TH_QUASIQUOTE { let { loc = getLoc $1
1384 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
1385 ; quoterId = mkUnqual varName quoter
1387 in sL loc $ HsQuasiQuoteE (mkHsQuasiQuote quoterId quoteSpan quote) }
1388 | TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
1389 | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
1390 | TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
1391 | TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) }
1392 | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
1393 | '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
1394 | '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
1395 return (LL $ HsBracket (PatBr p)) }
1396 | '[d|' cvtopbody '|]' {% checkDecBrGroup $2 >>= \g ->
1397 return (LL $ HsBracket (DecBr g)) }
1399 -- arrow notation extension
1400 | '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
1402 cmdargs :: { [LHsCmdTop RdrName] }
1403 : cmdargs acmd { $2 : $1 }
1404 | {- empty -} { [] }
1406 acmd :: { LHsCmdTop RdrName }
1407 : aexp2 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1409 cvtopbody :: { [LHsDecl RdrName] }
1410 : '{' cvtopdecls0 '}' { $2 }
1411 | vocurly cvtopdecls0 close { $2 }
1413 cvtopdecls0 :: { [LHsDecl RdrName] }
1414 : {- empty -} { [] }
1417 -- tuple expressions: things that can appear unparenthesized as long as they're
1418 -- inside parens or delimitted by commas
1419 texp :: { LHsExpr RdrName }
1421 -- Technically, this should only be used for bang patterns,
1422 -- but we can be a little more liberal here and avoid parens
1424 | infixexp qop { LL $ SectionL $1 $2 }
1425 | qopm infixexp { LL $ SectionR $1 $2 }
1426 -- view patterns get parenthesized above
1427 | exp '->' exp { LL $ EViewPat $1 $3 }
1429 texps :: { [LHsExpr RdrName] }
1430 : texps ',' texp { $3 : $1 }
1434 -----------------------------------------------------------------------------
1437 -- The rules below are little bit contorted to keep lexps left-recursive while
1438 -- avoiding another shift/reduce-conflict.
1440 list :: { LHsExpr RdrName }
1441 : texp { L1 $ ExplicitList placeHolderType [$1] }
1442 | lexps { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1443 | texp '..' { LL $ ArithSeq noPostTcExpr (From $1) }
1444 | texp ',' exp '..' { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
1445 | texp '..' exp { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
1446 | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1447 | texp '|' flattenedpquals { sL (comb2 $1 $>) $ mkHsDo ListComp (unLoc $3) $1 }
1449 lexps :: { Located [LHsExpr RdrName] }
1450 : lexps ',' texp { LL (((:) $! $3) $! unLoc $1) }
1451 | texp ',' texp { LL [$3,$1] }
1453 -----------------------------------------------------------------------------
1454 -- List Comprehensions
1456 flattenedpquals :: { Located [LStmt RdrName] }
1457 : pquals { case (unLoc $1) of
1458 ParStmt [(qs, _)] -> L1 qs
1459 -- We just had one thing in our "parallel" list so
1460 -- we simply return that thing directly
1463 -- We actually found some actual parallel lists so
1464 -- we leave them into as a ParStmt
1467 pquals :: { LStmt RdrName }
1468 : pquals1 { L1 (ParStmt [(qs, undefined) | qs <- (reverse (unLoc $1))]) }
1470 pquals1 :: { Located [[LStmt RdrName]] }
1471 : pquals1 '|' squals { LL (unLoc $3 : unLoc $1) }
1472 | squals { L (getLoc $1) [unLoc $1] }
1474 squals :: { Located [LStmt RdrName] }
1475 : squals1 { L (getLoc $1) (reverse (unLoc $1)) }
1477 squals1 :: { Located [LStmt RdrName] }
1478 : transformquals1 { LL (unLoc $1) }
1480 transformquals1 :: { Located [LStmt RdrName] }
1481 : transformquals1 ',' transformqual { LL $ [LL ((unLoc $3) (unLoc $1))] }
1482 | transformquals1 ',' qual { LL ($3 : unLoc $1) }
1483 -- | transformquals1 ',' '{|' pquals '|}' { LL ($4 : unLoc $1) }
1484 | transformqual { LL $ [LL ((unLoc $1) [])] }
1486 -- | '{|' pquals '|}' { L1 [$2] }
1489 -- It is possible to enable bracketing (associating) qualifier lists by uncommenting the lines with {| |}
1490 -- above. Due to a lack of consensus on the syntax, this feature is not being used until we get user
1491 -- demand. Note that the {| |} symbols are reused from -XGenerics and hence if you want to compile
1492 -- a program that makes use of this temporary syntax you must supply that flag to GHC
1494 transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) }
1495 : 'then' exp { LL $ \leftStmts -> (mkTransformStmt (reverse leftStmts) $2) }
1496 | 'then' exp 'by' exp { LL $ \leftStmts -> (mkTransformByStmt (reverse leftStmts) $2 $4) }
1497 | 'then' 'group' 'by' exp { LL $ \leftStmts -> (mkGroupByStmt (reverse leftStmts) $4) }
1498 | 'then' 'group' 'using' exp { LL $ \leftStmts -> (mkGroupUsingStmt (reverse leftStmts) $4) }
1499 | 'then' 'group' 'by' exp 'using' exp { LL $ \leftStmts -> (mkGroupByUsingStmt (reverse leftStmts) $4 $6) }
1501 -----------------------------------------------------------------------------
1502 -- Parallel array expressions
1504 -- The rules below are little bit contorted; see the list case for details.
1505 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1506 -- Moreover, we allow explicit arrays with no element (represented by the nil
1507 -- constructor in the list case).
1509 parr :: { LHsExpr RdrName }
1510 : { noLoc (ExplicitPArr placeHolderType []) }
1511 | texp { L1 $ ExplicitPArr placeHolderType [$1] }
1512 | lexps { L1 $ ExplicitPArr placeHolderType
1513 (reverse (unLoc $1)) }
1514 | texp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
1515 | texp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1516 | texp '|' flattenedpquals { LL $ mkHsDo PArrComp (unLoc $3) $1 }
1518 -- We are reusing `lexps' and `flattenedpquals' from the list case.
1520 -----------------------------------------------------------------------------
1523 guardquals :: { Located [LStmt RdrName] }
1524 : guardquals1 { L (getLoc $1) (reverse (unLoc $1)) }
1526 guardquals1 :: { Located [LStmt RdrName] }
1527 : guardquals1 ',' qual { LL ($3 : unLoc $1) }
1530 -----------------------------------------------------------------------------
1531 -- Case alternatives
1533 altslist :: { Located [LMatch RdrName] }
1534 : '{' alts '}' { LL (reverse (unLoc $2)) }
1535 | vocurly alts close { L (getLoc $2) (reverse (unLoc $2)) }
1537 alts :: { Located [LMatch RdrName] }
1538 : alts1 { L1 (unLoc $1) }
1539 | ';' alts { LL (unLoc $2) }
1541 alts1 :: { Located [LMatch RdrName] }
1542 : alts1 ';' alt { LL ($3 : unLoc $1) }
1543 | alts1 ';' { LL (unLoc $1) }
1546 alt :: { LMatch RdrName }
1547 : pat opt_sig alt_rhs { LL (Match [$1] $2 (unLoc $3)) }
1549 alt_rhs :: { Located (GRHSs RdrName) }
1550 : ralt wherebinds { LL (GRHSs (unLoc $1) (unLoc $2)) }
1552 ralt :: { Located [LGRHS RdrName] }
1553 : '->' exp { LL (unguardedRHS $2) }
1554 | gdpats { L1 (reverse (unLoc $1)) }
1556 gdpats :: { Located [LGRHS RdrName] }
1557 : gdpats gdpat { LL ($2 : unLoc $1) }
1560 gdpat :: { LGRHS RdrName }
1561 : '|' guardquals '->' exp { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
1563 -- 'pat' recognises a pattern, including one with a bang at the top
1564 -- e.g. "!x" or "!(x,y)" or "C a b" etc
1565 -- Bangs inside are parsed as infix operator applications, so that
1566 -- we parse them right when bang-patterns are off
1567 pat :: { LPat RdrName }
1568 pat : exp {% checkPattern $1 }
1569 | '!' aexp {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1571 apat :: { LPat RdrName }
1572 apat : aexp {% checkPattern $1 }
1573 | '!' aexp {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1575 apats :: { [LPat RdrName] }
1576 : apat apats { $1 : $2 }
1577 | {- empty -} { [] }
1579 -----------------------------------------------------------------------------
1580 -- Statement sequences
1582 stmtlist :: { Located [LStmt RdrName] }
1583 : '{' stmts '}' { LL (unLoc $2) }
1584 | vocurly stmts close { $2 }
1586 -- do { ;; s ; s ; ; s ;; }
1587 -- The last Stmt should be an expression, but that's hard to enforce
1588 -- here, because we need too much lookahead if we see do { e ; }
1589 -- So we use ExprStmts throughout, and switch the last one over
1590 -- in ParseUtils.checkDo instead
1591 stmts :: { Located [LStmt RdrName] }
1592 : stmt stmts_help { LL ($1 : unLoc $2) }
1593 | ';' stmts { LL (unLoc $2) }
1594 | {- empty -} { noLoc [] }
1596 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1597 : ';' stmts { LL (unLoc $2) }
1598 | {- empty -} { noLoc [] }
1600 -- For typing stmts at the GHCi prompt, where
1601 -- the input may consist of just comments.
1602 maybe_stmt :: { Maybe (LStmt RdrName) }
1604 | {- nothing -} { Nothing }
1606 stmt :: { LStmt RdrName }
1608 | 'rec' stmtlist { LL $ mkRecStmt (unLoc $2) }
1610 qual :: { LStmt RdrName }
1611 : pat '<-' exp { LL $ mkBindStmt $1 $3 }
1612 | exp { L1 $ mkExprStmt $1 }
1613 | 'let' binds { LL $ LetStmt (unLoc $2) }
1615 -----------------------------------------------------------------------------
1616 -- Record Field Update/Construction
1618 fbinds :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
1620 | {- empty -} { ([], False) }
1622 fbinds1 :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
1623 : fbind ',' fbinds1 { case $3 of (flds, dd) -> ($1 : flds, dd) }
1624 | fbind { ([$1], False) }
1625 | '..' { ([], True) }
1627 fbind :: { HsRecField RdrName (LHsExpr RdrName) }
1628 : qvar '=' exp { HsRecField $1 $3 False }
1629 | qvar { HsRecField $1 (L (getLoc $1) (HsVar (unLoc $1))) True }
1630 -- Here's where we say that plain 'x'
1631 -- means exactly 'x = x'. The pun-flag boolean is
1632 -- there so we can still print it right
1634 -----------------------------------------------------------------------------
1635 -- Implicit Parameter Bindings
1637 dbinds :: { Located [LIPBind RdrName] }
1638 : dbinds ';' dbind { let { this = $3; rest = unLoc $1 }
1639 in rest `seq` this `seq` LL (this : rest) }
1640 | dbinds ';' { LL (unLoc $1) }
1641 | dbind { let this = $1 in this `seq` L1 [this] }
1642 -- | {- empty -} { [] }
1644 dbind :: { LIPBind RdrName }
1645 dbind : ipvar '=' exp { LL (IPBind (unLoc $1) $3) }
1647 ipvar :: { Located (IPName RdrName) }
1648 : IPDUPVARID { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
1650 -----------------------------------------------------------------------------
1653 depreclist :: { Located [RdrName] }
1654 depreclist : deprec_var { L1 [unLoc $1] }
1655 | deprec_var ',' depreclist { LL (unLoc $1 : unLoc $3) }
1657 deprec_var :: { Located RdrName }
1658 deprec_var : var { $1 }
1661 -----------------------------------------
1662 -- Data constructors
1663 qcon :: { Located RdrName }
1665 | '(' qconsym ')' { LL (unLoc $2) }
1666 | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
1667 -- The case of '[:' ':]' is part of the production `parr'
1669 con :: { Located RdrName }
1671 | '(' consym ')' { LL (unLoc $2) }
1672 | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
1674 sysdcon :: { Located DataCon } -- Wired in data constructors
1675 : '(' ')' { LL unitDataCon }
1676 | '(' commas ')' { LL $ tupleCon Boxed $2 }
1677 | '(#' '#)' { LL $ unboxedSingletonDataCon }
1678 | '(#' commas '#)' { LL $ tupleCon Unboxed $2 }
1679 | '[' ']' { LL nilDataCon }
1681 conop :: { Located RdrName }
1683 | '`' conid '`' { LL (unLoc $2) }
1685 qconop :: { Located RdrName }
1687 | '`' qconid '`' { LL (unLoc $2) }
1689 -----------------------------------------------------------------------------
1690 -- Type constructors
1692 gtycon :: { Located RdrName } -- A "general" qualified tycon
1694 | '(' ')' { LL $ getRdrName unitTyCon }
1695 | '(' commas ')' { LL $ getRdrName (tupleTyCon Boxed $2) }
1696 | '(#' '#)' { LL $ getRdrName unboxedSingletonTyCon }
1697 | '(#' commas '#)' { LL $ getRdrName (tupleTyCon Unboxed $2) }
1698 | '(' '->' ')' { LL $ getRdrName funTyCon }
1699 | '[' ']' { LL $ listTyCon_RDR }
1700 | '[:' ':]' { LL $ parrTyCon_RDR }
1702 oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon
1704 | '(' qtyconsym ')' { LL (unLoc $2) }
1706 qtyconop :: { Located RdrName } -- Qualified or unqualified
1708 | '`' qtycon '`' { LL (unLoc $2) }
1710 qtycon :: { Located RdrName } -- Qualified or unqualified
1711 : QCONID { L1 $! mkQual tcClsName (getQCONID $1) }
1714 tycon :: { Located RdrName } -- Unqualified
1715 : CONID { L1 $! mkUnqual tcClsName (getCONID $1) }
1717 qtyconsym :: { Located RdrName }
1718 : QCONSYM { L1 $! mkQual tcClsName (getQCONSYM $1) }
1721 tyconsym :: { Located RdrName }
1722 : CONSYM { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1724 -----------------------------------------------------------------------------
1727 op :: { Located RdrName } -- used in infix decls
1731 varop :: { Located RdrName }
1733 | '`' varid '`' { LL (unLoc $2) }
1735 qop :: { LHsExpr RdrName } -- used in sections
1736 : qvarop { L1 $ HsVar (unLoc $1) }
1737 | qconop { L1 $ HsVar (unLoc $1) }
1739 qopm :: { LHsExpr RdrName } -- used in sections
1740 : qvaropm { L1 $ HsVar (unLoc $1) }
1741 | qconop { L1 $ HsVar (unLoc $1) }
1743 qvarop :: { Located RdrName }
1745 | '`' qvarid '`' { LL (unLoc $2) }
1747 qvaropm :: { Located RdrName }
1748 : qvarsym_no_minus { $1 }
1749 | '`' qvarid '`' { LL (unLoc $2) }
1751 -----------------------------------------------------------------------------
1754 tyvar :: { Located RdrName }
1755 tyvar : tyvarid { $1 }
1756 | '(' tyvarsym ')' { LL (unLoc $2) }
1758 tyvarop :: { Located RdrName }
1759 tyvarop : '`' tyvarid '`' { LL (unLoc $2) }
1762 tyvarid :: { Located RdrName }
1763 : VARID { L1 $! mkUnqual tvName (getVARID $1) }
1764 | special_id { L1 $! mkUnqual tvName (unLoc $1) }
1765 | 'unsafe' { L1 $! mkUnqual tvName (fsLit "unsafe") }
1766 | 'safe' { L1 $! mkUnqual tvName (fsLit "safe") }
1767 | 'threadsafe' { L1 $! mkUnqual tvName (fsLit "threadsafe") }
1769 tyvarsym :: { Located RdrName }
1770 -- Does not include "!", because that is used for strictness marks
1771 -- or ".", because that separates the quantified type vars from the rest
1772 -- or "*", because that's used for kinds
1773 tyvarsym : VARSYM { L1 $! mkUnqual tvName (getVARSYM $1) }
1775 -----------------------------------------------------------------------------
1778 var :: { Located RdrName }
1780 | '(' varsym ')' { LL (unLoc $2) }
1782 qvar :: { Located RdrName }
1784 | '(' varsym ')' { LL (unLoc $2) }
1785 | '(' qvarsym1 ')' { LL (unLoc $2) }
1786 -- We've inlined qvarsym here so that the decision about
1787 -- whether it's a qvar or a var can be postponed until
1788 -- *after* we see the close paren.
1790 qvarid :: { Located RdrName }
1792 | QVARID { L1 $ mkQual varName (getQVARID $1) }
1794 varid :: { Located RdrName }
1795 : varid_no_unsafe { $1 }
1796 | 'unsafe' { L1 $! mkUnqual varName (fsLit "unsafe") }
1797 | 'safe' { L1 $! mkUnqual varName (fsLit "safe") }
1798 | 'threadsafe' { L1 $! mkUnqual varName (fsLit "threadsafe") }
1800 varid_no_unsafe :: { Located RdrName }
1801 : VARID { L1 $! mkUnqual varName (getVARID $1) }
1802 | special_id { L1 $! mkUnqual varName (unLoc $1) }
1803 | 'forall' { L1 $! mkUnqual varName (fsLit "forall") }
1804 | 'family' { L1 $! mkUnqual varName (fsLit "family") }
1806 qvarsym :: { Located RdrName }
1810 qvarsym_no_minus :: { Located RdrName }
1811 : varsym_no_minus { $1 }
1814 qvarsym1 :: { Located RdrName }
1815 qvarsym1 : QVARSYM { L1 $ mkQual varName (getQVARSYM $1) }
1817 varsym :: { Located RdrName }
1818 : varsym_no_minus { $1 }
1819 | '-' { L1 $ mkUnqual varName (fsLit "-") }
1821 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1822 : VARSYM { L1 $ mkUnqual varName (getVARSYM $1) }
1823 | special_sym { L1 $ mkUnqual varName (unLoc $1) }
1826 -- These special_ids are treated as keywords in various places,
1827 -- but as ordinary ids elsewhere. 'special_id' collects all these
1828 -- except 'unsafe', 'forall', and 'family' whose treatment differs
1829 -- depending on context
1830 special_id :: { Located FastString }
1832 : 'as' { L1 (fsLit "as") }
1833 | 'qualified' { L1 (fsLit "qualified") }
1834 | 'hiding' { L1 (fsLit "hiding") }
1835 | 'export' { L1 (fsLit "export") }
1836 | 'label' { L1 (fsLit "label") }
1837 | 'dynamic' { L1 (fsLit "dynamic") }
1838 | 'stdcall' { L1 (fsLit "stdcall") }
1839 | 'ccall' { L1 (fsLit "ccall") }
1841 special_sym :: { Located FastString }
1842 special_sym : '!' { L1 (fsLit "!") }
1843 | '.' { L1 (fsLit ".") }
1844 | '*' { L1 (fsLit "*") }
1846 -----------------------------------------------------------------------------
1847 -- Data constructors
1849 qconid :: { Located RdrName } -- Qualified or unqualified
1851 | QCONID { L1 $ mkQual dataName (getQCONID $1) }
1853 conid :: { Located RdrName }
1854 : CONID { L1 $ mkUnqual dataName (getCONID $1) }
1856 qconsym :: { Located RdrName } -- Qualified or unqualified
1858 | QCONSYM { L1 $ mkQual dataName (getQCONSYM $1) }
1860 consym :: { Located RdrName }
1861 : CONSYM { L1 $ mkUnqual dataName (getCONSYM $1) }
1863 -- ':' means only list cons
1864 | ':' { L1 $ consDataCon_RDR }
1867 -----------------------------------------------------------------------------
1870 literal :: { Located HsLit }
1871 : CHAR { L1 $ HsChar $ getCHAR $1 }
1872 | STRING { L1 $ HsString $ getSTRING $1 }
1873 | PRIMINTEGER { L1 $ HsIntPrim $ getPRIMINTEGER $1 }
1874 | PRIMWORD { L1 $ HsWordPrim $ getPRIMWORD $1 }
1875 | PRIMCHAR { L1 $ HsCharPrim $ getPRIMCHAR $1 }
1876 | PRIMSTRING { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1877 | PRIMFLOAT { L1 $ HsFloatPrim $ getPRIMFLOAT $1 }
1878 | PRIMDOUBLE { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1880 -----------------------------------------------------------------------------
1884 : vccurly { () } -- context popped in lexer.
1885 | error {% popContext }
1887 -----------------------------------------------------------------------------
1888 -- Miscellaneous (mostly renamings)
1890 modid :: { Located ModuleName }
1891 : CONID { L1 $ mkModuleNameFS (getCONID $1) }
1892 | QCONID { L1 $ let (mod,c) = getQCONID $1 in
1895 (unpackFS mod ++ '.':unpackFS c))
1899 : commas ',' { $1 + 1 }
1902 -----------------------------------------------------------------------------
1903 -- Documentation comments
1905 docnext :: { LHsDoc RdrName }
1906 : DOCNEXT {% case parseHaddockParagraphs (tokenise (getDOCNEXT $1)) of {
1907 MyLeft err -> parseError (getLoc $1) err;
1908 MyRight doc -> return (L1 doc) } }
1910 docprev :: { LHsDoc RdrName }
1911 : DOCPREV {% case parseHaddockParagraphs (tokenise (getDOCPREV $1)) of {
1912 MyLeft err -> parseError (getLoc $1) err;
1913 MyRight doc -> return (L1 doc) } }
1915 docnamed :: { Located (String, (HsDoc RdrName)) }
1917 let string = getDOCNAMED $1
1918 (name, rest) = break isSpace string
1919 in case parseHaddockParagraphs (tokenise rest) of {
1920 MyLeft err -> parseError (getLoc $1) err;
1921 MyRight doc -> return (L1 (name, doc)) } }
1923 docsection :: { Located (Int, HsDoc RdrName) }
1924 : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
1925 case parseHaddockString (tokenise doc) of {
1926 MyLeft err -> parseError (getLoc $1) err;
1927 MyRight doc -> return (L1 (n, doc)) } }
1929 moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
1930 : DOCNEXT {% let string = getDOCNEXT $1 in
1931 case parseModuleHeader string of {
1932 Right (str, info) ->
1933 case parseHaddockParagraphs (tokenise str) of {
1934 MyLeft err -> parseError (getLoc $1) err;
1935 MyRight doc -> return (info, Just doc);
1937 Left err -> parseError (getLoc $1) err
1940 maybe_docprev :: { Maybe (LHsDoc RdrName) }
1941 : docprev { Just $1 }
1942 | {- empty -} { Nothing }
1944 maybe_docnext :: { Maybe (LHsDoc RdrName) }
1945 : docnext { Just $1 }
1946 | {- empty -} { Nothing }
1950 happyError = srcParseFail
1952 getVARID (L _ (ITvarid x)) = x
1953 getCONID (L _ (ITconid x)) = x
1954 getVARSYM (L _ (ITvarsym x)) = x
1955 getCONSYM (L _ (ITconsym x)) = x
1956 getQVARID (L _ (ITqvarid x)) = x
1957 getQCONID (L _ (ITqconid x)) = x
1958 getQVARSYM (L _ (ITqvarsym x)) = x
1959 getQCONSYM (L _ (ITqconsym x)) = x
1960 getIPDUPVARID (L _ (ITdupipvarid x)) = x
1961 getCHAR (L _ (ITchar x)) = x
1962 getSTRING (L _ (ITstring x)) = x
1963 getINTEGER (L _ (ITinteger x)) = x
1964 getRATIONAL (L _ (ITrational x)) = x
1965 getPRIMCHAR (L _ (ITprimchar x)) = x
1966 getPRIMSTRING (L _ (ITprimstring x)) = x
1967 getPRIMINTEGER (L _ (ITprimint x)) = x
1968 getPRIMWORD (L _ (ITprimword x)) = x
1969 getPRIMFLOAT (L _ (ITprimfloat x)) = x
1970 getPRIMDOUBLE (L _ (ITprimdouble x)) = x
1971 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1972 getINLINE (L _ (ITinline_prag b)) = b
1973 getSPEC_INLINE (L _ (ITspec_inline_prag b)) = b
1975 getDOCNEXT (L _ (ITdocCommentNext x)) = x
1976 getDOCPREV (L _ (ITdocCommentPrev x)) = x
1977 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
1978 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
1980 getSCC :: Located Token -> P FastString
1981 getSCC lt = do let s = getSTRING lt
1982 err = "Spaces are not allowed in SCCs"
1983 -- We probably actually want to be more restrictive than this
1984 if ' ' `elem` unpackFS s
1985 then failSpanMsgP (getLoc lt) (text err)
1988 -- Utilities for combining source spans
1989 comb2 :: Located a -> Located b -> SrcSpan
1990 comb2 a b = a `seq` b `seq` combineLocs a b
1992 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1993 comb3 a b c = a `seq` b `seq` c `seq`
1994 combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1996 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1997 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
1998 (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1999 combineSrcSpans (getLoc c) (getLoc d))
2001 -- strict constructor version:
2003 sL :: SrcSpan -> a -> Located a
2004 sL span a = span `seq` a `seq` L span a
2006 -- Make a source location for the file. We're a bit lazy here and just
2007 -- make a point SrcSpan at line 1, column 0. Strictly speaking we should
2008 -- try to find the span of the whole file (ToDo).
2009 fileSrcSpan :: P SrcSpan
2012 let loc = mkSrcLoc (srcLocFile l) 1 0;
2013 return (mkSrcSpan loc loc)