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, srcLocFile,
33 import CmdLineOpts ( opt_SccProfilingOn )
34 import Type ( Kind, mkArrowKind, liftedTypeKind )
35 import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
38 import Bag ( emptyBag )
41 import CStrings ( CLabelString )
43 import Maybes ( orElse )
49 -----------------------------------------------------------------------------
50 Conflicts: 29 shift/reduce, [SDM 19/9/2002]
52 10 for abiguity in 'if x then y else z + 1' [State 136]
53 (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
54 10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
56 1 for ambiguity in 'if x then y else z with ?x=3' [State 136]
57 (shift parses as 'if x then y else (z with ?x=3)'
59 1 for ambiguity in 'if x then y else z :: T' [State 136]
60 (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
62 8 for ambiguity in 'e :: a `b` c'. Does this mean [States 160,246]
66 1 for ambiguity in 'let ?x ...' [State 268]
67 the parser can't tell whether the ?x is the lhs of a normal binding or
68 an implicit binding. Fortunately resolving as shift gives it the only
69 sensible meaning, namely the lhs of an implicit binding.
71 1 for ambiguity in '{-# RULES "name" [ ... #-} [State 332]
72 we don't know whether the '[' starts the activation or not: it
73 might be the start of the declaration with the activation being
76 1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 394]
77 since 'forall' is a valid variable name, we don't know whether
78 to treat a forall on the input as the beginning of a quantifier
79 or the beginning of the rule itself. Resolving to shift means
80 it's always treated as a quantifier, hence the above is disallowed.
81 This saves explicitly defining a grammar for the rule lhs that
82 doesn't include 'forall'.
84 6 for conflicts between `fdecl' and `fdeclDEPRECATED', [States 384,385]
85 which are resolved correctly, and moreover,
86 should go away when `fdeclDEPRECATED' is removed.
88 -- ---------------------------------------------------------------------------
89 -- Adding location info
91 This is done in a stylised way using the three macros below, L0, L1
92 and LL. Each of these macros can be thought of as having type
94 L0, L1, LL :: a -> Located a
96 They each add a SrcSpan to their argument.
98 L0 adds 'noSrcSpan', used for empty productions
100 L1 for a production with a single token on the lhs. Grabs the SrcSpan
103 LL for a production with >1 token on the lhs. Makes up a SrcSpan from
104 the first and last tokens.
106 These suffice for the majority of cases. However, we must be
107 especially careful with empty productions: LL won't work if the first
108 or last token on the lhs can represent an empty span. In these cases,
109 we have to calculate the span using more of the tokens from the lhs, eg.
111 | 'newtype' tycl_hdr '=' newconstr deriving
113 (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
115 We provide comb3 and comb4 functions which are useful in such cases.
117 Be careful: there's no checking that you actually got this right, the
118 only symptom will be that the SrcSpans of your syntax will be
122 * We must expand these macros *before* running Happy, which is why this file is
123 * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
125 #define L0 L noSrcSpan
126 #define L1 sL (getLoc $1)
127 #define LL sL (comb2 $1 $>)
129 -- -----------------------------------------------------------------------------
134 '_' { L _ ITunderscore } -- Haskell keywords
136 'case' { L _ ITcase }
137 'class' { L _ ITclass }
138 'data' { L _ ITdata }
139 'default' { L _ ITdefault }
140 'deriving' { L _ ITderiving }
142 'else' { L _ ITelse }
143 'hiding' { L _ IThiding }
145 'import' { L _ ITimport }
147 'infix' { L _ ITinfix }
148 'infixl' { L _ ITinfixl }
149 'infixr' { L _ ITinfixr }
150 'instance' { L _ ITinstance }
152 'module' { L _ ITmodule }
153 'newtype' { L _ ITnewtype }
155 'qualified' { L _ ITqualified }
156 'then' { L _ ITthen }
157 'type' { L _ ITtype }
158 'where' { L _ ITwhere }
159 '_scc_' { L _ ITscc } -- ToDo: remove
161 'forall' { L _ ITforall } -- GHC extension keywords
162 'foreign' { L _ ITforeign }
163 'export' { L _ ITexport }
164 'label' { L _ ITlabel }
165 'dynamic' { L _ ITdynamic }
166 'safe' { L _ ITsafe }
167 'threadsafe' { L _ ITthreadsafe }
168 'unsafe' { L _ ITunsafe }
170 'stdcall' { L _ ITstdcallconv }
171 'ccall' { L _ ITccallconv }
172 'dotnet' { L _ ITdotnet }
173 'proc' { L _ ITproc } -- for arrow notation extension
174 'rec' { L _ ITrec } -- for arrow notation extension
176 '{-# SPECIALISE' { L _ ITspecialise_prag }
177 '{-# SOURCE' { L _ ITsource_prag }
178 '{-# INLINE' { L _ ITinline_prag }
179 '{-# NOINLINE' { L _ ITnoinline_prag }
180 '{-# RULES' { L _ ITrules_prag }
181 '{-# CORE' { L _ ITcore_prag } -- hdaume: annotated core
182 '{-# SCC' { L _ ITscc_prag }
183 '{-# DEPRECATED' { L _ ITdeprecated_prag }
184 '{-# UNPACK' { L _ ITunpack_prag }
185 '#-}' { L _ ITclose_prag }
187 '..' { L _ ITdotdot } -- reserved symbols
189 '::' { L _ ITdcolon }
193 '<-' { L _ ITlarrow }
194 '->' { L _ ITrarrow }
197 '=>' { L _ ITdarrow }
201 '-<' { L _ ITlarrowtail } -- for arrow notation
202 '>-' { L _ ITrarrowtail } -- for arrow notation
203 '-<<' { L _ ITLarrowtail } -- for arrow notation
204 '>>-' { L _ ITRarrowtail } -- for arrow notation
207 '{' { L _ ITocurly } -- special symbols
209 '{|' { L _ ITocurlybar }
210 '|}' { L _ ITccurlybar }
211 vocurly { L _ ITvocurly } -- virtual open curly (from layout)
212 vccurly { L _ ITvccurly } -- virtual close curly (from layout)
215 '[:' { L _ ITopabrack }
216 ':]' { L _ ITcpabrack }
219 '(#' { L _ IToubxparen }
220 '#)' { L _ ITcubxparen }
221 '(|' { L _ IToparenbar }
222 '|)' { L _ ITcparenbar }
225 '`' { L _ ITbackquote }
227 VARID { L _ (ITvarid _) } -- identifiers
228 CONID { L _ (ITconid _) }
229 VARSYM { L _ (ITvarsym _) }
230 CONSYM { L _ (ITconsym _) }
231 QVARID { L _ (ITqvarid _) }
232 QCONID { L _ (ITqconid _) }
233 QVARSYM { L _ (ITqvarsym _) }
234 QCONSYM { L _ (ITqconsym _) }
236 IPDUPVARID { L _ (ITdupipvarid _) } -- GHC extension
237 IPSPLITVARID { L _ (ITsplitipvarid _) } -- GHC extension
239 CHAR { L _ (ITchar _) }
240 STRING { L _ (ITstring _) }
241 INTEGER { L _ (ITinteger _) }
242 RATIONAL { L _ (ITrational _) }
244 PRIMCHAR { L _ (ITprimchar _) }
245 PRIMSTRING { L _ (ITprimstring _) }
246 PRIMINTEGER { L _ (ITprimint _) }
247 PRIMFLOAT { L _ (ITprimfloat _) }
248 PRIMDOUBLE { L _ (ITprimdouble _) }
251 '[|' { L _ ITopenExpQuote }
252 '[p|' { L _ ITopenPatQuote }
253 '[t|' { L _ ITopenTypQuote }
254 '[d|' { L _ ITopenDecQuote }
255 '|]' { L _ ITcloseQuote }
256 TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
257 '$(' { L _ ITparenEscape } -- $( exp )
258 TH_VAR_QUOTE { L _ ITvarQuote } -- 'x
259 TH_TY_QUOTE { L _ ITtyQuote } -- ''T
261 %monad { P } { >>= } { return }
262 %lexer { lexer } { L _ ITeof }
263 %name parseModule module
264 %name parseStmt maybe_stmt
265 %name parseIdentifier identifier
266 %name parseIface iface
267 %name parseType ctype
268 %tokentype { Located Token }
271 -----------------------------------------------------------------------------
274 -- The place for module deprecation is really too restrictive, but if it
275 -- was allowed at its natural place just before 'module', we get an ugly
276 -- s/r conflict with the second alternative. Another solution would be the
277 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
278 -- either, and DEPRECATED is only expected to be used by people who really
279 -- know what they are doing. :-)
281 module :: { Located (HsModule RdrName) }
282 : 'module' modid maybemoddeprec maybeexports 'where' body
283 {% fileSrcSpan >>= \ loc ->
284 return (L loc (HsModule (Just (L (getLoc $2)
285 (mkHomeModule (unLoc $2))))
286 $4 (fst $6) (snd $6) $3)) }
287 | missing_module_keyword top close
288 {% fileSrcSpan >>= \ loc ->
289 return (L loc (HsModule Nothing Nothing
290 (fst $2) (snd $2) Nothing)) }
292 missing_module_keyword :: { () }
293 : {- empty -} {% pushCurrentContext }
295 maybemoddeprec :: { Maybe DeprecTxt }
296 : '{-# DEPRECATED' STRING '#-}' { Just (getSTRING $2) }
297 | {- empty -} { Nothing }
299 body :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
301 | vocurly top close { $2 }
303 top :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
304 : importdecls { (reverse $1,[]) }
305 | importdecls ';' cvtopdecls { (reverse $1,$3) }
306 | cvtopdecls { ([],$1) }
308 cvtopdecls :: { [LHsDecl RdrName] }
309 : topdecls { cvTopDecls $1 }
311 -----------------------------------------------------------------------------
312 -- Interfaces (.hi-boot files)
314 iface :: { ModIface }
315 : 'module' modid 'where' ifacebody { mkBootIface (unLoc $2) $4 }
317 ifacebody :: { [HsDecl RdrName] }
318 : '{' ifacedecls '}' { $2 }
319 | vocurly ifacedecls close { $2 }
321 ifacedecls :: { [HsDecl RdrName] }
322 : ifacedecl ';' ifacedecls { $1 : $3 }
323 | ';' ifacedecls { $2 }
327 ifacedecl :: { HsDecl RdrName }
330 | 'type' syn_hdr '=' ctype
331 { let (tc,tvs) = $2 in TyClD (TySynonym tc tvs $4) }
332 | 'data' tycl_hdr constrs -- No deriving in hi-boot
333 { TyClD (mkTyData DataType (unLoc $2) (reverse (unLoc $3)) Nothing) }
334 | 'newtype' tycl_hdr -- Constructor is optional
335 { TyClD (mkTyData NewType (unLoc $2) [] Nothing) }
336 | 'newtype' tycl_hdr '=' newconstr
337 { TyClD (mkTyData NewType (unLoc $2) [$4] Nothing) }
338 | 'class' tycl_hdr fds
339 { TyClD (mkClassDecl (unLoc $2) (unLoc $3) [] emptyBag) }
341 -----------------------------------------------------------------------------
344 maybeexports :: { Maybe [LIE RdrName] }
345 : '(' exportlist ')' { Just $2 }
346 | {- empty -} { Nothing }
348 exportlist :: { [LIE RdrName] }
349 : exportlist ',' export { $3 : $1 }
350 | exportlist ',' { $1 }
354 -- No longer allow things like [] and (,,,) to be exported
355 -- They are built in syntax, always available
356 export :: { LIE RdrName }
357 : qvar { L1 (IEVar (unLoc $1)) }
358 | oqtycon { L1 (IEThingAbs (unLoc $1)) }
359 | oqtycon '(' '..' ')' { LL (IEThingAll (unLoc $1)) }
360 | oqtycon '(' ')' { LL (IEThingWith (unLoc $1) []) }
361 | oqtycon '(' qcnames ')' { LL (IEThingWith (unLoc $1) (reverse $3)) }
362 | 'module' modid { LL (IEModuleContents (unLoc $2)) }
364 qcnames :: { [RdrName] }
365 : qcnames ',' qcname { unLoc $3 : $1 }
366 | qcname { [unLoc $1] }
368 qcname :: { Located RdrName } -- Variable or data constructor
372 -----------------------------------------------------------------------------
373 -- Import Declarations
375 -- import decls can be *empty*, or even just a string of semicolons
376 -- whereas topdecls must contain at least one topdecl.
378 importdecls :: { [LImportDecl RdrName] }
379 : importdecls ';' importdecl { $3 : $1 }
380 | importdecls ';' { $1 }
381 | importdecl { [ $1 ] }
384 importdecl :: { LImportDecl RdrName }
385 : 'import' maybe_src optqualified modid maybeas maybeimpspec
386 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
388 maybe_src :: { IsBootInterface }
389 : '{-# SOURCE' '#-}' { True }
390 | {- empty -} { False }
392 optqualified :: { Bool }
393 : 'qualified' { True }
394 | {- empty -} { False }
396 maybeas :: { Located (Maybe ModuleName) }
397 : 'as' modid { LL (Just (unLoc $2)) }
398 | {- empty -} { noLoc Nothing }
400 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
401 : impspec { L1 (Just (unLoc $1)) }
402 | {- empty -} { noLoc Nothing }
404 impspec :: { Located (Bool, [LIE RdrName]) }
405 : '(' exportlist ')' { LL (False, reverse $2) }
406 | 'hiding' '(' exportlist ')' { LL (True, reverse $3) }
408 -----------------------------------------------------------------------------
409 -- Fixity Declarations
413 | INTEGER {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
415 infix :: { Located FixityDirection }
416 : 'infix' { L1 InfixN }
417 | 'infixl' { L1 InfixL }
418 | 'infixr' { L1 InfixR }
420 ops :: { Located [Located RdrName] }
421 : ops ',' op { LL ($3 : unLoc $1) }
424 -----------------------------------------------------------------------------
425 -- Top-Level Declarations
427 topdecls :: { OrdList (LHsDecl RdrName) } -- Reversed
428 : topdecls ';' topdecl { $1 `appOL` $3 }
429 | topdecls ';' { $1 }
432 topdecl :: { OrdList (LHsDecl RdrName) }
433 : tycl_decl { unitOL (L1 (TyClD (unLoc $1))) }
434 | 'instance' inst_type where
435 { let (binds,sigs) = cvBindsAndSigs (unLoc $3)
436 in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
437 | 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
438 | 'foreign' fdecl { unitOL (LL (unLoc $2)) }
439 | '{-# DEPRECATED' deprecations '#-}' { $2 }
440 | '{-# RULES' rules '#-}' { $2 }
441 | '$(' exp ')' { unitOL (LL $ SpliceD (SpliceDecl $2)) }
444 tycl_decl :: { LTyClDecl RdrName }
445 : 'type' syn_hdr '=' ctype
446 -- Note ctype, not sigtype.
447 -- We allow an explicit for-all but we don't insert one
448 -- in type Foo a = (b,b)
449 -- Instead we just say b is out of scope
450 { LL $ let (tc,tvs) = $2 in TySynonym tc tvs $4 }
452 | 'data' tycl_hdr constrs deriving
453 { L (comb4 $1 $2 $3 $4)
454 (mkTyData DataType (unLoc $2) (reverse (unLoc $3)) (unLoc $4)) }
456 | 'newtype' tycl_hdr '=' newconstr deriving
458 (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
460 | 'class' tycl_hdr fds where
462 (binds,sigs) = cvBindsAndSigs (unLoc $4)
464 L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs
467 syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) }
468 -- We don't retain the syntax of an infix
469 -- type synonym declaration. Oh well.
470 : tycon tv_bndrs { ($1, $2) }
471 | tv_bndr tyconop tv_bndr { ($2, [$1,$3]) }
473 -- tycl_hdr parses the header of a type or class decl,
474 -- which takes the form
477 -- (Eq a, Ord b) => T a b
478 -- Rather a lot of inlining here, else we get reduce/reduce errors
479 tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
480 : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
481 | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
483 -----------------------------------------------------------------------------
484 -- Nested declarations
486 decls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
487 : decls ';' decl { LL (unLoc $1 `appOL` unLoc $3) }
488 | decls ';' { LL (unLoc $1) }
490 | {- empty -} { noLoc nilOL }
493 decllist :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
494 : '{' decls '}' { LL (unLoc $2) }
495 | vocurly decls close { $2 }
497 where :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
498 -- No implicit parameters
499 : 'where' decllist { LL (unLoc $2) }
500 | {- empty -} { noLoc nilOL }
502 binds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
503 : decllist { L1 [cvBindGroup (unLoc $1)] }
504 | '{' dbinds '}' { LL [HsIPBinds (unLoc $2)] }
505 | vocurly dbinds close { L (getLoc $2) [HsIPBinds (unLoc $2)] }
507 wherebinds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
508 : 'where' binds { LL (unLoc $2) }
509 | {- empty -} { noLoc [] }
512 -----------------------------------------------------------------------------
513 -- Transformation Rules
515 rules :: { OrdList (LHsDecl RdrName) } -- Reversed
516 : rules ';' rule { $1 `snocOL` $3 }
519 | {- empty -} { nilOL }
521 rule :: { LHsDecl RdrName }
522 : STRING activation rule_forall infixexp '=' exp
523 { LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6) }
525 activation :: { Activation } -- Omitted means AlwaysActive
526 : {- empty -} { AlwaysActive }
527 | explicit_activation { $1 }
529 inverse_activation :: { Activation } -- Omitted means NeverActive
530 : {- empty -} { NeverActive }
531 | explicit_activation { $1 }
533 explicit_activation :: { Activation } -- In brackets
534 : '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
535 | '[' '~' INTEGER ']' { ActiveBefore (fromInteger (getINTEGER $3)) }
537 rule_forall :: { [RuleBndr RdrName] }
538 : 'forall' rule_var_list '.' { $2 }
541 rule_var_list :: { [RuleBndr RdrName] }
543 | rule_var rule_var_list { $1 : $2 }
545 rule_var :: { RuleBndr RdrName }
546 : varid { RuleBndr $1 }
547 | '(' varid '::' ctype ')' { RuleBndrSig $2 $4 }
549 -----------------------------------------------------------------------------
550 -- Deprecations (c.f. rules)
552 deprecations :: { OrdList (LHsDecl RdrName) } -- Reversed
553 : deprecations ';' deprecation { $1 `appOL` $3 }
554 | deprecations ';' { $1 }
556 | {- empty -} { nilOL }
558 -- SUP: TEMPORARY HACK, not checking for `module Foo'
559 deprecation :: { OrdList (LHsDecl RdrName) }
561 { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
565 -----------------------------------------------------------------------------
566 -- Foreign import and export declarations
568 -- for the time being, the following accepts foreign declarations conforming
569 -- to the FFI Addendum, Version 1.0 as well as pre-standard declarations
571 -- * a flag indicates whether pre-standard declarations have been used and
572 -- triggers a deprecation warning further down the road
574 -- NB: The first two rules could be combined into one by replacing `safety1'
575 -- with `safety'. However, the combined rule conflicts with the
578 fdecl :: { LHsDecl RdrName }
579 fdecl : 'import' callconv safety1 fspec
580 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
581 | 'import' callconv fspec
582 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
584 | 'export' callconv fspec
585 {% mkExport $2 (unLoc $3) >>= return.LL }
586 -- the following syntax is DEPRECATED
587 | fdecl1DEPRECATED { L1 (ForD (unLoc $1)) }
588 | fdecl2DEPRECATED { L1 (unLoc $1) }
590 fdecl1DEPRECATED :: { LForeignDecl RdrName }
592 ----------- DEPRECATED label decls ------------
593 : 'label' ext_name varid '::' sigtype
594 { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
595 (CLabel ($2 `orElse` mkExtName (unLoc $3)))) True }
597 ----------- DEPRECATED ccall/stdcall decls ------------
599 -- NB: This business with the case expression below may seem overly
600 -- complicated, but it is necessary to avoid some conflicts.
602 -- DEPRECATED variant #1: lack of a calling convention specification
604 | 'import' {-no callconv-} ext_name safety varid_no_unsafe '::' sigtype
606 target = StaticTarget ($2 `orElse` mkExtName (unLoc $4))
608 LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
609 (CFunction target)) True }
611 -- DEPRECATED variant #2: external name consists of two separate strings
612 -- (module name and function name) (import)
613 | 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype
615 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
616 CCall cconv -> return $
618 imp = CFunction (StaticTarget (getSTRING $4))
620 LL $ ForeignImport $6 $8 (CImport cconv $5 nilFS nilFS imp) True }
622 -- DEPRECATED variant #3: `unsafe' after entity
623 | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype
625 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
626 CCall cconv -> return $
628 imp = CFunction (StaticTarget (getSTRING $3))
630 LL $ ForeignImport $5 $7 (CImport cconv PlayRisky nilFS nilFS imp) True }
632 -- DEPRECATED variant #4: use of the special identifier `dynamic' without
633 -- an explicit calling convention (import)
634 | 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype
635 { LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
636 (CFunction DynamicTarget)) True }
638 -- DEPRECATED variant #5: use of the special identifier `dynamic' (import)
639 | 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype
641 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
642 CCall cconv -> return $
643 LL $ ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS
644 (CFunction DynamicTarget)) True }
646 -- DEPRECATED variant #6: lack of a calling convention specification
648 | 'export' {-no callconv-} ext_name varid '::' sigtype
649 { LL $ ForeignExport $3 $5 (CExport (CExportStatic ($2 `orElse` mkExtName (unLoc $3))
650 defaultCCallConv)) True }
652 -- DEPRECATED variant #7: external name consists of two separate strings
653 -- (module name and function name) (export)
654 | 'export' callconv STRING STRING varid '::' sigtype
656 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
657 CCall cconv -> return $
658 LL $ ForeignExport $5 $7
659 (CExport (CExportStatic (getSTRING $4) cconv)) True }
661 -- DEPRECATED variant #8: use of the special identifier `dynamic' without
662 -- an explicit calling convention (export)
663 | 'export' {-no callconv-} 'dynamic' varid '::' sigtype
664 { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
667 -- DEPRECATED variant #9: use of the special identifier `dynamic' (export)
668 | 'export' callconv 'dynamic' varid '::' sigtype
670 DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
671 CCall cconv -> return $
672 LL $ ForeignImport $4 $6
673 (CImport cconv (PlaySafe False) nilFS nilFS CWrapper) True }
675 ----------- DEPRECATED .NET decls ------------
676 -- NB: removed the .NET call declaration, as it is entirely subsumed
677 -- by the new standard FFI declarations
679 fdecl2DEPRECATED :: { LHsDecl RdrName }
681 : 'import' 'dotnet' 'type' ext_name tycon { LL $ TyClD (ForeignType $5 $4 DNType) }
682 -- left this one unchanged for the moment as type imports are not
683 -- covered currently by the FFI standard -=chak
686 callconv :: { CallConv }
687 : 'stdcall' { CCall StdCallConv }
688 | 'ccall' { CCall CCallConv }
689 | 'dotnet' { DNCall }
692 : 'unsafe' { PlayRisky }
693 | 'safe' { PlaySafe False }
694 | 'threadsafe' { PlaySafe True }
695 | {- empty -} { PlaySafe False }
697 safety1 :: { Safety }
698 : 'unsafe' { PlayRisky }
699 | 'safe' { PlaySafe False }
700 | 'threadsafe' { PlaySafe True }
701 -- only needed to avoid conflicts with the DEPRECATED rules
703 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
704 : STRING var '::' sigtype { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
705 | var '::' sigtype { LL (noLoc nilFS, $1, $3) }
706 -- if the entity string is missing, it defaults to the empty string;
707 -- the meaning of an empty entity string depends on the calling
711 ext_name :: { Maybe CLabelString }
712 : STRING { Just (getSTRING $1) }
713 | STRING STRING { Just (getSTRING $2) } -- Ignore "module name" for now
714 | {- empty -} { Nothing }
717 -----------------------------------------------------------------------------
720 opt_sig :: { Maybe (LHsType RdrName) }
721 : {- empty -} { Nothing }
722 | '::' sigtype { Just $2 }
724 opt_asig :: { Maybe (LHsType RdrName) }
725 : {- empty -} { Nothing }
726 | '::' atype { Just $2 }
728 sigtypes1 :: { [LHsType RdrName] }
730 | sigtype ',' sigtypes1 { $1 : $3 }
732 sigtype :: { LHsType RdrName }
733 : ctype { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
734 -- Wrap an Implicit forall if there isn't one there already
736 sig_vars :: { Located [Located RdrName] }
737 : sig_vars ',' var { LL ($3 : unLoc $1) }
740 -----------------------------------------------------------------------------
743 -- A ctype is a for-all type
744 ctype :: { LHsType RdrName }
745 : 'forall' tv_bndrs '.' ctype { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
746 | context '=>' type { LL $ mkImplicitHsForAllTy $1 $3 }
747 -- A type of form (context => type) is an *implicit* HsForAllTy
750 -- We parse a context as a btype so that we don't get reduce/reduce
751 -- errors in ctype. The basic problem is that
753 -- looks so much like a tuple type. We can't tell until we find the =>
754 context :: { LHsContext RdrName }
755 : btype {% checkContext $1 }
757 type :: { LHsType RdrName }
758 : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
761 gentype :: { LHsType RdrName }
763 | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
764 | btype '`' tyvar '`' gentype { LL $ HsOpTy $1 $3 $5 }
765 | btype '->' gentype { LL $ HsFunTy $1 $3 }
767 btype :: { LHsType RdrName }
768 : btype atype { LL $ HsAppTy $1 $2 }
771 atype :: { LHsType RdrName }
772 : gtycon { L1 (HsTyVar (unLoc $1)) }
773 | tyvar { L1 (HsTyVar (unLoc $1)) }
774 | '(' type ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) }
775 | '(#' comma_types1 '#)' { LL $ HsTupleTy Unboxed $2 }
776 | '[' type ']' { LL $ HsListTy $2 }
777 | '[:' type ':]' { LL $ HsPArrTy $2 }
778 | '(' ctype ')' { LL $ HsParTy $2 }
779 | '(' ctype '::' kind ')' { LL $ HsKindSig $2 $4 }
781 | INTEGER { L1 (HsNumTy (getINTEGER $1)) }
783 -- An inst_type is what occurs in the head of an instance decl
784 -- e.g. (Foo a, Gaz b) => Wibble a b
785 -- It's kept as a single type, with a MonoDictTy at the right
786 -- hand corner, for convenience.
787 inst_type :: { LHsType RdrName }
788 : ctype {% checkInstType $1 }
790 inst_types1 :: { [LHsType RdrName] }
792 | inst_type ',' inst_types1 { $1 : $3 }
794 comma_types0 :: { [LHsType RdrName] }
795 : comma_types1 { $1 }
798 comma_types1 :: { [LHsType RdrName] }
800 | type ',' comma_types1 { $1 : $3 }
802 tv_bndrs :: { [LHsTyVarBndr RdrName] }
803 : tv_bndr tv_bndrs { $1 : $2 }
806 tv_bndr :: { LHsTyVarBndr RdrName }
807 : tyvar { L1 (UserTyVar (unLoc $1)) }
808 | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2) $4) }
810 fds :: { Located [Located ([RdrName], [RdrName])] }
811 : {- empty -} { noLoc [] }
812 | '|' fds1 { LL (reverse (unLoc $2)) }
814 fds1 :: { Located [Located ([RdrName], [RdrName])] }
815 : fds1 ',' fd { LL ($3 : unLoc $1) }
818 fd :: { Located ([RdrName], [RdrName]) }
819 : varids0 '->' varids0 { L (comb3 $1 $2 $3)
820 (reverse (unLoc $1), reverse (unLoc $3)) }
822 varids0 :: { Located [RdrName] }
823 : {- empty -} { noLoc [] }
824 | varids0 tyvar { LL (unLoc $2 : unLoc $1) }
826 -----------------------------------------------------------------------------
831 | akind '->' kind { mkArrowKind $1 $3 }
834 : '*' { liftedTypeKind }
835 | '(' kind ')' { $2 }
838 -----------------------------------------------------------------------------
839 -- Datatype declarations
841 newconstr :: { LConDecl RdrName }
842 : conid atype { LL $ ConDecl $1 [] (noLoc [])
843 (PrefixCon [(unbangedType $2)]) }
844 | conid '{' var '::' ctype '}'
845 { LL $ ConDecl $1 [] (noLoc [])
846 (RecCon [($3, (unbangedType $5))]) }
848 constrs :: { Located [LConDecl RdrName] }
849 : {- empty; a GHC extension -} { noLoc [] }
850 | '=' constrs1 { LL (unLoc $2) }
852 constrs1 :: { Located [LConDecl RdrName] }
853 : constrs1 '|' constr { LL ($3 : unLoc $1) }
856 constr :: { LConDecl RdrName }
857 : forall context '=>' constr_stuff
858 { let (con,details) = unLoc $4 in
859 LL (ConDecl con (unLoc $1) $2 details) }
860 | forall constr_stuff
861 { let (con,details) = unLoc $2 in
862 LL (ConDecl con (unLoc $1) (noLoc []) details) }
864 forall :: { Located [LHsTyVarBndr RdrName] }
865 : 'forall' tv_bndrs '.' { LL $2 }
866 | {- empty -} { noLoc [] }
868 constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
869 : btype {% mkPrefixCon $1 [] >>= return.LL }
870 | btype bang_atype satypes {% do { r <- mkPrefixCon $1 ($2 : unLoc $3);
871 return (L (comb3 $1 $2 $3) r) } }
872 | oqtycon '{' '}' {% mkRecCon $1 [] >>= return.LL }
873 | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL }
874 | sbtype conop sbtype { LL ($2, InfixCon $1 $3) }
876 bang_atype :: { LBangType RdrName }
877 : strict_mark atype { LL (BangType (unLoc $1) $2) }
879 satypes :: { Located [LBangType RdrName] }
880 : atype satypes { LL (unbangedType $1 : unLoc $2) }
881 | bang_atype satypes { LL ($1 : unLoc $2) }
882 | {- empty -} { noLoc [] }
884 sbtype :: { LBangType RdrName }
885 : btype { unbangedType $1 }
886 | strict_mark atype { LL (BangType (unLoc $1) $2) }
888 fielddecls :: { [([Located RdrName], LBangType RdrName)] }
889 : fielddecl ',' fielddecls { unLoc $1 : $3 }
890 | fielddecl { [unLoc $1] }
892 fielddecl :: { Located ([Located RdrName], LBangType RdrName) }
893 : sig_vars '::' stype { LL (reverse (unLoc $1), $3) }
895 stype :: { LBangType RdrName }
896 : ctype { unbangedType $1 }
897 | strict_mark atype { LL (BangType (unLoc $1) $2) }
899 strict_mark :: { Located HsBang }
900 : '!' { L1 HsStrict }
901 | '{-# UNPACK' '#-}' '!' { LL HsUnbox }
903 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
904 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
905 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
906 -- We don't allow a context, but that's sorted out by the type checker.
907 deriving :: { Located (Maybe [LHsType RdrName]) }
908 : {- empty -} { noLoc Nothing }
909 | 'deriving' qtycon {% do { let { L loc tv = $2 }
910 ; p <- checkInstType (L loc (HsTyVar tv))
911 ; return (LL (Just [p])) } }
912 | 'deriving' '(' ')' { LL (Just []) }
913 | 'deriving' '(' inst_types1 ')' { LL (Just $3) }
914 -- Glasgow extension: allow partial
915 -- applications in derivings
917 -----------------------------------------------------------------------------
920 {- There's an awkward overlap with a type signature. Consider
921 f :: Int -> Int = ...rhs...
922 Then we can't tell whether it's a type signature or a value
923 definition with a result signature until we see the '='.
924 So we have to inline enough to postpone reductions until we know.
928 ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
929 instead of qvar, we get another shift/reduce-conflict. Consider the
932 { (^^) :: Int->Int ; } Type signature; only var allowed
934 { (^^) :: Int->Int = ... ; } Value defn with result signature;
935 qvar allowed (because of instance decls)
937 We can't tell whether to reduce var to qvar until after we've read the signatures.
940 decl :: { Located (OrdList (LHsDecl RdrName)) }
942 | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 (unLoc $3);
943 return (LL $ unitOL (LL $ ValD r)) } }
945 rhs :: { Located (GRHSs RdrName) }
946 : '=' exp wherebinds { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) placeHolderType }
947 | gdrhs wherebinds { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) placeHolderType }
949 gdrhs :: { Located [LGRHS RdrName] }
950 : gdrhs gdrh { LL ($2 : unLoc $1) }
953 gdrh :: { LGRHS RdrName }
954 : '|' quals '=' exp { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) :
957 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
958 : infixexp '::' sigtype
959 {% do s <- checkValSig $1 $3;
960 return (LL $ unitOL (LL $ SigD s)) }
961 -- See the above notes for why we need infixexp here
962 | var ',' sig_vars '::' sigtype
963 { LL $ toOL [ LL $ SigD (Sig n $5) | n <- $1 : unLoc $3 ] }
964 | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
966 | '{-# INLINE' activation qvar '#-}'
967 { LL $ unitOL (LL $ SigD (InlineSig True $3 $2)) }
968 | '{-# NOINLINE' inverse_activation qvar '#-}'
969 { LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) }
970 | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
971 { LL $ toOL [ LL $ SigD (SpecSig $2 t)
973 | '{-# SPECIALISE' 'instance' inst_type '#-}'
974 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
976 -----------------------------------------------------------------------------
979 exp :: { LHsExpr RdrName }
980 : infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
981 | fexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
982 | fexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
983 | fexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
984 | fexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
987 infixexp :: { LHsExpr RdrName }
989 | infixexp qop exp10 { LL (OpApp $1 $2 (panic "fixity") $3) }
991 exp10 :: { LHsExpr RdrName }
992 : '\\' aexp aexps opt_asig '->' exp
993 {% checkPatterns ($2 : reverse $3) >>= \ ps ->
994 return (LL $ HsLam (LL $ Match ps $4
995 (GRHSs (unguardedRHS $6) []
997 | 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
998 | 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 }
999 | 'case' exp 'of' altslist { LL $ HsCase $2 (unLoc $4) }
1000 | '-' fexp { LL $ mkHsNegApp $2 }
1002 | 'do' stmtlist {% let loc = comb2 $1 $2 in
1003 checkDo loc (unLoc $2) >>= \ stmts ->
1004 return (L loc (mkHsDo DoExpr stmts)) }
1005 | 'mdo' stmtlist {% let loc = comb2 $1 $2 in
1006 checkMDo loc (unLoc $2) >>= \ stmts ->
1007 return (L loc (mkHsDo MDoExpr stmts)) }
1009 | scc_annot exp { LL $ if opt_SccProfilingOn
1010 then HsSCC (unLoc $1) $2
1013 | 'proc' aexp '->' exp
1014 {% checkPattern $2 >>= \ p ->
1015 return (LL $ HsProc p (LL $ HsCmdTop $4 []
1016 placeHolderType undefined)) }
1017 -- TODO: is LL right here?
1019 | '{-# CORE' STRING '#-}' exp { LL $ HsCoreAnn (getSTRING $2) $4 }
1020 -- hdaume: core annotation
1023 scc_annot :: { Located FastString }
1024 : '_scc_' STRING { LL $ getSTRING $2 }
1025 | '{-# SCC' STRING '#-}' { LL $ getSTRING $2 }
1027 fexp :: { LHsExpr RdrName }
1028 : fexp aexp { LL $ HsApp $1 $2 }
1031 aexps :: { [LHsExpr RdrName] }
1032 : aexps aexp { $2 : $1 }
1033 | {- empty -} { [] }
1035 aexp :: { LHsExpr RdrName }
1036 : qvar '@' aexp { LL $ EAsPat $1 $3 }
1037 | '~' aexp { LL $ ELazyPat $2 }
1040 aexp1 :: { LHsExpr RdrName }
1041 : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
1046 -- Here was the syntax for type applications that I was planning
1047 -- but there are difficulties (e.g. what order for type args)
1048 -- so it's not enabled yet.
1049 -- But this case *is* used for the left hand side of a generic definition,
1050 -- which is parsed as an expression before being munged into a pattern
1051 | qcname '{|' gentype '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1052 (sL (getLoc $3) (HsType $3)) }
1054 aexp2 :: { LHsExpr RdrName }
1055 : ipvar { L1 (HsIPVar $! unLoc $1) }
1056 | qcname { L1 (HsVar $! unLoc $1) }
1057 | literal { L1 (HsLit $! unLoc $1) }
1058 | INTEGER { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
1059 | RATIONAL { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
1060 | '(' exp ')' { LL (HsPar $2) }
1061 | '(' exp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1062 | '(#' texps '#)' { LL $ ExplicitTuple (reverse $2) Unboxed }
1063 | '[' list ']' { LL (unLoc $2) }
1064 | '[:' parr ':]' { LL (unLoc $2) }
1065 | '(' infixexp qop ')' { LL $ SectionL $2 $3 }
1066 | '(' qopm infixexp ')' { LL $ SectionR $2 $3 }
1067 | '_' { L1 EWildPat }
1069 -- MetaHaskell Extension
1070 | TH_ID_SPLICE { L1 $ HsSpliceE (mkHsSplice
1071 (L1 $ HsVar (mkUnqual varName
1072 (getTH_ID_SPLICE $1)))) } -- $x
1073 | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
1075 | TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
1076 | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
1077 | TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
1078 | TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) }
1079 | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
1080 | '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
1081 | '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
1082 return (LL $ HsBracket (PatBr p)) }
1083 | '[d|' cvtopbody '|]' { LL $ HsBracket (DecBr (mkGroup $2)) }
1085 -- arrow notation extension
1086 | '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
1088 cmdargs :: { [LHsCmdTop RdrName] }
1089 : cmdargs acmd { $2 : $1 }
1090 | {- empty -} { [] }
1092 acmd :: { LHsCmdTop RdrName }
1093 : aexp2 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1095 cvtopbody :: { [LHsDecl RdrName] }
1096 : '{' cvtopdecls0 '}' { $2 }
1097 | vocurly cvtopdecls0 close { $2 }
1099 cvtopdecls0 :: { [LHsDecl RdrName] }
1100 : {- empty -} { [] }
1103 texps :: { [LHsExpr RdrName] }
1104 : texps ',' exp { $3 : $1 }
1108 -----------------------------------------------------------------------------
1111 -- The rules below are little bit contorted to keep lexps left-recursive while
1112 -- avoiding another shift/reduce-conflict.
1114 list :: { LHsExpr RdrName }
1115 : exp { L1 $ ExplicitList placeHolderType [$1] }
1116 | lexps { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1117 | exp '..' { LL $ ArithSeqIn (From $1) }
1118 | exp ',' exp '..' { LL $ ArithSeqIn (FromThen $1 $3) }
1119 | exp '..' exp { LL $ ArithSeqIn (FromTo $1 $3) }
1120 | exp ',' exp '..' exp { LL $ ArithSeqIn (FromThenTo $1 $3 $5) }
1121 | exp pquals { LL $ mkHsDo ListComp
1122 (reverse (L (getLoc $1) (ResultStmt $1) :
1125 lexps :: { Located [LHsExpr RdrName] }
1126 : lexps ',' exp { LL ($3 : unLoc $1) }
1127 | exp ',' exp { LL [$3,$1] }
1129 -----------------------------------------------------------------------------
1130 -- List Comprehensions
1132 pquals :: { Located [LStmt RdrName] } -- Either a singleton ParStmt,
1133 -- or a reversed list of Stmts
1134 : pquals1 { case unLoc $1 of
1136 qss -> L1 [L1 (ParStmt stmtss)]
1138 stmtss = [ (reverse qs, undefined)
1142 pquals1 :: { Located [[LStmt RdrName]] }
1143 : pquals1 '|' quals { LL (unLoc $3 : unLoc $1) }
1144 | '|' quals { L (getLoc $2) [unLoc $2] }
1146 quals :: { Located [LStmt RdrName] }
1147 : quals ',' qual { LL ($3 : unLoc $1) }
1150 -----------------------------------------------------------------------------
1151 -- Parallel array expressions
1153 -- The rules below are little bit contorted; see the list case for details.
1154 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1155 -- Moreover, we allow explicit arrays with no element (represented by the nil
1156 -- constructor in the list case).
1158 parr :: { LHsExpr RdrName }
1159 : { noLoc (ExplicitPArr placeHolderType []) }
1160 | exp { L1 $ ExplicitPArr placeHolderType [$1] }
1161 | lexps { L1 $ ExplicitPArr placeHolderType
1162 (reverse (unLoc $1)) }
1163 | exp '..' exp { LL $ PArrSeqIn (FromTo $1 $3) }
1164 | exp ',' exp '..' exp { LL $ PArrSeqIn (FromThenTo $1 $3 $5) }
1165 | exp pquals { LL $ mkHsDo PArrComp
1166 (reverse (L (getLoc $1) (ResultStmt $1) :
1170 -- We are reusing `lexps' and `pquals' from the list case.
1172 -----------------------------------------------------------------------------
1173 -- Case alternatives
1175 altslist :: { Located [LMatch RdrName] }
1176 : '{' alts '}' { LL (reverse (unLoc $2)) }
1177 | vocurly alts close { L (getLoc $2) (reverse (unLoc $2)) }
1179 alts :: { Located [LMatch RdrName] }
1180 : alts1 { L1 (unLoc $1) }
1181 | ';' alts { LL (unLoc $2) }
1183 alts1 :: { Located [LMatch RdrName] }
1184 : alts1 ';' alt { LL ($3 : unLoc $1) }
1185 | alts1 ';' { LL (unLoc $1) }
1188 alt :: { LMatch RdrName }
1189 : infixexp opt_sig alt_rhs {% checkPattern $1 >>= \p ->
1190 return (LL (Match [p] $2 (unLoc $3))) }
1192 alt_rhs :: { Located (GRHSs RdrName) }
1193 : ralt wherebinds { LL (GRHSs (unLoc $1) (unLoc $2)
1196 ralt :: { Located [LGRHS RdrName] }
1197 : '->' exp { LL (unguardedRHS $2) }
1198 | gdpats { L1 (reverse (unLoc $1)) }
1200 gdpats :: { Located [LGRHS RdrName] }
1201 : gdpats gdpat { LL ($2 : unLoc $1) }
1204 gdpat :: { LGRHS RdrName }
1205 : '|' quals '->' exp { let r = L (getLoc $4) (ResultStmt $4)
1206 in LL $ GRHS (reverse (r : unLoc $2)) }
1208 -----------------------------------------------------------------------------
1209 -- Statement sequences
1211 stmtlist :: { Located [LStmt RdrName] }
1212 : '{' stmts '}' { LL (unLoc $2) }
1213 | vocurly stmts close { $2 }
1215 -- do { ;; s ; s ; ; s ;; }
1216 -- The last Stmt should be a ResultStmt, but that's hard to enforce
1217 -- here, because we need too much lookahead if we see do { e ; }
1218 -- So we use ExprStmts throughout, and switch the last one over
1219 -- in ParseUtils.checkDo instead
1220 stmts :: { Located [LStmt RdrName] }
1221 : stmt stmts_help { LL ($1 : unLoc $2) }
1222 | ';' stmts { LL (unLoc $2) }
1223 | {- empty -} { noLoc [] }
1225 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1226 : ';' stmts { LL (unLoc $2) }
1227 | {- empty -} { noLoc [] }
1229 -- For typing stmts at the GHCi prompt, where
1230 -- the input may consist of just comments.
1231 maybe_stmt :: { Maybe (LStmt RdrName) }
1233 | {- nothing -} { Nothing }
1235 stmt :: { LStmt RdrName }
1237 | infixexp '->' exp {% checkPattern $3 >>= \p ->
1238 return (LL $ BindStmt p $1) }
1239 | 'rec' stmtlist { LL $ RecStmt (unLoc $2) undefined undefined undefined }
1241 qual :: { LStmt RdrName }
1242 : infixexp '<-' exp {% checkPattern $1 >>= \p ->
1243 return (LL $ BindStmt p $3) }
1244 | exp { L1 $ ExprStmt $1 placeHolderType }
1245 | 'let' binds { LL $ LetStmt (unLoc $2) }
1247 -----------------------------------------------------------------------------
1248 -- Record Field Update/Construction
1250 fbinds :: { HsRecordBinds RdrName }
1252 | {- empty -} { [] }
1254 fbinds1 :: { HsRecordBinds RdrName }
1255 : fbinds1 ',' fbind { $3 : $1 }
1258 fbind :: { (Located RdrName, LHsExpr RdrName) }
1259 : qvar '=' exp { ($1,$3) }
1261 -----------------------------------------------------------------------------
1262 -- Implicit Parameter Bindings
1264 dbinds :: { Located [LIPBind RdrName] }
1265 : dbinds ';' dbind { LL ($3 : unLoc $1) }
1266 | dbinds ';' { LL (unLoc $1) }
1268 -- | {- empty -} { [] }
1270 dbind :: { LIPBind RdrName }
1271 dbind : ipvar '=' exp { LL (IPBind (unLoc $1) $3) }
1273 -----------------------------------------------------------------------------
1274 -- Variables, Constructors and Operators.
1276 identifier :: { Located RdrName }
1282 depreclist :: { Located [RdrName] }
1283 depreclist : deprec_var { L1 [unLoc $1] }
1284 | deprec_var ',' depreclist { LL (unLoc $1 : unLoc $3) }
1286 deprec_var :: { Located RdrName }
1287 deprec_var : var { $1 }
1290 gcon :: { Located RdrName } -- Data constructor namespace
1291 : sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
1293 -- the case of '[:' ':]' is part of the production `parr'
1295 sysdcon :: { Located DataCon } -- Wired in data constructors
1296 : '(' ')' { LL unitDataCon }
1297 | '(' commas ')' { LL $ tupleCon Boxed $2 }
1298 | '[' ']' { LL nilDataCon }
1300 var :: { Located RdrName }
1302 | '(' varsym ')' { LL (unLoc $2) }
1304 qvar :: { Located RdrName }
1306 | '(' varsym ')' { LL (unLoc $2) }
1307 | '(' qvarsym1 ')' { LL (unLoc $2) }
1308 -- We've inlined qvarsym here so that the decision about
1309 -- whether it's a qvar or a var can be postponed until
1310 -- *after* we see the close paren.
1312 ipvar :: { Located (IPName RdrName) }
1313 : IPDUPVARID { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
1314 | IPSPLITVARID { L1 (Linear (mkUnqual varName (getIPSPLITVARID $1))) }
1316 qcon :: { Located RdrName }
1318 | '(' qconsym ')' { LL (unLoc $2) }
1320 varop :: { Located RdrName }
1322 | '`' varid '`' { LL (unLoc $2) }
1324 qvarop :: { Located RdrName }
1326 | '`' qvarid '`' { LL (unLoc $2) }
1328 qvaropm :: { Located RdrName }
1329 : qvarsym_no_minus { $1 }
1330 | '`' qvarid '`' { LL (unLoc $2) }
1332 conop :: { Located RdrName }
1334 | '`' conid '`' { LL (unLoc $2) }
1336 qconop :: { Located RdrName }
1338 | '`' qconid '`' { LL (unLoc $2) }
1340 -----------------------------------------------------------------------------
1341 -- Type constructors
1343 gtycon :: { Located RdrName } -- A "general" qualified tycon
1345 | '(' ')' { LL $ getRdrName unitTyCon }
1346 | '(' commas ')' { LL $ getRdrName (tupleTyCon Boxed $2) }
1347 | '(' '->' ')' { LL $ getRdrName funTyCon }
1348 | '[' ']' { LL $ listTyCon_RDR }
1349 | '[:' ':]' { LL $ parrTyCon_RDR }
1351 oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon
1353 | '(' qtyconsym ')' { LL (unLoc $2) }
1355 qtyconop :: { Located RdrName } -- Qualified or unqualified
1357 | '`' qtycon '`' { LL (unLoc $2) }
1359 tyconop :: { Located RdrName } -- Unqualified
1361 | '`' tycon '`' { LL (unLoc $2) }
1363 qtycon :: { Located RdrName } -- Qualified or unqualified
1364 : QCONID { L1 $! mkQual tcClsName (getQCONID $1) }
1367 tycon :: { Located RdrName } -- Unqualified
1368 : CONID { L1 $! mkUnqual tcClsName (getCONID $1) }
1370 qtyconsym :: { Located RdrName }
1371 : QCONSYM { L1 $! mkQual tcClsName (getQCONSYM $1) }
1374 tyconsym :: { Located RdrName }
1375 : CONSYM { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1377 -----------------------------------------------------------------------------
1380 op :: { Located RdrName } -- used in infix decls
1384 qop :: { LHsExpr RdrName } -- used in sections
1385 : qvarop { L1 $ HsVar (unLoc $1) }
1386 | qconop { L1 $ HsVar (unLoc $1) }
1388 qopm :: { LHsExpr RdrName } -- used in sections
1389 : qvaropm { L1 $ HsVar (unLoc $1) }
1390 | qconop { L1 $ HsVar (unLoc $1) }
1392 -----------------------------------------------------------------------------
1395 qvarid :: { Located RdrName }
1397 | QVARID { L1 $ mkQual varName (getQVARID $1) }
1399 varid :: { Located RdrName }
1400 : varid_no_unsafe { $1 }
1401 | 'unsafe' { L1 $! mkUnqual varName FSLIT("unsafe") }
1402 | 'safe' { L1 $! mkUnqual varName FSLIT("safe") }
1403 | 'threadsafe' { L1 $! mkUnqual varName FSLIT("threadsafe") }
1405 varid_no_unsafe :: { Located RdrName }
1406 : VARID { L1 $! mkUnqual varName (getVARID $1) }
1407 | special_id { L1 $! mkUnqual varName (unLoc $1) }
1408 | 'forall' { L1 $! mkUnqual varName FSLIT("forall") }
1410 tyvar :: { Located RdrName }
1411 : VARID { L1 $! mkUnqual tvName (getVARID $1) }
1412 | special_id { L1 $! mkUnqual tvName (unLoc $1) }
1413 | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") }
1414 | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") }
1415 | 'threadsafe' { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1417 -- These special_ids are treated as keywords in various places,
1418 -- but as ordinary ids elsewhere. 'special_id' collects all these
1419 -- except 'unsafe' and 'forall' whose treatment differs depending on context
1420 special_id :: { Located UserFS }
1422 : 'as' { L1 FSLIT("as") }
1423 | 'qualified' { L1 FSLIT("qualified") }
1424 | 'hiding' { L1 FSLIT("hiding") }
1425 | 'export' { L1 FSLIT("export") }
1426 | 'label' { L1 FSLIT("label") }
1427 | 'dynamic' { L1 FSLIT("dynamic") }
1428 | 'stdcall' { L1 FSLIT("stdcall") }
1429 | 'ccall' { L1 FSLIT("ccall") }
1431 -----------------------------------------------------------------------------
1434 qvarsym :: { Located RdrName }
1438 qvarsym_no_minus :: { Located RdrName }
1439 : varsym_no_minus { $1 }
1442 qvarsym1 :: { Located RdrName }
1443 qvarsym1 : QVARSYM { L1 $ mkQual varName (getQVARSYM $1) }
1445 varsym :: { Located RdrName }
1446 : varsym_no_minus { $1 }
1447 | '-' { L1 $ mkUnqual varName FSLIT("-") }
1449 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1450 : VARSYM { L1 $ mkUnqual varName (getVARSYM $1) }
1451 | special_sym { L1 $ mkUnqual varName (unLoc $1) }
1454 -- See comments with special_id
1455 special_sym :: { Located UserFS }
1456 special_sym : '!' { L1 FSLIT("!") }
1457 | '.' { L1 FSLIT(".") }
1458 | '*' { L1 FSLIT("*") }
1460 -----------------------------------------------------------------------------
1461 -- Data constructors
1463 qconid :: { Located RdrName } -- Qualified or unqualifiedb
1465 | QCONID { L1 $ mkQual dataName (getQCONID $1) }
1467 conid :: { Located RdrName }
1468 : CONID { L1 $ mkUnqual dataName (getCONID $1) }
1470 qconsym :: { Located RdrName } -- Qualified or unqualified
1472 | QCONSYM { L1 $ mkQual dataName (getQCONSYM $1) }
1474 consym :: { Located RdrName }
1475 : CONSYM { L1 $ mkUnqual dataName (getCONSYM $1) }
1477 -- ':' means only list cons
1478 | ':' { L1 $ consDataCon_RDR }
1481 -----------------------------------------------------------------------------
1484 literal :: { Located HsLit }
1485 : CHAR { L1 $ HsChar $ getCHAR $1 }
1486 | STRING { L1 $ HsString $ getSTRING $1 }
1487 | PRIMINTEGER { L1 $ HsIntPrim $ getPRIMINTEGER $1 }
1488 | PRIMCHAR { L1 $ HsCharPrim $ getPRIMCHAR $1 }
1489 | PRIMSTRING { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1490 | PRIMFLOAT { L1 $ HsFloatPrim $ getPRIMFLOAT $1 }
1491 | PRIMDOUBLE { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1493 -----------------------------------------------------------------------------
1497 : vccurly { () } -- context popped in lexer.
1498 | error {% popContext }
1500 -----------------------------------------------------------------------------
1501 -- Miscellaneous (mostly renamings)
1503 modid :: { Located ModuleName }
1504 : CONID { L1 $ mkModuleNameFS (getCONID $1) }
1505 | QCONID { L1 $ let (mod,c) = getQCONID $1 in
1508 (unpackFS mod ++ '.':unpackFS c))
1512 : commas ',' { $1 + 1 }
1515 -----------------------------------------------------------------------------
1519 happyError = srcParseFail
1521 getVARID (L _ (ITvarid x)) = x
1522 getCONID (L _ (ITconid x)) = x
1523 getVARSYM (L _ (ITvarsym x)) = x
1524 getCONSYM (L _ (ITconsym x)) = x
1525 getQVARID (L _ (ITqvarid x)) = x
1526 getQCONID (L _ (ITqconid x)) = x
1527 getQVARSYM (L _ (ITqvarsym x)) = x
1528 getQCONSYM (L _ (ITqconsym x)) = x
1529 getIPDUPVARID (L _ (ITdupipvarid x)) = x
1530 getIPSPLITVARID (L _ (ITsplitipvarid x)) = x
1531 getCHAR (L _ (ITchar x)) = x
1532 getSTRING (L _ (ITstring x)) = x
1533 getINTEGER (L _ (ITinteger x)) = x
1534 getRATIONAL (L _ (ITrational x)) = x
1535 getPRIMCHAR (L _ (ITprimchar x)) = x
1536 getPRIMSTRING (L _ (ITprimstring x)) = x
1537 getPRIMINTEGER (L _ (ITprimint x)) = x
1538 getPRIMFLOAT (L _ (ITprimfloat x)) = x
1539 getPRIMDOUBLE (L _ (ITprimdouble x)) = x
1540 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1542 -- Utilities for combining source spans
1543 comb2 :: Located a -> Located b -> SrcSpan
1546 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1547 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1549 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1550 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1551 combineSrcSpans (getLoc c) (getLoc d)
1553 -- strict constructor version:
1555 sL :: SrcSpan -> a -> Located a
1556 sL span a = span `seq` L span a
1558 -- Make a source location for the file. We're a bit lazy here and just
1559 -- make a point SrcSpan at line 1, column 0. Strictly speaking we should
1560 -- try to find the span of the whole file (ToDo).
1561 fileSrcSpan :: P SrcSpan
1564 let loc = mkSrcLoc (srcLocFile l) 1 0;
1565 return (mkSrcSpan loc loc)