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, parseIface, parseType ) where
13 #define INCLUDE #include
14 INCLUDE "HsVersions.h"
18 import HscTypes ( ModIface, IsBootInterface, DeprecTxt )
21 import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
22 listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
23 import Type ( funTyCon )
24 import ForeignCall ( Safety(..), CExportSpec(..),
25 CCallConv(..), CCallTarget(..), defaultCCallConv
27 import OccName ( UserFS, varName, dataName, tcClsName, tvName )
28 import DataCon ( DataCon, dataConName )
29 import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
30 SrcSpan, combineLocs, mkGeneralSrcSpan, srcLocFile )
32 import CmdLineOpts ( opt_SccProfilingOn )
33 import Type ( Kind, mkArrowKind, liftedTypeKind )
34 import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
37 import Bag ( emptyBag )
40 import CStrings ( CLabelString )
42 import Maybes ( orElse )
48 -----------------------------------------------------------------------------
49 Conflicts: 29 shift/reduce, [SDM 19/9/2002]
51 10 for abiguity in 'if x then y else z + 1' [State 136]
52 (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
53 10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
55 1 for ambiguity in 'if x then y else z with ?x=3' [State 136]
56 (shift parses as 'if x then y else (z with ?x=3)'
58 1 for ambiguity in 'if x then y else z :: T' [State 136]
59 (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
61 8 for ambiguity in 'e :: a `b` c'. Does this mean [States 160,246]
65 1 for ambiguity in 'let ?x ...' [State 268]
66 the parser can't tell whether the ?x is the lhs of a normal binding or
67 an implicit binding. Fortunately resolving as shift gives it the only
68 sensible meaning, namely the lhs of an implicit binding.
70 1 for ambiguity in '{-# RULES "name" [ ... #-} [State 332]
71 we don't know whether the '[' starts the activation or not: it
72 might be the start of the declaration with the activation being
75 1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 394]
76 since 'forall' is a valid variable name, we don't know whether
77 to treat a forall on the input as the beginning of a quantifier
78 or the beginning of the rule itself. Resolving to shift means
79 it's always treated as a quantifier, hence the above is disallowed.
80 This saves explicitly defining a grammar for the rule lhs that
81 doesn't include 'forall'.
83 6 for conflicts between `fdecl' and `fdeclDEPRECATED', [States 384,385]
84 which are resolved correctly, and moreover,
85 should go away when `fdeclDEPRECATED' is removed.
87 -- ---------------------------------------------------------------------------
88 -- Adding location info
90 This is done in a stylised way using the three macros below, L0, L1
91 and LL. Each of these macros can be thought of as having type
93 L0, L1, LL :: a -> Located a
95 They each add a SrcSpan to their argument.
97 L0 adds 'noSrcSpan', used for empty productions
99 L1 for a production with a single token on the lhs. Grabs the SrcSpan
102 LL for a production with >1 token on the lhs. Makes up a SrcSpan from
103 the first and last tokens.
105 These suffice for the majority of cases. However, we must be
106 especially careful with empty productions: LL won't work if the first
107 or last token on the lhs can represent an empty span. In these cases,
108 we have to calculate the span using more of the tokens from the lhs, eg.
110 | 'newtype' tycl_hdr '=' newconstr deriving
112 (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
114 We provide comb3 and comb4 functions which are useful in such cases.
116 Be careful: there's no checking that you actually got this right, the
117 only symptom will be that the SrcSpans of your syntax will be
121 * We must expand these macros *before* running Happy, which is why this file is
122 * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
124 #define L0 L noSrcSpan
125 #define L1 sL (getLoc $1)
126 #define LL sL (comb2 $1 $>)
128 -- -----------------------------------------------------------------------------
133 '_' { L _ ITunderscore } -- Haskell keywords
135 'case' { L _ ITcase }
136 'class' { L _ ITclass }
137 'data' { L _ ITdata }
138 'default' { L _ ITdefault }
139 'deriving' { L _ ITderiving }
141 'else' { L _ ITelse }
142 'hiding' { L _ IThiding }
144 'import' { L _ ITimport }
146 'infix' { L _ ITinfix }
147 'infixl' { L _ ITinfixl }
148 'infixr' { L _ ITinfixr }
149 'instance' { L _ ITinstance }
151 'module' { L _ ITmodule }
152 'newtype' { L _ ITnewtype }
154 'qualified' { L _ ITqualified }
155 'then' { L _ ITthen }
156 'type' { L _ ITtype }
157 'where' { L _ ITwhere }
158 '_scc_' { L _ ITscc } -- ToDo: remove
160 'forall' { L _ ITforall } -- GHC extension keywords
161 'foreign' { L _ ITforeign }
162 'export' { L _ ITexport }
163 'label' { L _ ITlabel }
164 'dynamic' { L _ ITdynamic }
165 'safe' { L _ ITsafe }
166 'threadsafe' { L _ ITthreadsafe }
167 'unsafe' { L _ ITunsafe }
169 'stdcall' { L _ ITstdcallconv }
170 'ccall' { L _ ITccallconv }
171 'dotnet' { L _ ITdotnet }
172 'proc' { L _ ITproc } -- for arrow notation extension
173 'rec' { L _ ITrec } -- for arrow notation extension
175 '{-# SPECIALISE' { L _ ITspecialise_prag }
176 '{-# SOURCE' { L _ ITsource_prag }
177 '{-# INLINE' { L _ ITinline_prag }
178 '{-# NOINLINE' { L _ ITnoinline_prag }
179 '{-# RULES' { L _ ITrules_prag }
180 '{-# CORE' { L _ ITcore_prag } -- hdaume: annotated core
181 '{-# SCC' { L _ ITscc_prag }
182 '{-# DEPRECATED' { L _ ITdeprecated_prag }
183 '{-# UNPACK' { L _ ITunpack_prag }
184 '#-}' { L _ ITclose_prag }
186 '..' { L _ ITdotdot } -- reserved symbols
188 '::' { L _ ITdcolon }
192 '<-' { L _ ITlarrow }
193 '->' { L _ ITrarrow }
196 '=>' { L _ ITdarrow }
200 '-<' { L _ ITlarrowtail } -- for arrow notation
201 '>-' { L _ ITrarrowtail } -- for arrow notation
202 '-<<' { L _ ITLarrowtail } -- for arrow notation
203 '>>-' { L _ ITRarrowtail } -- for arrow notation
206 '{' { L _ ITocurly } -- special symbols
208 '{|' { L _ ITocurlybar }
209 '|}' { L _ ITccurlybar }
210 vocurly { L _ ITvocurly } -- virtual open curly (from layout)
211 vccurly { L _ ITvccurly } -- virtual close curly (from layout)
214 '[:' { L _ ITopabrack }
215 ':]' { L _ ITcpabrack }
218 '(#' { L _ IToubxparen }
219 '#)' { L _ ITcubxparen }
220 '(|' { L _ IToparenbar }
221 '|)' { L _ ITcparenbar }
224 '`' { L _ ITbackquote }
226 VARID { L _ (ITvarid _) } -- identifiers
227 CONID { L _ (ITconid _) }
228 VARSYM { L _ (ITvarsym _) }
229 CONSYM { L _ (ITconsym _) }
230 QVARID { L _ (ITqvarid _) }
231 QCONID { L _ (ITqconid _) }
232 QVARSYM { L _ (ITqvarsym _) }
233 QCONSYM { L _ (ITqconsym _) }
235 IPDUPVARID { L _ (ITdupipvarid _) } -- GHC extension
236 IPSPLITVARID { L _ (ITsplitipvarid _) } -- GHC extension
238 CHAR { L _ (ITchar _) }
239 STRING { L _ (ITstring _) }
240 INTEGER { L _ (ITinteger _) }
241 RATIONAL { L _ (ITrational _) }
243 PRIMCHAR { L _ (ITprimchar _) }
244 PRIMSTRING { L _ (ITprimstring _) }
245 PRIMINTEGER { L _ (ITprimint _) }
246 PRIMFLOAT { L _ (ITprimfloat _) }
247 PRIMDOUBLE { L _ (ITprimdouble _) }
250 '[|' { L _ ITopenExpQuote }
251 '[p|' { L _ ITopenPatQuote }
252 '[t|' { L _ ITopenTypQuote }
253 '[d|' { L _ ITopenDecQuote }
254 '|]' { L _ ITcloseQuote }
255 TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
256 '$(' { L _ ITparenEscape } -- $( exp )
257 TH_VAR_QUOTE { L _ ITvarQuote } -- 'x
258 TH_TY_QUOTE { L _ ITtyQuote } -- ''T
260 %monad { P } { >>= } { return }
261 %lexer { lexer } { L _ ITeof }
262 %name parseModule module
263 %name parseStmt maybe_stmt
264 %name parseIdentifier identifier
265 %name parseIface iface
266 %name parseType ctype
267 %tokentype { Located Token }
270 -----------------------------------------------------------------------------
273 -- The place for module deprecation is really too restrictive, but if it
274 -- was allowed at its natural place just before 'module', we get an ugly
275 -- s/r conflict with the second alternative. Another solution would be the
276 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
277 -- either, and DEPRECATED is only expected to be used by people who really
278 -- know what they are doing. :-)
280 module :: { Located (HsModule RdrName) }
281 : 'module' modid maybemoddeprec maybeexports 'where' body
282 {% fileSrcSpan >>= \ loc ->
283 return (L loc (HsModule (Just (L (getLoc $2)
284 (mkHomeModule (unLoc $2))))
285 $4 (fst $6) (snd $6) $3)) }
286 | missing_module_keyword top close
287 {% fileSrcSpan >>= \ loc ->
288 return (L loc (HsModule Nothing Nothing
289 (fst $2) (snd $2) Nothing)) }
291 missing_module_keyword :: { () }
292 : {- empty -} {% pushCurrentContext }
294 maybemoddeprec :: { Maybe DeprecTxt }
295 : '{-# DEPRECATED' STRING '#-}' { Just (getSTRING $2) }
296 | {- empty -} { Nothing }
298 body :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
300 | vocurly top close { $2 }
302 top :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
303 : importdecls { (reverse $1,[]) }
304 | importdecls ';' cvtopdecls { (reverse $1,$3) }
305 | cvtopdecls { ([],$1) }
307 cvtopdecls :: { [LHsDecl RdrName] }
308 : topdecls { cvTopDecls $1 }
310 -----------------------------------------------------------------------------
311 -- Interfaces (.hi-boot files)
313 iface :: { ModIface }
314 : 'module' modid 'where' ifacebody { mkBootIface (unLoc $2) $4 }
316 ifacebody :: { [HsDecl RdrName] }
317 : '{' ifacedecls '}' { $2 }
318 | vocurly ifacedecls close { $2 }
320 ifacedecls :: { [HsDecl RdrName] }
321 : ifacedecl ';' ifacedecls { $1 : $3 }
322 | ';' ifacedecls { $2 }
326 ifacedecl :: { HsDecl RdrName }
329 | 'type' syn_hdr '=' ctype
330 { let (tc,tvs) = $2 in TyClD (TySynonym tc tvs $4) }
331 | 'data' tycl_hdr constrs -- No deriving in hi-boot
332 { TyClD (mkTyData DataType (unLoc $2) (reverse (unLoc $3)) Nothing) }
333 | 'newtype' tycl_hdr -- Constructor is optional
334 { TyClD (mkTyData NewType (unLoc $2) [] Nothing) }
335 | 'newtype' tycl_hdr '=' newconstr
336 { TyClD (mkTyData NewType (unLoc $2) [$4] Nothing) }
337 | 'class' tycl_hdr fds
338 { TyClD (mkClassDecl (unLoc $2) (unLoc $3) [] emptyBag) }
340 -----------------------------------------------------------------------------
343 maybeexports :: { Maybe [LIE RdrName] }
344 : '(' exportlist ')' { Just $2 }
345 | {- empty -} { Nothing }
347 exportlist :: { [LIE RdrName] }
348 : exportlist ',' export { $3 : $1 }
349 | exportlist ',' { $1 }
353 -- No longer allow things like [] and (,,,) to be exported
354 -- They are built in syntax, always available
355 export :: { LIE RdrName }
356 : qvar { L1 (IEVar (unLoc $1)) }
357 | oqtycon { L1 (IEThingAbs (unLoc $1)) }
358 | oqtycon '(' '..' ')' { LL (IEThingAll (unLoc $1)) }
359 | oqtycon '(' ')' { LL (IEThingWith (unLoc $1) []) }
360 | oqtycon '(' qcnames ')' { LL (IEThingWith (unLoc $1) (reverse $3)) }
361 | 'module' modid { LL (IEModuleContents (unLoc $2)) }
363 qcnames :: { [RdrName] }
364 : qcnames ',' qcname { unLoc $3 : $1 }
365 | qcname { [unLoc $1] }
367 qcname :: { Located RdrName } -- Variable or data constructor
371 -----------------------------------------------------------------------------
372 -- Import Declarations
374 -- import decls can be *empty*, or even just a string of semicolons
375 -- whereas topdecls must contain at least one topdecl.
377 importdecls :: { [LImportDecl RdrName] }
378 : importdecls ';' importdecl { $3 : $1 }
379 | importdecls ';' { $1 }
380 | importdecl { [ $1 ] }
383 importdecl :: { LImportDecl RdrName }
384 : 'import' maybe_src optqualified modid maybeas maybeimpspec
385 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
387 maybe_src :: { IsBootInterface }
388 : '{-# SOURCE' '#-}' { True }
389 | {- empty -} { False }
391 optqualified :: { Bool }
392 : 'qualified' { True }
393 | {- empty -} { False }
395 maybeas :: { Located (Maybe ModuleName) }
396 : 'as' modid { LL (Just (unLoc $2)) }
397 | {- empty -} { noLoc Nothing }
399 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
400 : impspec { L1 (Just (unLoc $1)) }
401 | {- empty -} { noLoc Nothing }
403 impspec :: { Located (Bool, [LIE RdrName]) }
404 : '(' exportlist ')' { LL (False, reverse $2) }
405 | 'hiding' '(' exportlist ')' { LL (True, reverse $3) }
407 -----------------------------------------------------------------------------
408 -- Fixity Declarations
412 | INTEGER {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
414 infix :: { Located FixityDirection }
415 : 'infix' { L1 InfixN }
416 | 'infixl' { L1 InfixL }
417 | 'infixr' { L1 InfixR }
419 ops :: { Located [Located RdrName] }
420 : ops ',' op { LL ($3 : unLoc $1) }
423 -----------------------------------------------------------------------------
424 -- Top-Level Declarations
426 topdecls :: { OrdList (LHsDecl RdrName) } -- Reversed
427 : topdecls ';' topdecl { $1 `appOL` $3 }
428 | topdecls ';' { $1 }
431 topdecl :: { OrdList (LHsDecl RdrName) }
432 : tycl_decl { unitOL (L1 (TyClD (unLoc $1))) }
433 | 'instance' inst_type where
434 { let (binds,sigs) = cvBindsAndSigs (unLoc $3)
435 in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
436 | 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
437 | 'foreign' fdecl { unitOL (LL (unLoc $2)) }
438 | '{-# DEPRECATED' deprecations '#-}' { $2 }
439 | '{-# RULES' rules '#-}' { $2 }
440 | '$(' exp ')' { unitOL (LL $ SpliceD (SpliceDecl $2)) }
443 tycl_decl :: { LTyClDecl RdrName }
444 : 'type' syn_hdr '=' ctype
445 -- Note ctype, not sigtype.
446 -- We allow an explicit for-all but we don't insert one
447 -- in type Foo a = (b,b)
448 -- Instead we just say b is out of scope
449 { LL $ let (tc,tvs) = $2 in TySynonym tc tvs $4 }
451 | 'data' tycl_hdr constrs deriving
452 { L (comb4 $1 $2 $3 $4)
453 (mkTyData DataType (unLoc $2) (reverse (unLoc $3)) (unLoc $4)) }
455 | 'newtype' tycl_hdr '=' newconstr deriving
457 (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
459 | 'class' tycl_hdr fds where
461 (binds,sigs) = cvBindsAndSigs (unLoc $4)
463 L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs
466 syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) }
467 -- We don't retain the syntax of an infix
468 -- type synonym declaration. Oh well.
469 : tycon tv_bndrs { ($1, $2) }
470 | tv_bndr tyconop tv_bndr { ($2, [$1,$3]) }
472 -- tycl_hdr parses the header of a type or class decl,
473 -- which takes the form
476 -- (Eq a, Ord b) => T a b
477 -- Rather a lot of inlining here, else we get reduce/reduce errors
478 tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
479 : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
480 | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
482 -----------------------------------------------------------------------------
483 -- Nested declarations
485 decls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
486 : decls ';' decl { LL (unLoc $1 `appOL` unLoc $3) }
487 | decls ';' { LL (unLoc $1) }
489 | {- empty -} { noLoc nilOL }
492 decllist :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
493 : '{' decls '}' { LL (unLoc $2) }
494 | vocurly decls close { $2 }
496 where :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
497 -- No implicit parameters
498 : 'where' decllist { LL (unLoc $2) }
499 | {- empty -} { noLoc nilOL }
501 binds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
502 : decllist { L1 [cvBindGroup (unLoc $1)] }
503 | '{' dbinds '}' { LL [HsIPBinds (unLoc $2)] }
504 | vocurly dbinds close { L (getLoc $2) [HsIPBinds (unLoc $2)] }
506 wherebinds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
507 : 'where' binds { LL (unLoc $2) }
508 | {- empty -} { noLoc [] }
511 -----------------------------------------------------------------------------
512 -- Transformation Rules
514 rules :: { OrdList (LHsDecl RdrName) } -- Reversed
515 : rules ';' rule { $1 `snocOL` $3 }
518 | {- empty -} { nilOL }
520 rule :: { LHsDecl RdrName }
521 : STRING activation rule_forall infixexp '=' exp
522 { LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6) }
524 activation :: { Activation } -- Omitted means AlwaysActive
525 : {- empty -} { AlwaysActive }
526 | explicit_activation { $1 }
528 inverse_activation :: { Activation } -- Omitted means NeverActive
529 : {- empty -} { NeverActive }
530 | explicit_activation { $1 }
532 explicit_activation :: { Activation } -- In brackets
533 : '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
534 | '[' '~' INTEGER ']' { ActiveBefore (fromInteger (getINTEGER $3)) }
536 rule_forall :: { [RuleBndr RdrName] }
537 : 'forall' rule_var_list '.' { $2 }
540 rule_var_list :: { [RuleBndr RdrName] }
542 | rule_var rule_var_list { $1 : $2 }
544 rule_var :: { RuleBndr RdrName }
545 : varid { RuleBndr $1 }
546 | '(' varid '::' ctype ')' { RuleBndrSig $2 $4 }
548 -----------------------------------------------------------------------------
549 -- Deprecations (c.f. rules)
551 deprecations :: { OrdList (LHsDecl RdrName) } -- Reversed
552 : deprecations ';' deprecation { $1 `appOL` $3 }
553 | deprecations ';' { $1 }
555 | {- empty -} { nilOL }
557 -- SUP: TEMPORARY HACK, not checking for `module Foo'
558 deprecation :: { OrdList (LHsDecl RdrName) }
560 { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
564 -----------------------------------------------------------------------------
565 -- Foreign import and export declarations
567 -- for the time being, the following accepts foreign declarations conforming
568 -- to the FFI Addendum, Version 1.0 as well as pre-standard declarations
570 -- * a flag indicates whether pre-standard declarations have been used and
571 -- triggers a deprecation warning further down the road
573 -- NB: The first two rules could be combined into one by replacing `safety1'
574 -- with `safety'. However, the combined rule conflicts with the
577 fdecl :: { LHsDecl RdrName }
578 fdecl : 'import' callconv safety1 fspec
579 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
580 | 'import' callconv fspec
581 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
583 | 'export' callconv fspec
584 {% mkExport $2 (unLoc $3) >>= return.LL }
585 -- the following syntax is DEPRECATED
586 | fdecl1DEPRECATED { L1 (ForD (unLoc $1)) }
587 | fdecl2DEPRECATED { L1 (unLoc $1) }
589 fdecl1DEPRECATED :: { LForeignDecl RdrName }
591 ----------- DEPRECATED label decls ------------
592 : 'label' ext_name varid '::' sigtype
593 { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
594 (CLabel ($2 `orElse` mkExtName (unLoc $3)))) True }
596 ----------- DEPRECATED ccall/stdcall decls ------------
598 -- NB: This business with the case expression below may seem overly
599 -- complicated, but it is necessary to avoid some conflicts.
601 -- DEPRECATED variant #1: lack of a calling convention specification
603 | 'import' {-no callconv-} ext_name safety varid_no_unsafe '::' sigtype
605 target = StaticTarget ($2 `orElse` mkExtName (unLoc $4))
607 LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
608 (CFunction target)) True }
610 -- DEPRECATED variant #2: external name consists of two separate strings
611 -- (module name and function name) (import)
612 | 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype
614 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
615 CCall cconv -> return $
617 imp = CFunction (StaticTarget (getSTRING $4))
619 LL $ ForeignImport $6 $8 (CImport cconv $5 nilFS nilFS imp) True }
621 -- DEPRECATED variant #3: `unsafe' after entity
622 | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype
624 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
625 CCall cconv -> return $
627 imp = CFunction (StaticTarget (getSTRING $3))
629 LL $ ForeignImport $5 $7 (CImport cconv PlayRisky nilFS nilFS imp) True }
631 -- DEPRECATED variant #4: use of the special identifier `dynamic' without
632 -- an explicit calling convention (import)
633 | 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype
634 { LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
635 (CFunction DynamicTarget)) True }
637 -- DEPRECATED variant #5: use of the special identifier `dynamic' (import)
638 | 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype
640 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
641 CCall cconv -> return $
642 LL $ ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS
643 (CFunction DynamicTarget)) True }
645 -- DEPRECATED variant #6: lack of a calling convention specification
647 | 'export' {-no callconv-} ext_name varid '::' sigtype
648 { LL $ ForeignExport $3 $5 (CExport (CExportStatic ($2 `orElse` mkExtName (unLoc $3))
649 defaultCCallConv)) True }
651 -- DEPRECATED variant #7: external name consists of two separate strings
652 -- (module name and function name) (export)
653 | 'export' callconv STRING STRING varid '::' sigtype
655 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
656 CCall cconv -> return $
657 LL $ ForeignExport $5 $7
658 (CExport (CExportStatic (getSTRING $4) cconv)) True }
660 -- DEPRECATED variant #8: use of the special identifier `dynamic' without
661 -- an explicit calling convention (export)
662 | 'export' {-no callconv-} 'dynamic' varid '::' sigtype
663 { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
666 -- DEPRECATED variant #9: use of the special identifier `dynamic' (export)
667 | 'export' callconv 'dynamic' varid '::' sigtype
669 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
670 CCall cconv -> return $
671 LL $ ForeignImport $4 $6
672 (CImport cconv (PlaySafe False) nilFS nilFS CWrapper) True }
674 ----------- DEPRECATED .NET decls ------------
675 -- NB: removed the .NET call declaration, as it is entirely subsumed
676 -- by the new standard FFI declarations
678 fdecl2DEPRECATED :: { LHsDecl RdrName }
680 : 'import' 'dotnet' 'type' ext_name tycon { LL $ TyClD (ForeignType $5 $4 DNType) }
681 -- left this one unchanged for the moment as type imports are not
682 -- covered currently by the FFI standard -=chak
685 callconv :: { CallConv }
686 : 'stdcall' { CCall StdCallConv }
687 | 'ccall' { CCall CCallConv }
688 | 'dotnet' { DNCall }
691 : 'unsafe' { PlayRisky }
692 | 'safe' { PlaySafe False }
693 | 'threadsafe' { PlaySafe True }
694 | {- empty -} { PlaySafe False }
696 safety1 :: { Safety }
697 : 'unsafe' { PlayRisky }
698 | 'safe' { PlaySafe False }
699 | 'threadsafe' { PlaySafe True }
700 -- only needed to avoid conflicts with the DEPRECATED rules
702 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
703 : STRING var '::' sigtype { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
704 | var '::' sigtype { LL (noLoc nilFS, $1, $3) }
705 -- if the entity string is missing, it defaults to the empty string;
706 -- the meaning of an empty entity string depends on the calling
710 ext_name :: { Maybe CLabelString }
711 : STRING { Just (getSTRING $1) }
712 | STRING STRING { Just (getSTRING $2) } -- Ignore "module name" for now
713 | {- empty -} { Nothing }
716 -----------------------------------------------------------------------------
719 opt_sig :: { Maybe (LHsType RdrName) }
720 : {- empty -} { Nothing }
721 | '::' sigtype { Just $2 }
723 opt_asig :: { Maybe (LHsType RdrName) }
724 : {- empty -} { Nothing }
725 | '::' atype { Just $2 }
727 sigtypes1 :: { [LHsType RdrName] }
729 | sigtype ',' sigtypes1 { $1 : $3 }
731 sigtype :: { LHsType RdrName }
732 : ctype { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
733 -- Wrap an Implicit forall if there isn't one there already
735 sig_vars :: { Located [Located RdrName] }
736 : sig_vars ',' var { LL ($3 : unLoc $1) }
739 -----------------------------------------------------------------------------
742 -- A ctype is a for-all type
743 ctype :: { LHsType RdrName }
744 : 'forall' tv_bndrs '.' ctype { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
745 | context '=>' type { LL $ mkImplicitHsForAllTy $1 $3 }
746 -- A type of form (context => type) is an *implicit* HsForAllTy
749 -- We parse a context as a btype so that we don't get reduce/reduce
750 -- errors in ctype. The basic problem is that
752 -- looks so much like a tuple type. We can't tell until we find the =>
753 context :: { LHsContext RdrName }
754 : btype {% checkContext $1 }
756 type :: { LHsType RdrName }
757 : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
760 gentype :: { LHsType RdrName }
762 | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
763 | btype '`' tyvar '`' gentype { LL $ HsOpTy $1 $3 $5 }
764 | btype '->' gentype { LL $ HsFunTy $1 $3 }
766 btype :: { LHsType RdrName }
767 : btype atype { LL $ HsAppTy $1 $2 }
770 atype :: { LHsType RdrName }
771 : gtycon { L1 (HsTyVar (unLoc $1)) }
772 | tyvar { L1 (HsTyVar (unLoc $1)) }
773 | '(' type ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) }
774 | '(#' comma_types1 '#)' { LL $ HsTupleTy Unboxed $2 }
775 | '[' type ']' { LL $ HsListTy $2 }
776 | '[:' type ':]' { LL $ HsPArrTy $2 }
777 | '(' ctype ')' { LL $ HsParTy $2 }
778 | '(' ctype '::' kind ')' { LL $ HsKindSig $2 $4 }
780 | INTEGER { L1 (HsNumTy (getINTEGER $1)) }
782 -- An inst_type is what occurs in the head of an instance decl
783 -- e.g. (Foo a, Gaz b) => Wibble a b
784 -- It's kept as a single type, with a MonoDictTy at the right
785 -- hand corner, for convenience.
786 inst_type :: { LHsType RdrName }
787 : ctype {% checkInstType $1 }
789 inst_types1 :: { [LHsType RdrName] }
791 | inst_type ',' inst_types1 { $1 : $3 }
793 comma_types0 :: { [LHsType RdrName] }
794 : comma_types1 { $1 }
797 comma_types1 :: { [LHsType RdrName] }
799 | type ',' comma_types1 { $1 : $3 }
801 tv_bndrs :: { [LHsTyVarBndr RdrName] }
802 : tv_bndr tv_bndrs { $1 : $2 }
805 tv_bndr :: { LHsTyVarBndr RdrName }
806 : tyvar { L1 (UserTyVar (unLoc $1)) }
807 | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2) $4) }
809 fds :: { Located [Located ([RdrName], [RdrName])] }
810 : {- empty -} { noLoc [] }
811 | '|' fds1 { LL (reverse (unLoc $2)) }
813 fds1 :: { Located [Located ([RdrName], [RdrName])] }
814 : fds1 ',' fd { LL ($3 : unLoc $1) }
817 fd :: { Located ([RdrName], [RdrName]) }
818 : varids0 '->' varids0 { L (comb3 $1 $2 $3)
819 (reverse (unLoc $1), reverse (unLoc $3)) }
821 varids0 :: { Located [RdrName] }
822 : {- empty -} { noLoc [] }
823 | varids0 tyvar { LL (unLoc $2 : unLoc $1) }
825 -----------------------------------------------------------------------------
830 | akind '->' kind { mkArrowKind $1 $3 }
833 : '*' { liftedTypeKind }
834 | '(' kind ')' { $2 }
837 -----------------------------------------------------------------------------
838 -- Datatype declarations
840 newconstr :: { LConDecl RdrName }
841 : conid atype { LL $ ConDecl $1 [] (noLoc [])
842 (PrefixCon [(unbangedType $2)]) }
843 | conid '{' var '::' ctype '}'
844 { LL $ ConDecl $1 [] (noLoc [])
845 (RecCon [($3, (unbangedType $5))]) }
847 constrs :: { Located [LConDecl RdrName] }
848 : {- empty; a GHC extension -} { noLoc [] }
849 | '=' constrs1 { LL (unLoc $2) }
851 constrs1 :: { Located [LConDecl RdrName] }
852 : constrs1 '|' constr { LL ($3 : unLoc $1) }
855 constr :: { LConDecl RdrName }
856 : forall context '=>' constr_stuff
857 { let (con,details) = unLoc $4 in
858 LL (ConDecl con (unLoc $1) $2 details) }
859 | forall constr_stuff
860 { let (con,details) = unLoc $2 in
861 LL (ConDecl con (unLoc $1) (noLoc []) details) }
863 forall :: { Located [LHsTyVarBndr RdrName] }
864 : 'forall' tv_bndrs '.' { LL $2 }
865 | {- empty -} { noLoc [] }
867 constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
868 : btype {% mkPrefixCon $1 [] >>= return.LL }
869 | btype bang_atype satypes {% do { r <- mkPrefixCon $1 ($2 : unLoc $3);
870 return (L (comb3 $1 $2 $3) r) } }
871 | oqtycon '{' '}' {% mkRecCon $1 [] >>= return.LL }
872 | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL }
873 | sbtype conop sbtype { LL ($2, InfixCon $1 $3) }
875 bang_atype :: { LBangType RdrName }
876 : strict_mark atype { LL (BangType (unLoc $1) $2) }
878 satypes :: { Located [LBangType RdrName] }
879 : atype satypes { LL (unbangedType $1 : unLoc $2) }
880 | bang_atype satypes { LL ($1 : unLoc $2) }
881 | {- empty -} { noLoc [] }
883 sbtype :: { LBangType RdrName }
884 : btype { unbangedType $1 }
885 | strict_mark atype { LL (BangType (unLoc $1) $2) }
887 fielddecls :: { [([Located RdrName], LBangType RdrName)] }
888 : fielddecl ',' fielddecls { unLoc $1 : $3 }
889 | fielddecl { [unLoc $1] }
891 fielddecl :: { Located ([Located RdrName], LBangType RdrName) }
892 : sig_vars '::' stype { LL (reverse (unLoc $1), $3) }
894 stype :: { LBangType RdrName }
895 : ctype { unbangedType $1 }
896 | strict_mark atype { LL (BangType (unLoc $1) $2) }
898 strict_mark :: { Located HsBang }
899 : '!' { L1 HsStrict }
900 | '{-# UNPACK' '#-}' '!' { LL HsUnbox }
902 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
903 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
904 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
905 -- We don't allow a context, but that's sorted out by the type checker.
906 deriving :: { Located (Maybe [LHsType RdrName]) }
907 : {- empty -} { noLoc Nothing }
908 | 'deriving' qtycon {% do { let { L loc tv = $2 }
909 ; p <- checkInstType (L loc (HsTyVar tv))
910 ; return (LL (Just [p])) } }
911 | 'deriving' '(' ')' { LL (Just []) }
912 | 'deriving' '(' inst_types1 ')' { LL (Just $3) }
913 -- Glasgow extension: allow partial
914 -- applications in derivings
916 -----------------------------------------------------------------------------
919 {- There's an awkward overlap with a type signature. Consider
920 f :: Int -> Int = ...rhs...
921 Then we can't tell whether it's a type signature or a value
922 definition with a result signature until we see the '='.
923 So we have to inline enough to postpone reductions until we know.
927 ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
928 instead of qvar, we get another shift/reduce-conflict. Consider the
931 { (^^) :: Int->Int ; } Type signature; only var allowed
933 { (^^) :: Int->Int = ... ; } Value defn with result signature;
934 qvar allowed (because of instance decls)
936 We can't tell whether to reduce var to qvar until after we've read the signatures.
939 decl :: { Located (OrdList (LHsDecl RdrName)) }
941 | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 (unLoc $3);
942 return (LL $ unitOL (LL $ ValD r)) } }
944 rhs :: { Located (GRHSs RdrName) }
945 : '=' exp wherebinds { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) placeHolderType }
946 | gdrhs wherebinds { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) placeHolderType }
948 gdrhs :: { Located [LGRHS RdrName] }
949 : gdrhs gdrh { LL ($2 : unLoc $1) }
952 gdrh :: { LGRHS RdrName }
953 : '|' quals '=' exp { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) :
956 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
957 : infixexp '::' sigtype
958 {% do s <- checkValSig $1 $3;
959 return (LL $ unitOL (LL $ SigD s)) }
960 -- See the above notes for why we need infixexp here
961 | var ',' sig_vars '::' sigtype
962 { LL $ toOL [ LL $ SigD (Sig n $5) | n <- $1 : unLoc $3 ] }
963 | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
965 | '{-# INLINE' activation qvar '#-}'
966 { LL $ unitOL (LL $ SigD (InlineSig True $3 $2)) }
967 | '{-# NOINLINE' inverse_activation qvar '#-}'
968 { LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) }
969 | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
970 { LL $ toOL [ LL $ SigD (SpecSig $2 t)
972 | '{-# SPECIALISE' 'instance' inst_type '#-}'
973 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
975 -----------------------------------------------------------------------------
978 exp :: { LHsExpr RdrName }
979 : infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
980 | fexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
981 | fexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
982 | fexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
983 | fexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
986 infixexp :: { LHsExpr RdrName }
988 | infixexp qop exp10 { LL (OpApp $1 $2 (panic "fixity") $3) }
990 exp10 :: { LHsExpr RdrName }
991 : '\\' aexp aexps opt_asig '->' exp
992 {% checkPatterns ($2 : reverse $3) >>= \ ps ->
993 return (LL $ HsLam (LL $ Match ps $4
994 (GRHSs (unguardedRHS $6) []
996 | 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
997 | 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 }
998 | 'case' exp 'of' altslist { LL $ HsCase $2 (unLoc $4) }
999 | '-' fexp { LL $ mkHsNegApp $2 }
1001 | 'do' stmtlist {% let loc = comb2 $1 $2 in
1002 checkDo loc (unLoc $2) >>= \ stmts ->
1003 return (L loc (mkHsDo DoExpr stmts)) }
1004 | 'mdo' stmtlist {% let loc = comb2 $1 $2 in
1005 checkMDo loc (unLoc $2) >>= \ stmts ->
1006 return (L loc (mkHsDo MDoExpr stmts)) }
1008 | scc_annot exp { LL $ if opt_SccProfilingOn
1009 then HsSCC (unLoc $1) $2
1012 | 'proc' aexp '->' exp
1013 {% checkPattern $2 >>= \ p ->
1014 return (LL $ HsProc p (LL $ HsCmdTop $4 []
1015 placeHolderType undefined)) }
1016 -- TODO: is LL right here?
1018 | '{-# CORE' STRING '#-}' exp { LL $ HsCoreAnn (getSTRING $2) $4 }
1019 -- hdaume: core annotation
1022 scc_annot :: { Located FastString }
1023 : '_scc_' STRING { LL $ getSTRING $2 }
1024 | '{-# SCC' STRING '#-}' { LL $ getSTRING $2 }
1026 fexp :: { LHsExpr RdrName }
1027 : fexp aexp { LL $ HsApp $1 $2 }
1030 aexps :: { [LHsExpr RdrName] }
1031 : aexps aexp { $2 : $1 }
1032 | {- empty -} { [] }
1034 aexp :: { LHsExpr RdrName }
1035 : qvar '@' aexp { LL $ EAsPat $1 $3 }
1036 | '~' aexp { LL $ ELazyPat $2 }
1039 aexp1 :: { LHsExpr RdrName }
1040 : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
1045 -- Here was the syntax for type applications that I was planning
1046 -- but there are difficulties (e.g. what order for type args)
1047 -- so it's not enabled yet.
1048 -- But this case *is* used for the left hand side of a generic definition,
1049 -- which is parsed as an expression before being munged into a pattern
1050 | qcname '{|' gentype '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1051 (sL (getLoc $3) (HsType $3)) }
1053 aexp2 :: { LHsExpr RdrName }
1054 : ipvar { L1 (HsIPVar $! unLoc $1) }
1055 | qcname { L1 (HsVar $! unLoc $1) }
1056 | literal { L1 (HsLit $! unLoc $1) }
1057 | INTEGER { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
1058 | RATIONAL { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
1059 | '(' exp ')' { LL (HsPar $2) }
1060 | '(' exp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1061 | '(#' texps '#)' { LL $ ExplicitTuple (reverse $2) Unboxed }
1062 | '[' list ']' { LL (unLoc $2) }
1063 | '[:' parr ':]' { LL (unLoc $2) }
1064 | '(' infixexp qop ')' { LL $ SectionL $2 $3 }
1065 | '(' qopm infixexp ')' { LL $ SectionR $2 $3 }
1066 | '_' { L1 EWildPat }
1068 -- MetaHaskell Extension
1069 | TH_ID_SPLICE { L1 $ HsSpliceE (mkHsSplice
1070 (L1 $ HsVar (mkUnqual varName
1071 (getTH_ID_SPLICE $1)))) } -- $x
1072 | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
1074 | TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
1075 | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
1076 | TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
1077 | TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) }
1078 | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
1079 | '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
1080 | '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
1081 return (LL $ HsBracket (PatBr p)) }
1082 | '[d|' cvtopbody '|]' { LL $ HsBracket (DecBr (mkGroup $2)) }
1084 -- arrow notation extension
1085 | '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
1087 cmdargs :: { [LHsCmdTop RdrName] }
1088 : cmdargs acmd { $2 : $1 }
1089 | {- empty -} { [] }
1091 acmd :: { LHsCmdTop RdrName }
1092 : aexp2 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1094 cvtopbody :: { [LHsDecl RdrName] }
1095 : '{' cvtopdecls0 '}' { $2 }
1096 | vocurly cvtopdecls0 close { $2 }
1098 cvtopdecls0 :: { [LHsDecl RdrName] }
1099 : {- empty -} { [] }
1102 texps :: { [LHsExpr RdrName] }
1103 : texps ',' exp { $3 : $1 }
1107 -----------------------------------------------------------------------------
1110 -- The rules below are little bit contorted to keep lexps left-recursive while
1111 -- avoiding another shift/reduce-conflict.
1113 list :: { LHsExpr RdrName }
1114 : exp { L1 $ ExplicitList placeHolderType [$1] }
1115 | lexps { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1116 | exp '..' { LL $ ArithSeqIn (From $1) }
1117 | exp ',' exp '..' { LL $ ArithSeqIn (FromThen $1 $3) }
1118 | exp '..' exp { LL $ ArithSeqIn (FromTo $1 $3) }
1119 | exp ',' exp '..' exp { LL $ ArithSeqIn (FromThenTo $1 $3 $5) }
1120 | exp pquals { LL $ mkHsDo ListComp
1121 (reverse (L (getLoc $1) (ResultStmt $1) :
1124 lexps :: { Located [LHsExpr RdrName] }
1125 : lexps ',' exp { LL ($3 : unLoc $1) }
1126 | exp ',' exp { LL [$3,$1] }
1128 -----------------------------------------------------------------------------
1129 -- List Comprehensions
1131 pquals :: { Located [LStmt RdrName] } -- Either a singleton ParStmt,
1132 -- or a reversed list of Stmts
1133 : pquals1 { case unLoc $1 of
1135 qss -> L1 [L1 (ParStmt stmtss)]
1137 stmtss = [ (reverse qs, undefined)
1141 pquals1 :: { Located [[LStmt RdrName]] }
1142 : pquals1 '|' quals { LL (unLoc $3 : unLoc $1) }
1143 | '|' quals { L (getLoc $2) [unLoc $2] }
1145 quals :: { Located [LStmt RdrName] }
1146 : quals ',' qual { LL ($3 : unLoc $1) }
1149 -----------------------------------------------------------------------------
1150 -- Parallel array expressions
1152 -- The rules below are little bit contorted; see the list case for details.
1153 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1154 -- Moreover, we allow explicit arrays with no element (represented by the nil
1155 -- constructor in the list case).
1157 parr :: { LHsExpr RdrName }
1158 : { noLoc (ExplicitPArr placeHolderType []) }
1159 | exp { L1 $ ExplicitPArr placeHolderType [$1] }
1160 | lexps { L1 $ ExplicitPArr placeHolderType
1161 (reverse (unLoc $1)) }
1162 | exp '..' exp { LL $ PArrSeqIn (FromTo $1 $3) }
1163 | exp ',' exp '..' exp { LL $ PArrSeqIn (FromThenTo $1 $3 $5) }
1164 | exp pquals { LL $ mkHsDo PArrComp
1165 (reverse (L (getLoc $1) (ResultStmt $1) :
1169 -- We are reusing `lexps' and `pquals' from the list case.
1171 -----------------------------------------------------------------------------
1172 -- Case alternatives
1174 altslist :: { Located [LMatch RdrName] }
1175 : '{' alts '}' { LL (reverse (unLoc $2)) }
1176 | vocurly alts close { L (getLoc $2) (reverse (unLoc $2)) }
1178 alts :: { Located [LMatch RdrName] }
1179 : alts1 { L1 (unLoc $1) }
1180 | ';' alts { LL (unLoc $2) }
1182 alts1 :: { Located [LMatch RdrName] }
1183 : alts1 ';' alt { LL ($3 : unLoc $1) }
1184 | alts1 ';' { LL (unLoc $1) }
1187 alt :: { LMatch RdrName }
1188 : infixexp opt_sig alt_rhs {% checkPattern $1 >>= \p ->
1189 return (LL (Match [p] $2 (unLoc $3))) }
1191 alt_rhs :: { Located (GRHSs RdrName) }
1192 : ralt wherebinds { LL (GRHSs (unLoc $1) (unLoc $2)
1195 ralt :: { Located [LGRHS RdrName] }
1196 : '->' exp { LL (unguardedRHS $2) }
1197 | gdpats { L1 (reverse (unLoc $1)) }
1199 gdpats :: { Located [LGRHS RdrName] }
1200 : gdpats gdpat { LL ($2 : unLoc $1) }
1203 gdpat :: { LGRHS RdrName }
1204 : '|' quals '->' exp { let r = L (getLoc $4) (ResultStmt $4)
1205 in LL $ GRHS (reverse (r : unLoc $2)) }
1207 -----------------------------------------------------------------------------
1208 -- Statement sequences
1210 stmtlist :: { Located [LStmt RdrName] }
1211 : '{' stmts '}' { LL (unLoc $2) }
1212 | vocurly stmts close { $2 }
1214 -- do { ;; s ; s ; ; s ;; }
1215 -- The last Stmt should be a ResultStmt, but that's hard to enforce
1216 -- here, because we need too much lookahead if we see do { e ; }
1217 -- So we use ExprStmts throughout, and switch the last one over
1218 -- in ParseUtils.checkDo instead
1219 stmts :: { Located [LStmt RdrName] }
1220 : stmt stmts_help { LL ($1 : unLoc $2) }
1221 | ';' stmts { LL (unLoc $2) }
1222 | {- empty -} { noLoc [] }
1224 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1225 : ';' stmts { LL (unLoc $2) }
1226 | {- empty -} { noLoc [] }
1228 -- For typing stmts at the GHCi prompt, where
1229 -- the input may consist of just comments.
1230 maybe_stmt :: { Maybe (LStmt RdrName) }
1232 | {- nothing -} { Nothing }
1234 stmt :: { LStmt RdrName }
1236 | infixexp '->' exp {% checkPattern $3 >>= \p ->
1237 return (LL $ BindStmt p $1) }
1238 | 'rec' stmtlist { LL $ RecStmt (unLoc $2) undefined undefined undefined }
1240 qual :: { LStmt RdrName }
1241 : infixexp '<-' exp {% checkPattern $1 >>= \p ->
1242 return (LL $ BindStmt p $3) }
1243 | exp { L1 $ ExprStmt $1 placeHolderType }
1244 | 'let' binds { LL $ LetStmt (unLoc $2) }
1246 -----------------------------------------------------------------------------
1247 -- Record Field Update/Construction
1249 fbinds :: { HsRecordBinds RdrName }
1251 | {- empty -} { [] }
1253 fbinds1 :: { HsRecordBinds RdrName }
1254 : fbinds1 ',' fbind { $3 : $1 }
1257 fbind :: { (Located RdrName, LHsExpr RdrName) }
1258 : qvar '=' exp { ($1,$3) }
1260 -----------------------------------------------------------------------------
1261 -- Implicit Parameter Bindings
1263 dbinds :: { Located [LIPBind RdrName] }
1264 : dbinds ';' dbind { LL ($3 : unLoc $1) }
1265 | dbinds ';' { LL (unLoc $1) }
1267 -- | {- empty -} { [] }
1269 dbind :: { LIPBind RdrName }
1270 dbind : ipvar '=' exp { LL (IPBind (unLoc $1) $3) }
1272 -----------------------------------------------------------------------------
1273 -- Variables, Constructors and Operators.
1275 identifier :: { Located RdrName }
1281 depreclist :: { Located [RdrName] }
1282 depreclist : deprec_var { L1 [unLoc $1] }
1283 | deprec_var ',' depreclist { LL (unLoc $1 : unLoc $3) }
1285 deprec_var :: { Located RdrName }
1286 deprec_var : var { $1 }
1289 gcon :: { Located RdrName } -- Data constructor namespace
1290 : sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
1292 -- the case of '[:' ':]' is part of the production `parr'
1294 sysdcon :: { Located DataCon } -- Wired in data constructors
1295 : '(' ')' { LL unitDataCon }
1296 | '(' commas ')' { LL $ tupleCon Boxed $2 }
1297 | '[' ']' { LL nilDataCon }
1299 var :: { Located RdrName }
1301 | '(' varsym ')' { LL (unLoc $2) }
1303 qvar :: { Located RdrName }
1305 | '(' varsym ')' { LL (unLoc $2) }
1306 | '(' qvarsym1 ')' { LL (unLoc $2) }
1307 -- We've inlined qvarsym here so that the decision about
1308 -- whether it's a qvar or a var can be postponed until
1309 -- *after* we see the close paren.
1311 ipvar :: { Located (IPName RdrName) }
1312 : IPDUPVARID { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
1313 | IPSPLITVARID { L1 (Linear (mkUnqual varName (getIPSPLITVARID $1))) }
1315 qcon :: { Located RdrName }
1317 | '(' qconsym ')' { LL (unLoc $2) }
1319 varop :: { Located RdrName }
1321 | '`' varid '`' { LL (unLoc $2) }
1323 qvarop :: { Located RdrName }
1325 | '`' qvarid '`' { LL (unLoc $2) }
1327 qvaropm :: { Located RdrName }
1328 : qvarsym_no_minus { $1 }
1329 | '`' qvarid '`' { LL (unLoc $2) }
1331 conop :: { Located RdrName }
1333 | '`' conid '`' { LL (unLoc $2) }
1335 qconop :: { Located RdrName }
1337 | '`' qconid '`' { LL (unLoc $2) }
1339 -----------------------------------------------------------------------------
1340 -- Type constructors
1342 gtycon :: { Located RdrName } -- A "general" qualified tycon
1344 | '(' ')' { LL $ getRdrName unitTyCon }
1345 | '(' commas ')' { LL $ getRdrName (tupleTyCon Boxed $2) }
1346 | '(' '->' ')' { LL $ getRdrName funTyCon }
1347 | '[' ']' { LL $ listTyCon_RDR }
1348 | '[:' ':]' { LL $ parrTyCon_RDR }
1350 oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon
1352 | '(' qtyconsym ')' { LL (unLoc $2) }
1354 qtyconop :: { Located RdrName } -- Qualified or unqualified
1356 | '`' qtycon '`' { LL (unLoc $2) }
1358 tyconop :: { Located RdrName } -- Unqualified
1360 | '`' tycon '`' { LL (unLoc $2) }
1362 qtycon :: { Located RdrName } -- Qualified or unqualified
1363 : QCONID { L1 $! mkQual tcClsName (getQCONID $1) }
1366 tycon :: { Located RdrName } -- Unqualified
1367 : CONID { L1 $! mkUnqual tcClsName (getCONID $1) }
1369 qtyconsym :: { Located RdrName }
1370 : QCONSYM { L1 $! mkQual tcClsName (getQCONSYM $1) }
1373 tyconsym :: { Located RdrName }
1374 : CONSYM { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1376 -----------------------------------------------------------------------------
1379 op :: { Located RdrName } -- used in infix decls
1383 qop :: { LHsExpr RdrName } -- used in sections
1384 : qvarop { L1 $ HsVar (unLoc $1) }
1385 | qconop { L1 $ HsVar (unLoc $1) }
1387 qopm :: { LHsExpr RdrName } -- used in sections
1388 : qvaropm { L1 $ HsVar (unLoc $1) }
1389 | qconop { L1 $ HsVar (unLoc $1) }
1391 -----------------------------------------------------------------------------
1394 qvarid :: { Located RdrName }
1396 | QVARID { L1 $ mkQual varName (getQVARID $1) }
1398 varid :: { Located RdrName }
1399 : varid_no_unsafe { $1 }
1400 | 'unsafe' { L1 $! mkUnqual varName FSLIT("unsafe") }
1401 | 'safe' { L1 $! mkUnqual varName FSLIT("safe") }
1402 | 'threadsafe' { L1 $! mkUnqual varName FSLIT("threadsafe") }
1404 varid_no_unsafe :: { Located RdrName }
1405 : VARID { L1 $! mkUnqual varName (getVARID $1) }
1406 | special_id { L1 $! mkUnqual varName (unLoc $1) }
1407 | 'forall' { L1 $! mkUnqual varName FSLIT("forall") }
1409 tyvar :: { Located RdrName }
1410 : VARID { L1 $! mkUnqual tvName (getVARID $1) }
1411 | special_id { L1 $! mkUnqual tvName (unLoc $1) }
1412 | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") }
1413 | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") }
1414 | 'threadsafe' { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1416 -- These special_ids are treated as keywords in various places,
1417 -- but as ordinary ids elsewhere. 'special_id' collects all these
1418 -- except 'unsafe' and 'forall' whose treatment differs depending on context
1419 special_id :: { Located UserFS }
1421 : 'as' { L1 FSLIT("as") }
1422 | 'qualified' { L1 FSLIT("qualified") }
1423 | 'hiding' { L1 FSLIT("hiding") }
1424 | 'export' { L1 FSLIT("export") }
1425 | 'label' { L1 FSLIT("label") }
1426 | 'dynamic' { L1 FSLIT("dynamic") }
1427 | 'stdcall' { L1 FSLIT("stdcall") }
1428 | 'ccall' { L1 FSLIT("ccall") }
1430 -----------------------------------------------------------------------------
1433 qvarsym :: { Located RdrName }
1437 qvarsym_no_minus :: { Located RdrName }
1438 : varsym_no_minus { $1 }
1441 qvarsym1 :: { Located RdrName }
1442 qvarsym1 : QVARSYM { L1 $ mkQual varName (getQVARSYM $1) }
1444 varsym :: { Located RdrName }
1445 : varsym_no_minus { $1 }
1446 | '-' { L1 $ mkUnqual varName FSLIT("-") }
1448 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1449 : VARSYM { L1 $ mkUnqual varName (getVARSYM $1) }
1450 | special_sym { L1 $ mkUnqual varName (unLoc $1) }
1453 -- See comments with special_id
1454 special_sym :: { Located UserFS }
1455 special_sym : '!' { L1 FSLIT("!") }
1456 | '.' { L1 FSLIT(".") }
1457 | '*' { L1 FSLIT("*") }
1459 -----------------------------------------------------------------------------
1460 -- Data constructors
1462 qconid :: { Located RdrName } -- Qualified or unqualifiedb
1464 | QCONID { L1 $ mkQual dataName (getQCONID $1) }
1466 conid :: { Located RdrName }
1467 : CONID { L1 $ mkUnqual dataName (getCONID $1) }
1469 qconsym :: { Located RdrName } -- Qualified or unqualified
1471 | QCONSYM { L1 $ mkQual dataName (getQCONSYM $1) }
1473 consym :: { Located RdrName }
1474 : CONSYM { L1 $ mkUnqual dataName (getCONSYM $1) }
1476 -- ':' means only list cons
1477 | ':' { L1 $ consDataCon_RDR }
1480 -----------------------------------------------------------------------------
1483 literal :: { Located HsLit }
1484 : CHAR { L1 $ HsChar $ getCHAR $1 }
1485 | STRING { L1 $ HsString $ getSTRING $1 }
1486 | PRIMINTEGER { L1 $ HsIntPrim $ getPRIMINTEGER $1 }
1487 | PRIMCHAR { L1 $ HsCharPrim $ getPRIMCHAR $1 }
1488 | PRIMSTRING { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1489 | PRIMFLOAT { L1 $ HsFloatPrim $ getPRIMFLOAT $1 }
1490 | PRIMDOUBLE { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1492 -----------------------------------------------------------------------------
1496 : vccurly { () } -- context popped in lexer.
1497 | error {% popContext }
1499 -----------------------------------------------------------------------------
1500 -- Miscellaneous (mostly renamings)
1502 modid :: { Located ModuleName }
1503 : CONID { L1 $ mkModuleNameFS (getCONID $1) }
1504 | QCONID { L1 $ let (mod,c) = getQCONID $1 in
1507 (unpackFS mod ++ '.':unpackFS c))
1511 : commas ',' { $1 + 1 }
1514 -----------------------------------------------------------------------------
1518 happyError = srcParseFail
1520 getVARID (L _ (ITvarid x)) = x
1521 getCONID (L _ (ITconid x)) = x
1522 getVARSYM (L _ (ITvarsym x)) = x
1523 getCONSYM (L _ (ITconsym x)) = x
1524 getQVARID (L _ (ITqvarid x)) = x
1525 getQCONID (L _ (ITqconid x)) = x
1526 getQVARSYM (L _ (ITqvarsym x)) = x
1527 getQCONSYM (L _ (ITqconsym x)) = x
1528 getIPDUPVARID (L _ (ITdupipvarid x)) = x
1529 getIPSPLITVARID (L _ (ITsplitipvarid x)) = x
1530 getCHAR (L _ (ITchar x)) = x
1531 getSTRING (L _ (ITstring x)) = x
1532 getINTEGER (L _ (ITinteger x)) = x
1533 getRATIONAL (L _ (ITrational x)) = x
1534 getPRIMCHAR (L _ (ITprimchar x)) = x
1535 getPRIMSTRING (L _ (ITprimstring x)) = x
1536 getPRIMINTEGER (L _ (ITprimint x)) = x
1537 getPRIMFLOAT (L _ (ITprimfloat x)) = x
1538 getPRIMDOUBLE (L _ (ITprimdouble x)) = x
1539 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1541 -- Utilities for combining source spans
1542 comb2 :: Located a -> Located b -> SrcSpan
1545 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1546 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1548 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1549 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1550 combineSrcSpans (getLoc c) (getLoc d)
1552 -- strict constructor version:
1554 sL :: SrcSpan -> a -> Located a
1555 sL span a = span `seq` L span a
1557 -- Make a source location that is just the filename. This seems slightly
1558 -- neater than trying to construct the span of the text within the file.
1559 fileSrcSpan :: P SrcSpan
1560 fileSrcSpan = do l <- getSrcLoc; return (mkGeneralSrcSpan (srcLocFile l))