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 )
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 ( when )
50 import Control.Monad ( mplus )
54 -----------------------------------------------------------------------------
57 Conflicts: 37 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 -----------------------------------------------------------------------------
66 Conflicts: 38 shift/reduce (1.25)
68 10 for abiguity in 'if x then y else z + 1' [State 178]
69 (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
70 10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
72 1 for ambiguity in 'if x then y else z :: T' [State 178]
73 (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
75 4 for ambiguity in 'if x then y else z -< e' [State 178]
76 (shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
77 There are four such operators: -<, >-, -<<, >>-
80 2 for ambiguity in 'case v of { x :: T -> T ... } ' [States 11, 253]
81 Which of these two is intended?
83 (x::T) -> T -- Rhs is T
86 (x::T -> T) -> .. -- Rhs is ...
88 10 for ambiguity in 'e :: a `b` c'. Does this mean [States 11, 253]
91 As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases
92 Same duplication between states 11 and 253 as the previous case
94 1 for ambiguity in 'let ?x ...' [State 329]
95 the parser can't tell whether the ?x is the lhs of a normal binding or
96 an implicit binding. Fortunately resolving as shift gives it the only
97 sensible meaning, namely the lhs of an implicit binding.
99 1 for ambiguity in '{-# RULES "name" [ ... #-} [State 382]
100 we don't know whether the '[' starts the activation or not: it
101 might be the start of the declaration with the activation being
102 empty. --SDM 1/4/2002
104 1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 474]
105 since 'forall' is a valid variable name, we don't know whether
106 to treat a forall on the input as the beginning of a quantifier
107 or the beginning of the rule itself. Resolving to shift means
108 it's always treated as a quantifier, hence the above is disallowed.
109 This saves explicitly defining a grammar for the rule lhs that
110 doesn't include 'forall'.
112 1 for ambiguity when the source file starts with "-- | doc". We need another
113 token of lookahead to determine if a top declaration or the 'module' keyword
114 follows. Shift parses as if the 'module' keyword follows.
116 -- ---------------------------------------------------------------------------
117 -- Adding location info
119 This is done in a stylised way using the three macros below, L0, L1
120 and LL. Each of these macros can be thought of as having type
122 L0, L1, LL :: a -> Located a
124 They each add a SrcSpan to their argument.
126 L0 adds 'noSrcSpan', used for empty productions
127 -- This doesn't seem to work anymore -=chak
129 L1 for a production with a single token on the lhs. Grabs the SrcSpan
132 LL for a production with >1 token on the lhs. Makes up a SrcSpan from
133 the first and last tokens.
135 These suffice for the majority of cases. However, we must be
136 especially careful with empty productions: LL won't work if the first
137 or last token on the lhs can represent an empty span. In these cases,
138 we have to calculate the span using more of the tokens from the lhs, eg.
140 | 'newtype' tycl_hdr '=' newconstr deriving
142 (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
144 We provide comb3 and comb4 functions which are useful in such cases.
146 Be careful: there's no checking that you actually got this right, the
147 only symptom will be that the SrcSpans of your syntax will be
151 * We must expand these macros *before* running Happy, which is why this file is
152 * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
154 #define L0 L noSrcSpan
155 #define L1 sL (getLoc $1)
156 #define LL sL (comb2 $1 $>)
158 -- -----------------------------------------------------------------------------
163 '_' { L _ ITunderscore } -- Haskell keywords
165 'case' { L _ ITcase }
166 'class' { L _ ITclass }
167 'data' { L _ ITdata }
168 'default' { L _ ITdefault }
169 'deriving' { L _ ITderiving }
171 'else' { L _ ITelse }
173 'hiding' { L _ IThiding }
175 'import' { L _ ITimport }
177 'infix' { L _ ITinfix }
178 'infixl' { L _ ITinfixl }
179 'infixr' { L _ ITinfixr }
180 'instance' { L _ ITinstance }
182 'module' { L _ ITmodule }
183 'newtype' { L _ ITnewtype }
185 'qualified' { L _ ITqualified }
186 'then' { L _ ITthen }
187 'type' { L _ ITtype }
188 'where' { L _ ITwhere }
189 '_scc_' { L _ ITscc } -- ToDo: remove
191 'forall' { L _ ITforall } -- GHC extension keywords
192 'foreign' { L _ ITforeign }
193 'export' { L _ ITexport }
194 'label' { L _ ITlabel }
195 'dynamic' { L _ ITdynamic }
196 'safe' { L _ ITsafe }
197 'threadsafe' { L _ ITthreadsafe }
198 'unsafe' { L _ ITunsafe }
201 'family' { L _ ITfamily }
202 'stdcall' { L _ ITstdcallconv }
203 'ccall' { L _ ITccallconv }
204 'dotnet' { L _ ITdotnet }
205 'proc' { L _ ITproc } -- for arrow notation extension
206 'rec' { L _ ITrec } -- for arrow notation extension
208 '{-# INLINE' { L _ (ITinline_prag _) }
209 '{-# SPECIALISE' { L _ ITspec_prag }
210 '{-# SPECIALISE_INLINE' { L _ (ITspec_inline_prag _) }
211 '{-# SOURCE' { L _ ITsource_prag }
212 '{-# RULES' { L _ ITrules_prag }
213 '{-# CORE' { L _ ITcore_prag } -- hdaume: annotated core
214 '{-# SCC' { L _ ITscc_prag }
215 '{-# DEPRECATED' { L _ ITdeprecated_prag }
216 '{-# UNPACK' { L _ ITunpack_prag }
217 '#-}' { L _ ITclose_prag }
219 '..' { L _ ITdotdot } -- reserved symbols
221 '::' { L _ ITdcolon }
225 '<-' { L _ ITlarrow }
226 '->' { L _ ITrarrow }
229 '=>' { L _ ITdarrow }
233 '-<' { L _ ITlarrowtail } -- for arrow notation
234 '>-' { L _ ITrarrowtail } -- for arrow notation
235 '-<<' { L _ ITLarrowtail } -- for arrow notation
236 '>>-' { L _ ITRarrowtail } -- for arrow notation
239 '{' { L _ ITocurly } -- special symbols
241 '{|' { L _ ITocurlybar }
242 '|}' { L _ ITccurlybar }
243 vocurly { L _ ITvocurly } -- virtual open curly (from layout)
244 vccurly { L _ ITvccurly } -- virtual close curly (from layout)
247 '[:' { L _ ITopabrack }
248 ':]' { L _ ITcpabrack }
251 '(#' { L _ IToubxparen }
252 '#)' { L _ ITcubxparen }
253 '(|' { L _ IToparenbar }
254 '|)' { L _ ITcparenbar }
257 '`' { L _ ITbackquote }
259 VARID { L _ (ITvarid _) } -- identifiers
260 CONID { L _ (ITconid _) }
261 VARSYM { L _ (ITvarsym _) }
262 CONSYM { L _ (ITconsym _) }
263 QVARID { L _ (ITqvarid _) }
264 QCONID { L _ (ITqconid _) }
265 QVARSYM { L _ (ITqvarsym _) }
266 QCONSYM { L _ (ITqconsym _) }
268 IPDUPVARID { L _ (ITdupipvarid _) } -- GHC extension
270 CHAR { L _ (ITchar _) }
271 STRING { L _ (ITstring _) }
272 INTEGER { L _ (ITinteger _) }
273 RATIONAL { L _ (ITrational _) }
275 PRIMCHAR { L _ (ITprimchar _) }
276 PRIMSTRING { L _ (ITprimstring _) }
277 PRIMINTEGER { L _ (ITprimint _) }
278 PRIMFLOAT { L _ (ITprimfloat _) }
279 PRIMDOUBLE { L _ (ITprimdouble _) }
281 DOCNEXT { L _ (ITdocCommentNext _) }
282 DOCPREV { L _ (ITdocCommentPrev _) }
283 DOCNAMED { L _ (ITdocCommentNamed _) }
284 DOCSECTION { L _ (ITdocSection _ _) }
285 DOCOPTIONS { L _ (ITdocOptions _) }
288 '[|' { L _ ITopenExpQuote }
289 '[p|' { L _ ITopenPatQuote }
290 '[t|' { L _ ITopenTypQuote }
291 '[d|' { L _ ITopenDecQuote }
292 '|]' { L _ ITcloseQuote }
293 TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
294 '$(' { L _ ITparenEscape } -- $( exp )
295 TH_VAR_QUOTE { L _ ITvarQuote } -- 'x
296 TH_TY_QUOTE { L _ ITtyQuote } -- ''T
298 %monad { P } { >>= } { return }
299 %lexer { lexer } { L _ ITeof }
300 %name parseModule module
301 %name parseStmt maybe_stmt
302 %name parseIdentifier identifier
303 %name parseType ctype
304 %partial parseHeader header
305 %tokentype { (Located Token) }
308 -----------------------------------------------------------------------------
309 -- Identifiers; one of the entry points
310 identifier :: { Located RdrName }
316 -----------------------------------------------------------------------------
319 -- The place for module deprecation is really too restrictive, but if it
320 -- was allowed at its natural place just before 'module', we get an ugly
321 -- s/r conflict with the second alternative. Another solution would be the
322 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
323 -- either, and DEPRECATED is only expected to be used by people who really
324 -- know what they are doing. :-)
326 module :: { Located (HsModule RdrName) }
327 : optdoc 'module' modid maybemoddeprec maybeexports 'where' body
328 {% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) ->
329 return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
331 | missing_module_keyword top close
332 {% fileSrcSpan >>= \ loc ->
333 return (L loc (HsModule Nothing Nothing
334 (fst $2) (snd $2) Nothing Nothing emptyHaddockModInfo
337 optdoc :: { (Maybe String, HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
338 : moduleheader { (Nothing, fst $1, snd $1) }
339 | docoptions { (Just $1, emptyHaddockModInfo, Nothing)}
340 | docoptions moduleheader { (Just $1, fst $2, snd $2) }
341 | moduleheader docoptions { (Just $2, fst $1, snd $1) }
342 | {- empty -} { (Nothing, emptyHaddockModInfo, Nothing) }
344 missing_module_keyword :: { () }
345 : {- empty -} {% pushCurrentContext }
347 maybemoddeprec :: { Maybe DeprecTxt }
348 : '{-# DEPRECATED' STRING '#-}' { Just (getSTRING $2) }
349 | {- empty -} { Nothing }
351 body :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
353 | vocurly top close { $2 }
355 top :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
356 : importdecls { (reverse $1,[]) }
357 | importdecls ';' cvtopdecls { (reverse $1,$3) }
358 | cvtopdecls { ([],$1) }
360 cvtopdecls :: { [LHsDecl RdrName] }
361 : topdecls { cvTopDecls $1 }
363 -----------------------------------------------------------------------------
364 -- Module declaration & imports only
366 header :: { Located (HsModule RdrName) }
367 : optdoc 'module' modid maybemoddeprec maybeexports 'where' header_body
368 {% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) ->
369 return (L loc (HsModule (Just $3) $5 $7 [] $4
371 | missing_module_keyword importdecls
372 {% fileSrcSpan >>= \ loc ->
373 return (L loc (HsModule Nothing Nothing $2 [] Nothing
374 Nothing emptyHaddockModInfo Nothing)) }
376 header_body :: { [LImportDecl RdrName] }
377 : '{' importdecls { $2 }
378 | vocurly importdecls { $2 }
380 -----------------------------------------------------------------------------
383 maybeexports :: { Maybe [LIE RdrName] }
384 : '(' exportlist ')' { Just $2 }
385 | {- empty -} { Nothing }
387 exportlist :: { [LIE RdrName] }
388 : expdoclist ',' expdoclist { $1 ++ $3 }
391 exportlist1 :: { [LIE RdrName] }
392 : expdoclist export expdoclist ',' exportlist { $1 ++ ($2 : $3) ++ $5 }
393 | expdoclist export expdoclist { $1 ++ ($2 : $3) }
396 expdoclist :: { [LIE RdrName] }
397 : exp_doc expdoclist { $1 : $2 }
400 exp_doc :: { LIE RdrName }
401 : docsection { L1 (case (unLoc $1) of (n, doc) -> IEGroup n doc) }
402 | docnamed { L1 (IEDocNamed ((fst . unLoc) $1)) }
403 | docnext { L1 (IEDoc (unLoc $1)) }
405 -- No longer allow things like [] and (,,,) to be exported
406 -- They are built in syntax, always available
407 export :: { LIE RdrName }
408 : qvar { L1 (IEVar (unLoc $1)) }
409 | oqtycon { L1 (IEThingAbs (unLoc $1)) }
410 | oqtycon '(' '..' ')' { LL (IEThingAll (unLoc $1)) }
411 | oqtycon '(' ')' { LL (IEThingWith (unLoc $1) []) }
412 | oqtycon '(' qcnames ')' { LL (IEThingWith (unLoc $1) (reverse $3)) }
413 | 'module' modid { LL (IEModuleContents (unLoc $2)) }
415 qcnames :: { [RdrName] }
416 : qcnames ',' qcname_ext { unLoc $3 : $1 }
417 | qcname_ext { [unLoc $1] }
419 qcname_ext :: { Located RdrName } -- Variable or data constructor
420 -- or tagged type constructor
422 | 'type' qcon { sL (comb2 $1 $2)
423 (setRdrNameSpace (unLoc $2)
426 -- Cannot pull into qcname_ext, as qcname is also used in expression.
427 qcname :: { Located RdrName } -- Variable or data constructor
431 -----------------------------------------------------------------------------
432 -- Import Declarations
434 -- import decls can be *empty*, or even just a string of semicolons
435 -- whereas topdecls must contain at least one topdecl.
437 importdecls :: { [LImportDecl RdrName] }
438 : importdecls ';' importdecl { $3 : $1 }
439 | importdecls ';' { $1 }
440 | importdecl { [ $1 ] }
443 importdecl :: { LImportDecl RdrName }
444 : 'import' maybe_src optqualified modid maybeas maybeimpspec
445 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
447 maybe_src :: { IsBootInterface }
448 : '{-# SOURCE' '#-}' { True }
449 | {- empty -} { False }
451 optqualified :: { Bool }
452 : 'qualified' { True }
453 | {- empty -} { False }
455 maybeas :: { Located (Maybe ModuleName) }
456 : 'as' modid { LL (Just (unLoc $2)) }
457 | {- empty -} { noLoc Nothing }
459 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
460 : impspec { L1 (Just (unLoc $1)) }
461 | {- empty -} { noLoc Nothing }
463 impspec :: { Located (Bool, [LIE RdrName]) }
464 : '(' exportlist ')' { LL (False, $2) }
465 | 'hiding' '(' exportlist ')' { LL (True, $3) }
467 -----------------------------------------------------------------------------
468 -- Fixity Declarations
472 | INTEGER {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
474 infix :: { Located FixityDirection }
475 : 'infix' { L1 InfixN }
476 | 'infixl' { L1 InfixL }
477 | 'infixr' { L1 InfixR }
479 ops :: { Located [Located RdrName] }
480 : ops ',' op { LL ($3 : unLoc $1) }
483 -----------------------------------------------------------------------------
484 -- Top-Level Declarations
486 topdecls :: { OrdList (LHsDecl RdrName) }
487 : topdecls ';' topdecl { $1 `appOL` $3 }
488 | topdecls ';' { $1 }
491 topdecl :: { OrdList (LHsDecl RdrName) }
492 : cl_decl { unitOL (L1 (TyClD (unLoc $1))) }
493 | ty_decl { unitOL (L1 (TyClD (unLoc $1))) }
494 | 'instance' inst_type where
495 { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
496 in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs ats))) }
497 | stand_alone_deriving { unitOL (LL (DerivD (unLoc $1))) }
498 | 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
499 | 'foreign' fdecl { unitOL (LL (unLoc $2)) }
500 | '{-# DEPRECATED' deprecations '#-}' { $2 }
501 | '{-# RULES' rules '#-}' { $2 }
504 -- Template Haskell Extension
505 | '$(' exp ')' { unitOL (LL $ SpliceD (SpliceDecl $2)) }
506 | TH_ID_SPLICE { unitOL (LL $ SpliceD (SpliceDecl $
507 L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
512 cl_decl :: { LTyClDecl RdrName }
513 : 'class' tycl_hdr fds where
514 {% do { let { (binds, sigs, ats, docs) =
515 cvBindsAndSigs (unLoc $4)
516 ; (ctxt, tc, tvs, tparms) = unLoc $2}
517 ; checkTyVars tparms -- only type vars allowed
519 ; return $ L (comb4 $1 $2 $3 $4)
520 (mkClassDecl (ctxt, tc, tvs)
521 (unLoc $3) sigs binds ats docs) } }
523 -- Type declarations (toplevel)
525 ty_decl :: { LTyClDecl RdrName }
526 -- ordinary type synonyms
527 : 'type' type '=' ctype
528 -- Note ctype, not sigtype, on the right of '='
529 -- We allow an explicit for-all but we don't insert one
530 -- in type Foo a = (b,b)
531 -- Instead we just say b is out of scope
533 -- Note the use of type for the head; this allows
534 -- infix type constructors to be declared
535 {% do { (tc, tvs, _) <- checkSynHdr $2 False
536 ; return (L (comb2 $1 $4)
537 (TySynonym tc tvs Nothing $4))
540 -- type family declarations
541 | 'type' 'family' type opt_kind_sig
542 -- Note the use of type for the head; this allows
543 -- infix type constructors to be declared
545 {% do { (tc, tvs, _) <- checkSynHdr $3 False
546 ; let kind = case unLoc $4 of
547 Nothing -> liftedTypeKind
549 ; return (L (comb3 $1 $3 $4)
550 (TyFunction tc tvs False kind))
553 -- type instance declarations
554 | 'type' 'instance' type '=' ctype
555 -- Note the use of type for the head; this allows
556 -- infix type constructors and type patterns
558 {% do { (tc, tvs, typats) <- checkSynHdr $3 True
559 ; return (L (comb2 $1 $5)
560 (TySynonym tc tvs (Just typats) $5))
563 -- ordinary data type or newtype declaration
564 | data_or_newtype tycl_hdr constrs deriving
565 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
566 ; checkTyVars tparms -- no type pattern
568 L (comb4 $1 $2 $3 $4)
569 -- We need the location on tycl_hdr in case
570 -- constrs and deriving are both empty
571 (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
572 Nothing (reverse (unLoc $3)) (unLoc $4)) } }
574 -- ordinary GADT declaration
575 | data_or_newtype tycl_hdr opt_kind_sig
576 'where' gadt_constrlist
578 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
579 ; checkTyVars tparms -- can have type pats
581 L (comb4 $1 $2 $4 $5)
582 (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
583 (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
585 -- data/newtype family
586 | data_or_newtype 'family' tycl_hdr opt_kind_sig
587 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
588 ; checkTyVars tparms -- no type pattern
589 ; let kind = case unLoc $4 of
590 Nothing -> liftedTypeKind
594 (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
595 (Just kind) [] Nothing) } }
597 -- data/newtype instance declaration
598 | data_or_newtype 'instance' tycl_hdr constrs deriving
599 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
600 -- can have type pats
602 L (comb4 $1 $3 $4 $5)
603 -- We need the location on tycl_hdr in case
604 -- constrs and deriving are both empty
605 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
606 Nothing (reverse (unLoc $4)) (unLoc $5)) } }
608 -- GADT instance declaration
609 | data_or_newtype 'instance' tycl_hdr opt_kind_sig
610 'where' gadt_constrlist
612 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
613 -- can have type pats
615 L (comb4 $1 $3 $6 $7)
616 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
617 (unLoc $4) (reverse (unLoc $6)) (unLoc $7)) } }
619 -- Associate type declarations
621 at_decl :: { LTyClDecl RdrName }
622 -- type family declarations
623 : 'type' type opt_kind_sig
624 -- Note the use of type for the head; this allows
625 -- infix type constructors to be declared
627 {% do { (tc, tvs, _) <- checkSynHdr $2 False
628 ; let kind = case unLoc $3 of
629 Nothing -> liftedTypeKind
631 ; return (L (comb3 $1 $2 $3)
632 (TyFunction tc tvs False kind))
635 -- type instance declarations
636 | 'type' type '=' ctype
637 -- Note the use of type for the head; this allows
638 -- infix type constructors and type patterns
640 {% do { (tc, tvs, typats) <- checkSynHdr $2 True
641 ; return (L (comb2 $1 $4)
642 (TySynonym tc tvs (Just typats) $4))
645 -- data/newtype family
646 | data_or_newtype tycl_hdr '::' kind
647 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
648 ; checkTyVars tparms -- no type pattern
651 (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
652 (Just (unLoc $4)) [] Nothing) } }
654 -- data/newtype instance declaration
655 | data_or_newtype tycl_hdr constrs deriving
656 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
657 -- can have type pats
659 L (comb4 $1 $2 $3 $4)
660 -- We need the location on tycl_hdr in case
661 -- constrs and deriving are both empty
662 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
663 Nothing (reverse (unLoc $3)) (unLoc $4)) } }
665 -- GADT instance declaration
666 | data_or_newtype tycl_hdr opt_kind_sig
667 'where' gadt_constrlist
669 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
670 -- can have type pats
672 L (comb4 $1 $2 $5 $6)
673 (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
674 (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
680 data_or_newtype :: { Located NewOrData }
681 : 'data' { L1 DataType }
682 | 'newtype' { L1 NewType }
684 opt_kind_sig :: { Located (Maybe Kind) }
686 | '::' kind { LL (Just (unLoc $2)) }
688 -- tycl_hdr parses the header of a class or data type decl,
689 -- which takes the form
692 -- (Eq a, Ord b) => T a b
693 -- T Int [a] -- for associated types
694 -- Rather a lot of inlining here, else we get reduce/reduce errors
695 tycl_hdr :: { Located (LHsContext RdrName,
697 [LHsTyVarBndr RdrName],
699 : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
700 | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
702 -----------------------------------------------------------------------------
703 -- Stand-alone deriving
705 -- Glasgow extension: stand-alone deriving declarations
706 stand_alone_deriving :: { LDerivDecl RdrName }
707 : 'deriving' qtycon 'for' qtycon {% do { p <- checkInstType (fmap HsTyVar $2)
708 ; checkDerivDecl (LL (DerivDecl p $4)) } }
710 | 'deriving' '(' inst_type ')' 'for' qtycon {% checkDerivDecl (LL (DerivDecl $3 $6)) }
712 -----------------------------------------------------------------------------
713 -- Nested declarations
715 -- Type declaration or value declaration
717 tydecl :: { Located (OrdList (LHsDecl RdrName)) }
718 tydecl : at_decl { LL (unitOL (L1 (TyClD (unLoc $1)))) }
721 tydecls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
722 : tydecls ';' tydecl { LL (unLoc $1 `appOL` unLoc $3) }
723 | tydecls ';' { LL (unLoc $1) }
725 | {- empty -} { noLoc nilOL }
729 :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
730 : '{' tydecls '}' { LL (unLoc $2) }
731 | vocurly tydecls close { $2 }
733 -- Form of the body of class and instance declarations
735 where :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
736 -- No implicit parameters
737 -- May have type declarations
738 : 'where' tydecllist { LL (unLoc $2) }
739 | {- empty -} { noLoc nilOL }
741 decls :: { Located (OrdList (LHsDecl RdrName)) }
742 : decls ';' decl { LL (unLoc $1 `appOL` unLoc $3) }
743 | decls ';' { LL (unLoc $1) }
745 | {- empty -} { noLoc nilOL }
747 decllist :: { Located (OrdList (LHsDecl RdrName)) }
748 : '{' decls '}' { LL (unLoc $2) }
749 | vocurly decls close { $2 }
751 -- Binding groups other than those of class and instance declarations
753 binds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
754 -- No type declarations
755 : decllist { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
756 | '{' dbinds '}' { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
757 | vocurly dbinds close { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
759 wherebinds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
760 -- No type declarations
761 : 'where' binds { LL (unLoc $2) }
762 | {- empty -} { noLoc emptyLocalBinds }
765 -----------------------------------------------------------------------------
766 -- Transformation Rules
768 rules :: { OrdList (LHsDecl RdrName) }
769 : rules ';' rule { $1 `snocOL` $3 }
772 | {- empty -} { nilOL }
774 rule :: { LHsDecl RdrName }
775 : STRING activation rule_forall infixexp '=' exp
776 { LL $ RuleD (HsRule (getSTRING $1)
777 ($2 `orElse` AlwaysActive)
778 $3 $4 placeHolderNames $6 placeHolderNames) }
780 activation :: { Maybe Activation }
781 : {- empty -} { Nothing }
782 | explicit_activation { Just $1 }
784 explicit_activation :: { Activation } -- In brackets
785 : '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
786 | '[' '~' INTEGER ']' { ActiveBefore (fromInteger (getINTEGER $3)) }
788 rule_forall :: { [RuleBndr RdrName] }
789 : 'forall' rule_var_list '.' { $2 }
792 rule_var_list :: { [RuleBndr RdrName] }
794 | rule_var rule_var_list { $1 : $2 }
796 rule_var :: { RuleBndr RdrName }
797 : varid { RuleBndr $1 }
798 | '(' varid '::' ctype ')' { RuleBndrSig $2 $4 }
800 -----------------------------------------------------------------------------
801 -- Deprecations (c.f. rules)
803 deprecations :: { OrdList (LHsDecl RdrName) }
804 : deprecations ';' deprecation { $1 `appOL` $3 }
805 | deprecations ';' { $1 }
807 | {- empty -} { nilOL }
809 -- SUP: TEMPORARY HACK, not checking for `module Foo'
810 deprecation :: { OrdList (LHsDecl RdrName) }
812 { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
816 -----------------------------------------------------------------------------
817 -- Foreign import and export declarations
819 fdecl :: { LHsDecl RdrName }
820 fdecl : 'import' callconv safety fspec
821 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
822 | 'import' callconv fspec
823 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
825 | 'export' callconv fspec
826 {% mkExport $2 (unLoc $3) >>= return.LL }
828 callconv :: { CallConv }
829 : 'stdcall' { CCall StdCallConv }
830 | 'ccall' { CCall CCallConv }
831 | 'dotnet' { DNCall }
834 : 'unsafe' { PlayRisky }
835 | 'safe' { PlaySafe False }
836 | 'threadsafe' { PlaySafe True }
838 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
839 : STRING var '::' sigtypedoc { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
840 | var '::' sigtypedoc { LL (noLoc nilFS, $1, $3) }
841 -- if the entity string is missing, it defaults to the empty string;
842 -- the meaning of an empty entity string depends on the calling
845 -----------------------------------------------------------------------------
848 opt_sig :: { Maybe (LHsType RdrName) }
849 : {- empty -} { Nothing }
850 | '::' sigtype { Just $2 }
852 opt_asig :: { Maybe (LHsType RdrName) }
853 : {- empty -} { Nothing }
854 | '::' atype { Just $2 }
856 sigtypes1 :: { [LHsType RdrName] }
858 | sigtype ',' sigtypes1 { $1 : $3 }
860 sigtype :: { LHsType RdrName }
861 : ctype { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
862 -- Wrap an Implicit forall if there isn't one there already
864 sigtypedoc :: { LHsType RdrName }
865 : ctypedoc { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
866 -- Wrap an Implicit forall if there isn't one there already
868 sig_vars :: { Located [Located RdrName] }
869 : sig_vars ',' var { LL ($3 : unLoc $1) }
872 -----------------------------------------------------------------------------
875 infixtype :: { LHsType RdrName }
876 : btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
877 | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
879 infixtypedoc :: { LHsType RdrName }
881 | infixtype docprev { LL $ HsDocTy $1 $2 }
883 gentypedoc :: { LHsType RdrName }
886 | infixtypedoc { $1 }
887 | btype '->' ctypedoc { LL $ HsFunTy $1 $3 }
888 | btypedoc '->' ctypedoc { LL $ HsFunTy $1 $3 }
890 ctypedoc :: { LHsType RdrName }
891 : 'forall' tv_bndrs '.' ctypedoc { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
892 | context '=>' gentypedoc { LL $ mkImplicitHsForAllTy $1 $3 }
893 -- A type of form (context => type) is an *implicit* HsForAllTy
896 strict_mark :: { Located HsBang }
897 : '!' { L1 HsStrict }
898 | '{-# UNPACK' '#-}' '!' { LL HsUnbox }
900 -- A ctype is a for-all type
901 ctype :: { LHsType RdrName }
902 : 'forall' tv_bndrs '.' ctype { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
903 | context '=>' type { LL $ mkImplicitHsForAllTy $1 $3 }
904 -- A type of form (context => type) is an *implicit* HsForAllTy
907 -- We parse a context as a btype so that we don't get reduce/reduce
908 -- errors in ctype. The basic problem is that
910 -- looks so much like a tuple type. We can't tell until we find the =>
911 context :: { LHsContext RdrName }
912 : btype {% checkContext $1 }
914 type :: { LHsType RdrName }
915 : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
918 gentype :: { LHsType RdrName }
920 | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
921 | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
922 | btype '->' ctype { LL $ HsFunTy $1 $3 }
924 btype :: { LHsType RdrName }
925 : btype atype { LL $ HsAppTy $1 $2 }
928 btypedoc :: { LHsType RdrName }
929 : btype atype docprev { LL $ HsDocTy (L (comb2 $1 $2) (HsAppTy $1 $2)) $3 }
930 | atype docprev { LL $ HsDocTy $1 $2 }
932 atype :: { LHsType RdrName }
933 : gtycon { L1 (HsTyVar (unLoc $1)) }
934 | tyvar { L1 (HsTyVar (unLoc $1)) }
935 | strict_mark atype { LL (HsBangTy (unLoc $1) $2) }
936 | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) }
937 | '(#' comma_types1 '#)' { LL $ HsTupleTy Unboxed $2 }
938 | '[' ctype ']' { LL $ HsListTy $2 }
939 | '[:' ctype ':]' { LL $ HsPArrTy $2 }
940 | '(' ctype ')' { LL $ HsParTy $2 }
941 | '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) }
943 | INTEGER { L1 (HsNumTy (getINTEGER $1)) }
945 -- An inst_type is what occurs in the head of an instance decl
946 -- e.g. (Foo a, Gaz b) => Wibble a b
947 -- It's kept as a single type, with a MonoDictTy at the right
948 -- hand corner, for convenience.
949 inst_type :: { LHsType RdrName }
950 : sigtype {% checkInstType $1 }
952 inst_types1 :: { [LHsType RdrName] }
954 | inst_type ',' inst_types1 { $1 : $3 }
956 comma_types0 :: { [LHsType RdrName] }
957 : comma_types1 { $1 }
960 comma_types1 :: { [LHsType RdrName] }
962 | ctype ',' comma_types1 { $1 : $3 }
964 tv_bndrs :: { [LHsTyVarBndr RdrName] }
965 : tv_bndr tv_bndrs { $1 : $2 }
968 tv_bndr :: { LHsTyVarBndr RdrName }
969 : tyvar { L1 (UserTyVar (unLoc $1)) }
970 | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2)
973 fds :: { Located [Located ([RdrName], [RdrName])] }
974 : {- empty -} { noLoc [] }
975 | '|' fds1 { LL (reverse (unLoc $2)) }
977 fds1 :: { Located [Located ([RdrName], [RdrName])] }
978 : fds1 ',' fd { LL ($3 : unLoc $1) }
981 fd :: { Located ([RdrName], [RdrName]) }
982 : varids0 '->' varids0 { L (comb3 $1 $2 $3)
983 (reverse (unLoc $1), reverse (unLoc $3)) }
985 varids0 :: { Located [RdrName] }
986 : {- empty -} { noLoc [] }
987 | varids0 tyvar { LL (unLoc $2 : unLoc $1) }
989 -----------------------------------------------------------------------------
992 kind :: { Located Kind }
994 | akind '->' kind { LL (mkArrowKind (unLoc $1) (unLoc $3)) }
996 akind :: { Located Kind }
997 : '*' { L1 liftedTypeKind }
998 | '!' { L1 unliftedTypeKind }
999 | '(' kind ')' { LL (unLoc $2) }
1002 -----------------------------------------------------------------------------
1003 -- Datatype declarations
1005 gadt_constrlist :: { Located [LConDecl RdrName] }
1006 : '{' gadt_constrs '}' { LL (unLoc $2) }
1007 | vocurly gadt_constrs close { $2 }
1009 gadt_constrs :: { Located [LConDecl RdrName] }
1010 : gadt_constrs ';' gadt_constr { LL ($3 : unLoc $1) }
1011 | gadt_constrs ';' { $1 }
1012 | gadt_constr { L1 [$1] }
1014 -- We allow the following forms:
1015 -- C :: Eq a => a -> T a
1016 -- C :: forall a. Eq a => !a -> T a
1017 -- D { x,y :: a } :: T a
1018 -- forall a. Eq a => D { x,y :: a } :: T a
1020 gadt_constr :: { LConDecl RdrName }
1022 { LL (mkGadtDecl $1 $3) }
1023 -- Syntax: Maybe merge the record stuff with the single-case above?
1024 -- (to kill the mostly harmless reduce/reduce error)
1025 -- XXX revisit audreyt
1026 | constr_stuff_record '::' sigtype
1027 { let (con,details) = unLoc $1 in
1028 LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing) }
1030 | forall context '=>' constr_stuff_record '::' sigtype
1031 { let (con,details) = unLoc $4 in
1032 LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6) Nothing ) }
1033 | forall constr_stuff_record '::' sigtype
1034 { let (con,details) = unLoc $2 in
1035 LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4) Nothing) }
1039 constrs :: { Located [LConDecl RdrName] }
1040 : {- empty; a GHC extension -} { noLoc [] }
1041 | maybe_docnext '=' constrs1 { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
1043 constrs1 :: { Located [LConDecl RdrName] }
1044 : constrs1 maybe_docnext '|' maybe_docprev constr { LL (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4) }
1045 | constr { L1 [$1] }
1047 constr :: { LConDecl RdrName }
1048 : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1049 { let (con,details) = unLoc $5 in
1050 L (comb4 $2 $3 $4 $5) (ConDecl con Explicit (unLoc $2) $3 details ResTyH98 ($1 `mplus` $6)) }
1051 | maybe_docnext forall constr_stuff maybe_docprev
1052 { let (con,details) = unLoc $3 in
1053 L (comb2 $2 $3) (ConDecl con Explicit (unLoc $2) (noLoc []) details ResTyH98 ($1 `mplus` $4)) }
1055 forall :: { Located [LHsTyVarBndr RdrName] }
1056 : 'forall' tv_bndrs '.' { LL $2 }
1057 | {- empty -} { noLoc [] }
1059 constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
1060 -- We parse the constructor declaration
1062 -- as a btype (treating C as a type constructor) and then convert C to be
1063 -- a data constructor. Reason: it might continue like this:
1065 -- in which case C really would be a type constructor. We can't resolve this
1066 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
1067 : btype {% mkPrefixCon $1 [] >>= return.LL }
1068 | oqtycon '{' '}' {% mkRecCon $1 [] >>= return.LL }
1069 | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL }
1070 | btype conop btype { LL ($2, InfixCon $1 $3) }
1072 constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
1073 : oqtycon '{' '}' {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
1074 | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
1076 fielddecls :: { [([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName))] }
1077 : fielddecl maybe_docnext ',' maybe_docprev fielddecls { addFieldDoc (unLoc $1) $4 : addFieldDocs $5 $2 }
1078 | fielddecl { [unLoc $1] }
1080 fielddecl :: { Located ([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName)) }
1081 : maybe_docnext sig_vars '::' ctype maybe_docprev { L (comb3 $2 $3 $4) (reverse (unLoc $2), $4, $1 `mplus` $5) }
1083 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1084 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1085 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1086 -- We don't allow a context, but that's sorted out by the type checker.
1087 deriving :: { Located (Maybe [LHsType RdrName]) }
1088 : {- empty -} { noLoc Nothing }
1089 | 'deriving' qtycon {% do { let { L loc tv = $2 }
1090 ; p <- checkInstType (L loc (HsTyVar tv))
1091 ; return (LL (Just [p])) } }
1092 | 'deriving' '(' ')' { LL (Just []) }
1093 | 'deriving' '(' inst_types1 ')' { LL (Just $3) }
1094 -- Glasgow extension: allow partial
1095 -- applications in derivings
1097 -----------------------------------------------------------------------------
1098 -- Value definitions
1100 {- There's an awkward overlap with a type signature. Consider
1101 f :: Int -> Int = ...rhs...
1102 Then we can't tell whether it's a type signature or a value
1103 definition with a result signature until we see the '='.
1104 So we have to inline enough to postpone reductions until we know.
1108 ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1109 instead of qvar, we get another shift/reduce-conflict. Consider the
1112 { (^^) :: Int->Int ; } Type signature; only var allowed
1114 { (^^) :: Int->Int = ... ; } Value defn with result signature;
1115 qvar allowed (because of instance decls)
1117 We can't tell whether to reduce var to qvar until after we've read the signatures.
1120 docdecl :: { LHsDecl RdrName }
1121 : docdecld { L1 (DocD (unLoc $1)) }
1123 docdecld :: { LDocDecl RdrName }
1124 : docnext { L1 (DocCommentNext (unLoc $1)) }
1125 | docprev { L1 (DocCommentPrev (unLoc $1)) }
1126 | docnamed { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
1127 | docsection { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
1129 decl :: { Located (OrdList (LHsDecl RdrName)) }
1131 | '!' infixexp rhs {% do { pat <- checkPattern $2;
1132 return (LL $ unitOL $ LL $ ValD (
1133 PatBind (LL $ BangPat pat) (unLoc $3)
1134 placeHolderType placeHolderNames)) } }
1135 | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3;
1136 return (LL $ unitOL (LL $ ValD r)) } }
1137 | docdecl { LL $ unitOL $1 }
1139 rhs :: { Located (GRHSs RdrName) }
1140 : '=' exp wherebinds { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
1141 | gdrhs wherebinds { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) }
1143 gdrhs :: { Located [LGRHS RdrName] }
1144 : gdrhs gdrh { LL ($2 : unLoc $1) }
1147 gdrh :: { LGRHS RdrName }
1148 : '|' quals '=' exp { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
1150 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
1151 : infixexp '::' sigtypedoc
1152 {% do s <- checkValSig $1 $3;
1153 return (LL $ unitOL (LL $ SigD s)) }
1154 -- See the above notes for why we need infixexp here
1155 | var ',' sig_vars '::' sigtypedoc
1156 { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
1157 | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
1159 | '{-# INLINE' activation qvar '#-}'
1160 { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
1161 | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
1162 { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
1164 | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
1165 { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
1167 | '{-# SPECIALISE' 'instance' inst_type '#-}'
1168 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
1170 -----------------------------------------------------------------------------
1173 exp :: { LHsExpr RdrName }
1174 : infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
1175 | infixexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
1176 | infixexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
1177 | infixexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
1178 | infixexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
1181 infixexp :: { LHsExpr RdrName }
1183 | infixexp qop exp10 { LL (OpApp $1 $2 (panic "fixity") $3) }
1185 exp10 :: { LHsExpr RdrName }
1186 : '\\' aexp aexps opt_asig '->' exp
1187 {% checkPatterns ($2 : reverse $3) >>= \ ps ->
1188 return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4
1189 (GRHSs (unguardedRHS $6) emptyLocalBinds
1191 | 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
1192 | 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 }
1193 | 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
1194 | '-' fexp { LL $ mkHsNegApp $2 }
1196 | 'do' stmtlist {% let loc = comb2 $1 $2 in
1197 checkDo loc (unLoc $2) >>= \ (stmts,body) ->
1198 return (L loc (mkHsDo DoExpr stmts body)) }
1199 | 'mdo' stmtlist {% let loc = comb2 $1 $2 in
1200 checkDo loc (unLoc $2) >>= \ (stmts,body) ->
1201 return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
1202 | scc_annot exp { LL $ if opt_SccProfilingOn
1203 then HsSCC (unLoc $1) $2
1206 | 'proc' aexp '->' exp
1207 {% checkPattern $2 >>= \ p ->
1208 return (LL $ HsProc p (LL $ HsCmdTop $4 []
1209 placeHolderType undefined)) }
1210 -- TODO: is LL right here?
1212 | '{-# CORE' STRING '#-}' exp { LL $ HsCoreAnn (getSTRING $2) $4 }
1213 -- hdaume: core annotation
1216 scc_annot :: { Located FastString }
1217 : '_scc_' STRING { LL $ getSTRING $2 }
1218 | '{-# SCC' STRING '#-}' { LL $ getSTRING $2 }
1220 fexp :: { LHsExpr RdrName }
1221 : fexp aexp { LL $ HsApp $1 $2 }
1224 aexps :: { [LHsExpr RdrName] }
1225 : aexps aexp { $2 : $1 }
1226 | {- empty -} { [] }
1228 aexp :: { LHsExpr RdrName }
1229 : qvar '@' aexp { LL $ EAsPat $1 $3 }
1230 | '~' aexp { LL $ ELazyPat $2 }
1231 -- | '!' aexp { LL $ EBangPat $2 }
1234 aexp1 :: { LHsExpr RdrName }
1235 : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
1240 -- Here was the syntax for type applications that I was planning
1241 -- but there are difficulties (e.g. what order for type args)
1242 -- so it's not enabled yet.
1243 -- But this case *is* used for the left hand side of a generic definition,
1244 -- which is parsed as an expression before being munged into a pattern
1245 | qcname '{|' gentype '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1246 (sL (getLoc $3) (HsType $3)) }
1248 aexp2 :: { LHsExpr RdrName }
1249 : ipvar { L1 (HsIPVar $! unLoc $1) }
1250 | qcname { L1 (HsVar $! unLoc $1) }
1251 | literal { L1 (HsLit $! unLoc $1) }
1252 | INTEGER { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
1253 | RATIONAL { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
1254 | '(' exp ')' { LL (HsPar $2) }
1255 | '(' texp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1256 | '(#' texps '#)' { LL $ ExplicitTuple (reverse $2) Unboxed }
1257 | '[' list ']' { LL (unLoc $2) }
1258 | '[:' parr ':]' { LL (unLoc $2) }
1259 | '(' infixexp qop ')' { LL $ SectionL $2 $3 }
1260 | '(' qopm infixexp ')' { LL $ SectionR $2 $3 }
1261 | '_' { L1 EWildPat }
1263 -- Template Haskell Extension
1264 | TH_ID_SPLICE { L1 $ HsSpliceE (mkHsSplice
1265 (L1 $ HsVar (mkUnqual varName
1266 (getTH_ID_SPLICE $1)))) } -- $x
1267 | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
1269 | TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
1270 | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
1271 | TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
1272 | TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) }
1273 | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
1274 | '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
1275 | '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
1276 return (LL $ HsBracket (PatBr p)) }
1277 | '[d|' cvtopbody '|]' { LL $ HsBracket (DecBr (mkGroup $2)) }
1279 -- arrow notation extension
1280 | '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
1282 cmdargs :: { [LHsCmdTop RdrName] }
1283 : cmdargs acmd { $2 : $1 }
1284 | {- empty -} { [] }
1286 acmd :: { LHsCmdTop RdrName }
1287 : aexp2 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1289 cvtopbody :: { [LHsDecl RdrName] }
1290 : '{' cvtopdecls0 '}' { $2 }
1291 | vocurly cvtopdecls0 close { $2 }
1293 cvtopdecls0 :: { [LHsDecl RdrName] }
1294 : {- empty -} { [] }
1297 texp :: { LHsExpr RdrName }
1299 | qopm infixexp { LL $ SectionR $1 $2 }
1300 -- The second production is really here only for bang patterns
1303 texps :: { [LHsExpr RdrName] }
1304 : texps ',' texp { $3 : $1 }
1308 -----------------------------------------------------------------------------
1311 -- The rules below are little bit contorted to keep lexps left-recursive while
1312 -- avoiding another shift/reduce-conflict.
1314 list :: { LHsExpr RdrName }
1315 : texp { L1 $ ExplicitList placeHolderType [$1] }
1316 | lexps { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1317 | texp '..' { LL $ ArithSeq noPostTcExpr (From $1) }
1318 | texp ',' exp '..' { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
1319 | texp '..' exp { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
1320 | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1321 | texp pquals { sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
1323 lexps :: { Located [LHsExpr RdrName] }
1324 : lexps ',' texp { LL ($3 : unLoc $1) }
1325 | texp ',' texp { LL [$3,$1] }
1327 -----------------------------------------------------------------------------
1328 -- List Comprehensions
1330 pquals :: { Located [LStmt RdrName] } -- Either a singleton ParStmt,
1331 -- or a reversed list of Stmts
1332 : pquals1 { case unLoc $1 of
1334 qss -> L1 [L1 (ParStmt stmtss)]
1336 stmtss = [ (reverse qs, undefined)
1340 pquals1 :: { Located [[LStmt RdrName]] }
1341 : pquals1 '|' quals { LL (unLoc $3 : unLoc $1) }
1342 | '|' quals { L (getLoc $2) [unLoc $2] }
1344 quals :: { Located [LStmt RdrName] }
1345 : quals ',' qual { LL ($3 : unLoc $1) }
1348 -----------------------------------------------------------------------------
1349 -- Parallel array expressions
1351 -- The rules below are little bit contorted; see the list case for details.
1352 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1353 -- Moreover, we allow explicit arrays with no element (represented by the nil
1354 -- constructor in the list case).
1356 parr :: { LHsExpr RdrName }
1357 : { noLoc (ExplicitPArr placeHolderType []) }
1358 | exp { L1 $ ExplicitPArr placeHolderType [$1] }
1359 | lexps { L1 $ ExplicitPArr placeHolderType
1360 (reverse (unLoc $1)) }
1361 | exp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
1362 | exp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1363 | exp pquals { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
1365 -- We are reusing `lexps' and `pquals' from the list case.
1367 -----------------------------------------------------------------------------
1368 -- Case alternatives
1370 altslist :: { Located [LMatch RdrName] }
1371 : '{' alts '}' { LL (reverse (unLoc $2)) }
1372 | vocurly alts close { L (getLoc $2) (reverse (unLoc $2)) }
1374 alts :: { Located [LMatch RdrName] }
1375 : alts1 { L1 (unLoc $1) }
1376 | ';' alts { LL (unLoc $2) }
1378 alts1 :: { Located [LMatch RdrName] }
1379 : alts1 ';' alt { LL ($3 : unLoc $1) }
1380 | alts1 ';' { LL (unLoc $1) }
1383 alt :: { LMatch RdrName }
1384 : infixexp opt_sig alt_rhs {% checkPattern $1 >>= \p ->
1385 return (LL (Match [p] $2 (unLoc $3))) }
1386 | '!' infixexp opt_sig alt_rhs {% checkPattern $2 >>= \p ->
1387 return (LL (Match [LL $ BangPat p] $3 (unLoc $4))) }
1389 alt_rhs :: { Located (GRHSs RdrName) }
1390 : ralt wherebinds { LL (GRHSs (unLoc $1) (unLoc $2)) }
1392 ralt :: { Located [LGRHS RdrName] }
1393 : '->' exp { LL (unguardedRHS $2) }
1394 | gdpats { L1 (reverse (unLoc $1)) }
1396 gdpats :: { Located [LGRHS RdrName] }
1397 : gdpats gdpat { LL ($2 : unLoc $1) }
1400 gdpat :: { LGRHS RdrName }
1401 : '|' quals '->' exp { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
1403 -----------------------------------------------------------------------------
1404 -- Statement sequences
1406 stmtlist :: { Located [LStmt RdrName] }
1407 : '{' stmts '}' { LL (unLoc $2) }
1408 | vocurly stmts close { $2 }
1410 -- do { ;; s ; s ; ; s ;; }
1411 -- The last Stmt should be an expression, but that's hard to enforce
1412 -- here, because we need too much lookahead if we see do { e ; }
1413 -- So we use ExprStmts throughout, and switch the last one over
1414 -- in ParseUtils.checkDo instead
1415 stmts :: { Located [LStmt RdrName] }
1416 : stmt stmts_help { LL ($1 : unLoc $2) }
1417 | ';' stmts { LL (unLoc $2) }
1418 | {- empty -} { noLoc [] }
1420 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1421 : ';' stmts { LL (unLoc $2) }
1422 | {- empty -} { noLoc [] }
1424 -- For typing stmts at the GHCi prompt, where
1425 -- the input may consist of just comments.
1426 maybe_stmt :: { Maybe (LStmt RdrName) }
1428 | {- nothing -} { Nothing }
1430 stmt :: { LStmt RdrName }
1432 | infixexp '->' exp {% checkPattern $3 >>= \p ->
1433 return (LL $ mkBindStmt p $1) }
1434 | 'rec' stmtlist { LL $ mkRecStmt (unLoc $2) }
1436 qual :: { LStmt RdrName }
1437 : exp '<-' exp {% checkPattern $1 >>= \p ->
1438 return (LL $ mkBindStmt p $3) }
1439 | exp { L1 $ mkExprStmt $1 }
1440 | 'let' binds { LL $ LetStmt (unLoc $2) }
1442 -----------------------------------------------------------------------------
1443 -- Record Field Update/Construction
1445 fbinds :: { HsRecordBinds RdrName }
1447 | {- empty -} { [] }
1449 fbinds1 :: { HsRecordBinds RdrName }
1450 : fbinds1 ',' fbind { $3 : $1 }
1453 fbind :: { (Located RdrName, LHsExpr RdrName) }
1454 : qvar '=' exp { ($1,$3) }
1456 -----------------------------------------------------------------------------
1457 -- Implicit Parameter Bindings
1459 dbinds :: { Located [LIPBind RdrName] }
1460 : dbinds ';' dbind { LL ($3 : unLoc $1) }
1461 | dbinds ';' { LL (unLoc $1) }
1463 -- | {- empty -} { [] }
1465 dbind :: { LIPBind RdrName }
1466 dbind : ipvar '=' exp { LL (IPBind (unLoc $1) $3) }
1468 ipvar :: { Located (IPName RdrName) }
1469 : IPDUPVARID { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
1471 -----------------------------------------------------------------------------
1474 depreclist :: { Located [RdrName] }
1475 depreclist : deprec_var { L1 [unLoc $1] }
1476 | deprec_var ',' depreclist { LL (unLoc $1 : unLoc $3) }
1478 deprec_var :: { Located RdrName }
1479 deprec_var : var { $1 }
1482 -----------------------------------------
1483 -- Data constructors
1484 qcon :: { Located RdrName }
1486 | '(' qconsym ')' { LL (unLoc $2) }
1487 | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
1488 -- The case of '[:' ':]' is part of the production `parr'
1490 con :: { Located RdrName }
1492 | '(' consym ')' { LL (unLoc $2) }
1493 | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
1495 sysdcon :: { Located DataCon } -- Wired in data constructors
1496 : '(' ')' { LL unitDataCon }
1497 | '(' commas ')' { LL $ tupleCon Boxed $2 }
1498 | '[' ']' { LL nilDataCon }
1500 conop :: { Located RdrName }
1502 | '`' conid '`' { LL (unLoc $2) }
1504 qconop :: { Located RdrName }
1506 | '`' qconid '`' { LL (unLoc $2) }
1508 -----------------------------------------------------------------------------
1509 -- Type constructors
1511 gtycon :: { Located RdrName } -- A "general" qualified tycon
1513 | '(' ')' { LL $ getRdrName unitTyCon }
1514 | '(' commas ')' { LL $ getRdrName (tupleTyCon Boxed $2) }
1515 | '(' '->' ')' { LL $ getRdrName funTyCon }
1516 | '[' ']' { LL $ listTyCon_RDR }
1517 | '[:' ':]' { LL $ parrTyCon_RDR }
1519 oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon
1521 | '(' qtyconsym ')' { LL (unLoc $2) }
1523 qtyconop :: { Located RdrName } -- Qualified or unqualified
1525 | '`' qtycon '`' { LL (unLoc $2) }
1527 qtycon :: { Located RdrName } -- Qualified or unqualified
1528 : QCONID { L1 $! mkQual tcClsName (getQCONID $1) }
1531 tycon :: { Located RdrName } -- Unqualified
1532 : CONID { L1 $! mkUnqual tcClsName (getCONID $1) }
1534 qtyconsym :: { Located RdrName }
1535 : QCONSYM { L1 $! mkQual tcClsName (getQCONSYM $1) }
1538 tyconsym :: { Located RdrName }
1539 : CONSYM { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1541 -----------------------------------------------------------------------------
1544 op :: { Located RdrName } -- used in infix decls
1548 varop :: { Located RdrName }
1550 | '`' varid '`' { LL (unLoc $2) }
1552 qop :: { LHsExpr RdrName } -- used in sections
1553 : qvarop { L1 $ HsVar (unLoc $1) }
1554 | qconop { L1 $ HsVar (unLoc $1) }
1556 qopm :: { LHsExpr RdrName } -- used in sections
1557 : qvaropm { L1 $ HsVar (unLoc $1) }
1558 | qconop { L1 $ HsVar (unLoc $1) }
1560 qvarop :: { Located RdrName }
1562 | '`' qvarid '`' { LL (unLoc $2) }
1564 qvaropm :: { Located RdrName }
1565 : qvarsym_no_minus { $1 }
1566 | '`' qvarid '`' { LL (unLoc $2) }
1568 -----------------------------------------------------------------------------
1571 tyvar :: { Located RdrName }
1572 tyvar : tyvarid { $1 }
1573 | '(' tyvarsym ')' { LL (unLoc $2) }
1575 tyvarop :: { Located RdrName }
1576 tyvarop : '`' tyvarid '`' { LL (unLoc $2) }
1579 tyvarid :: { Located RdrName }
1580 : VARID { L1 $! mkUnqual tvName (getVARID $1) }
1581 | special_id { L1 $! mkUnqual tvName (unLoc $1) }
1582 | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") }
1583 | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") }
1584 | 'threadsafe' { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1586 tyvarsym :: { Located RdrName }
1587 -- Does not include "!", because that is used for strictness marks
1588 -- or ".", because that separates the quantified type vars from the rest
1589 -- or "*", because that's used for kinds
1590 tyvarsym : VARSYM { L1 $! mkUnqual tvName (getVARSYM $1) }
1592 -----------------------------------------------------------------------------
1595 var :: { Located RdrName }
1597 | '(' varsym ')' { LL (unLoc $2) }
1599 qvar :: { Located RdrName }
1601 | '(' varsym ')' { LL (unLoc $2) }
1602 | '(' qvarsym1 ')' { LL (unLoc $2) }
1603 -- We've inlined qvarsym here so that the decision about
1604 -- whether it's a qvar or a var can be postponed until
1605 -- *after* we see the close paren.
1607 qvarid :: { Located RdrName }
1609 | QVARID { L1 $ mkQual varName (getQVARID $1) }
1611 varid :: { Located RdrName }
1612 : varid_no_unsafe { $1 }
1613 | 'unsafe' { L1 $! mkUnqual varName FSLIT("unsafe") }
1614 | 'safe' { L1 $! mkUnqual varName FSLIT("safe") }
1615 | 'threadsafe' { L1 $! mkUnqual varName FSLIT("threadsafe") }
1617 varid_no_unsafe :: { Located RdrName }
1618 : VARID { L1 $! mkUnqual varName (getVARID $1) }
1619 | special_id { L1 $! mkUnqual varName (unLoc $1) }
1620 | 'forall' { L1 $! mkUnqual varName FSLIT("forall") }
1621 | 'iso' { L1 $! mkUnqual varName FSLIT("iso") }
1622 | 'family' { L1 $! mkUnqual varName FSLIT("family") }
1624 qvarsym :: { Located RdrName }
1628 qvarsym_no_minus :: { Located RdrName }
1629 : varsym_no_minus { $1 }
1632 qvarsym1 :: { Located RdrName }
1633 qvarsym1 : QVARSYM { L1 $ mkQual varName (getQVARSYM $1) }
1635 varsym :: { Located RdrName }
1636 : varsym_no_minus { $1 }
1637 | '-' { L1 $ mkUnqual varName FSLIT("-") }
1639 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1640 : VARSYM { L1 $ mkUnqual varName (getVARSYM $1) }
1641 | special_sym { L1 $ mkUnqual varName (unLoc $1) }
1644 -- These special_ids are treated as keywords in various places,
1645 -- but as ordinary ids elsewhere. 'special_id' collects all these
1646 -- except 'unsafe', 'forall', 'family', and 'iso' whose treatment differs
1647 -- depending on context
1648 special_id :: { Located FastString }
1650 : 'as' { L1 FSLIT("as") }
1651 | 'qualified' { L1 FSLIT("qualified") }
1652 | 'hiding' { L1 FSLIT("hiding") }
1653 | 'for' { L1 FSLIT("for") }
1654 | 'export' { L1 FSLIT("export") }
1655 | 'label' { L1 FSLIT("label") }
1656 | 'dynamic' { L1 FSLIT("dynamic") }
1657 | 'stdcall' { L1 FSLIT("stdcall") }
1658 | 'ccall' { L1 FSLIT("ccall") }
1660 special_sym :: { Located FastString }
1661 special_sym : '!' { L1 FSLIT("!") }
1662 | '.' { L1 FSLIT(".") }
1663 | '*' { L1 FSLIT("*") }
1665 -----------------------------------------------------------------------------
1666 -- Data constructors
1668 qconid :: { Located RdrName } -- Qualified or unqualified
1670 | QCONID { L1 $ mkQual dataName (getQCONID $1) }
1672 conid :: { Located RdrName }
1673 : CONID { L1 $ mkUnqual dataName (getCONID $1) }
1675 qconsym :: { Located RdrName } -- Qualified or unqualified
1677 | QCONSYM { L1 $ mkQual dataName (getQCONSYM $1) }
1679 consym :: { Located RdrName }
1680 : CONSYM { L1 $ mkUnqual dataName (getCONSYM $1) }
1682 -- ':' means only list cons
1683 | ':' { L1 $ consDataCon_RDR }
1686 -----------------------------------------------------------------------------
1689 literal :: { Located HsLit }
1690 : CHAR { L1 $ HsChar $ getCHAR $1 }
1691 | STRING { L1 $ HsString $ getSTRING $1 }
1692 | PRIMINTEGER { L1 $ HsIntPrim $ getPRIMINTEGER $1 }
1693 | PRIMCHAR { L1 $ HsCharPrim $ getPRIMCHAR $1 }
1694 | PRIMSTRING { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1695 | PRIMFLOAT { L1 $ HsFloatPrim $ getPRIMFLOAT $1 }
1696 | PRIMDOUBLE { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1698 -----------------------------------------------------------------------------
1702 : vccurly { () } -- context popped in lexer.
1703 | error {% popContext }
1705 -----------------------------------------------------------------------------
1706 -- Miscellaneous (mostly renamings)
1708 modid :: { Located ModuleName }
1709 : CONID { L1 $ mkModuleNameFS (getCONID $1) }
1710 | QCONID { L1 $ let (mod,c) = getQCONID $1 in
1713 (unpackFS mod ++ '.':unpackFS c))
1717 : commas ',' { $1 + 1 }
1720 -----------------------------------------------------------------------------
1721 -- Documentation comments
1723 docnext :: { LHsDoc RdrName }
1724 : DOCNEXT {% case parseHaddockParagraphs (tokenise (getDOCNEXT $1)) of {
1725 Left err -> parseError (getLoc $1) err;
1726 Right doc -> return (L1 doc) } }
1728 docprev :: { LHsDoc RdrName }
1729 : DOCPREV {% case parseHaddockParagraphs (tokenise (getDOCPREV $1)) of {
1730 Left err -> parseError (getLoc $1) err;
1731 Right doc -> return (L1 doc) } }
1733 docnamed :: { Located (String, (HsDoc RdrName)) }
1735 let string = getDOCNAMED $1
1736 (name, rest) = break isSpace string
1737 in case parseHaddockParagraphs (tokenise rest) of {
1738 Left err -> parseError (getLoc $1) err;
1739 Right doc -> return (L1 (name, doc)) } }
1741 docsection :: { Located (n, HsDoc RdrName) }
1742 : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
1743 case parseHaddockString (tokenise doc) of {
1744 Left err -> parseError (getLoc $1) err;
1745 Right doc -> return (L1 (n, doc)) } }
1747 docoptions :: { String }
1748 : DOCOPTIONS { getDOCOPTIONS $1 }
1750 moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
1751 : DOCNEXT {% let string = getDOCNEXT $1 in
1752 case parseModuleHeader string of {
1753 Right (str, info) ->
1754 case parseHaddockParagraphs (tokenise str) of {
1755 Left err -> parseError (getLoc $1) err;
1756 Right doc -> return (info, Just doc);
1758 Left err -> parseError (getLoc $1) err
1761 maybe_docprev :: { Maybe (LHsDoc RdrName) }
1762 : docprev { Just $1 }
1763 | {- empty -} { Nothing }
1765 maybe_docnext :: { Maybe (LHsDoc RdrName) }
1766 : docnext { Just $1 }
1767 | {- empty -} { Nothing }
1771 happyError = srcParseFail
1773 getVARID (L _ (ITvarid x)) = x
1774 getCONID (L _ (ITconid x)) = x
1775 getVARSYM (L _ (ITvarsym x)) = x
1776 getCONSYM (L _ (ITconsym x)) = x
1777 getQVARID (L _ (ITqvarid x)) = x
1778 getQCONID (L _ (ITqconid x)) = x
1779 getQVARSYM (L _ (ITqvarsym x)) = x
1780 getQCONSYM (L _ (ITqconsym x)) = x
1781 getIPDUPVARID (L _ (ITdupipvarid x)) = x
1782 getCHAR (L _ (ITchar x)) = x
1783 getSTRING (L _ (ITstring x)) = x
1784 getINTEGER (L _ (ITinteger x)) = x
1785 getRATIONAL (L _ (ITrational x)) = x
1786 getPRIMCHAR (L _ (ITprimchar x)) = x
1787 getPRIMSTRING (L _ (ITprimstring x)) = x
1788 getPRIMINTEGER (L _ (ITprimint x)) = x
1789 getPRIMFLOAT (L _ (ITprimfloat x)) = x
1790 getPRIMDOUBLE (L _ (ITprimdouble x)) = x
1791 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1792 getINLINE (L _ (ITinline_prag b)) = b
1793 getSPEC_INLINE (L _ (ITspec_inline_prag b)) = b
1795 getDOCNEXT (L _ (ITdocCommentNext x)) = x
1796 getDOCPREV (L _ (ITdocCommentPrev x)) = x
1797 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
1798 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
1799 getDOCOPTIONS (L _ (ITdocOptions x)) = x
1801 -- Utilities for combining source spans
1802 comb2 :: Located a -> Located b -> SrcSpan
1805 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1806 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1808 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1809 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1810 combineSrcSpans (getLoc c) (getLoc d)
1812 -- strict constructor version:
1814 sL :: SrcSpan -> a -> Located a
1815 sL span a = span `seq` L span a
1817 -- Make a source location for the file. We're a bit lazy here and just
1818 -- make a point SrcSpan at line 1, column 0. Strictly speaking we should
1819 -- try to find the span of the whole file (ToDo).
1820 fileSrcSpan :: P SrcSpan
1823 let loc = mkSrcLoc (srcLocFile l) 1 0;
1824 return (mkSrcSpan loc loc)