X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y.pp;h=b4acb890eb4228c97364c4abddbb26c23ae71e9d;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=01ad57973365110cae5e24c1e4a868d3d7cbfb09;hpb=508a505e9853984bfdaa3ad855ae3fcbc6d31787;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp index 01ad579..b4acb89 100644 --- a/ghc/compiler/parser/Parser.y.pp +++ b/ghc/compiler/parser/Parser.y.pp @@ -16,7 +16,7 @@ INCLUDE "HsVersions.h" import HsSyn import RdrHsSyn -import HscTypes ( ModIface, IsBootInterface, DeprecTxt ) +import HscTypes ( IsBootInterface, DeprecTxt ) import Lexer import RdrName import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon, @@ -25,19 +25,17 @@ import Type ( funTyCon ) import ForeignCall ( Safety(..), CExportSpec(..), CLabelString, CCallConv(..), CCallTarget(..), defaultCCallConv ) -import OccName ( UserFS, varName, dataName, tcClsName, tvName ) +import OccName ( varName, dataName, tcClsName, tvName ) import DataCon ( DataCon, dataConName ) import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans, SrcSpan, combineLocs, srcLocFile, mkSrcLoc, mkSrcSpan ) import Module -import CmdLineOpts ( opt_SccProfilingOn ) +import StaticFlags ( opt_SccProfilingOn ) import Type ( Kind, mkArrowKind, liftedTypeKind ) import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..), - Activation(..) ) + Activation(..), defaultInlineSpec ) import OrdList -import Bag ( emptyBag ) -import Panic import FastString import Maybes ( orElse ) @@ -47,7 +45,7 @@ import GLAEXTS {- ----------------------------------------------------------------------------- -Conflicts: 34 shift/reduce (1.15) +Conflicts: 36 shift/reduce (1.25) 10 for abiguity in 'if x then y else z + 1' [State 178] (shift parses as 'if x then y else (z + 1)', as per longest-parse rule) @@ -69,10 +67,10 @@ Conflicts: 34 shift/reduce (1.15) case v of (x::T -> T) -> .. -- Rhs is ... -8 for ambiguity in 'e :: a `b` c'. Does this mean [States 11, 253] +10 for ambiguity in 'e :: a `b` c'. Does this mean [States 11, 253] (e::a) `b` c, or (e :: (a `b` c)) - As well as `b` we can have !, QCONSYM, and CONSYM, hence 3 cases + As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases Same duplication between states 11 and 253 as the previous case 1 for ambiguity in 'let ?x ...' [State 329] @@ -185,10 +183,10 @@ incorrect. 'proc' { L _ ITproc } -- for arrow notation extension 'rec' { L _ ITrec } -- for arrow notation extension - '{-# SPECIALISE' { L _ ITspecialise_prag } + '{-# INLINE' { L _ (ITinline_prag _) } + '{-# SPECIALISE' { L _ ITspec_prag } + '{-# SPECIALISE_INLINE' { L _ (ITspec_inline_prag _) } '{-# SOURCE' { L _ ITsource_prag } - '{-# INLINE' { L _ ITinline_prag } - '{-# NOINLINE' { L _ ITnoinline_prag } '{-# RULES' { L _ ITrules_prag } '{-# CORE' { L _ ITcore_prag } -- hdaume: annotated core '{-# SCC' { L _ ITscc_prag } @@ -281,6 +279,14 @@ TH_TY_QUOTE { L _ ITtyQuote } -- ''T %% ----------------------------------------------------------------------------- +-- Identifiers; one of the entry points +identifier :: { Located RdrName } + : qvar { $1 } + | qcon { $1 } + | qvarop { $1 } + | qconop { $1 } + +----------------------------------------------------------------------------- -- Module Header -- The place for module deprecation is really too restrictive, but if it @@ -362,7 +368,7 @@ qcnames :: { [RdrName] } qcname :: { Located RdrName } -- Variable or data constructor : qvar { $1 } - | gcon { $1 } + | qcon { $1 } ----------------------------------------------------------------------------- -- Import Declarations @@ -437,24 +443,27 @@ topdecl :: { OrdList (LHsDecl RdrName) } | decl { unLoc $1 } tycl_decl :: { LTyClDecl RdrName } - : 'type' syn_hdr '=' ctype - -- Note ctype, not sigtype. + : 'type' type '=' ctype + -- Note type on the left of the '='; this allows + -- infix type constructors to be declared + -- + -- Note ctype, not sigtype, on the right -- We allow an explicit for-all but we don't insert one -- in type Foo a = (b,b) -- Instead we just say b is out of scope - { LL $ let (tc,tvs) = $2 in TySynonym tc tvs $4 } + {% do { (tc,tvs) <- checkSynHdr $2 + ; return (LL (TySynonym tc tvs $4)) } } - | 'data' tycl_hdr constrs deriving - { L (comb4 $1 $2 $3 $4) - (mkTyData DataType $2 Nothing (reverse (unLoc $3)) (unLoc $4)) } + | data_or_newtype tycl_hdr constrs deriving + { L (comb4 $1 $2 $3 $4) -- We need the location on tycl_hdr + -- in case constrs and deriving are both empty + (mkTyData (unLoc $1) (unLoc $2) Nothing (reverse (unLoc $3)) (unLoc $4)) } - | 'data' tycl_hdr opt_kind_sig 'where' gadt_constrlist -- No deriving for GADTs + | data_or_newtype tycl_hdr opt_kind_sig + 'where' gadt_constrlist + deriving { L (comb4 $1 $2 $4 $5) - (mkTyData DataType $2 $3 (reverse (unLoc $5)) Nothing) } - - | 'newtype' tycl_hdr '=' newconstr deriving - { L (comb3 $1 $4 $5) - (mkTyData NewType $2 Nothing [$4] (unLoc $5)) } + (mkTyData (unLoc $1) (unLoc $2) $3 (reverse (unLoc $5)) (unLoc $6)) } | 'class' tycl_hdr fds where { let @@ -463,16 +472,14 @@ tycl_decl :: { LTyClDecl RdrName } L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs binds) } +data_or_newtype :: { Located NewOrData } + : 'data' { L1 DataType } + | 'newtype' { L1 NewType } + opt_kind_sig :: { Maybe Kind } : { Nothing } | '::' kind { Just $2 } -syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) } - -- We don't retain the syntax of an infix - -- type synonym declaration. Oh well. - : tycon tv_bndrs { ($1, $2) } - | tv_bndr tyconop tv_bndr { ($2, [$1,$3]) } - -- tycl_hdr parses the header of a type or class decl, -- which takes the form -- T a b @@ -480,7 +487,7 @@ syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) } -- (Eq a, Ord b) => T a b -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) } - : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL } + : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL } | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 } ----------------------------------------------------------------------------- @@ -502,14 +509,14 @@ where :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed : 'where' decllist { LL (unLoc $2) } | {- empty -} { noLoc nilOL } -binds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters - : decllist { L1 [cvBindGroup (unLoc $1)] } - | '{' dbinds '}' { LL [HsIPBinds (unLoc $2)] } - | vocurly dbinds close { L (getLoc $2) [HsIPBinds (unLoc $2)] } +binds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters + : decllist { L1 (HsValBinds (cvBindGroup (unLoc $1))) } + | '{' dbinds '}' { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) } + | vocurly dbinds close { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) } -wherebinds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters +wherebinds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters : 'where' binds { LL (unLoc $2) } - | {- empty -} { noLoc [] } + | {- empty -} { noLoc emptyLocalBinds } ----------------------------------------------------------------------------- @@ -523,15 +530,13 @@ rules :: { OrdList (LHsDecl RdrName) } -- Reversed rule :: { LHsDecl RdrName } : STRING activation rule_forall infixexp '=' exp - { LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6) } + { LL $ RuleD (HsRule (getSTRING $1) + ($2 `orElse` AlwaysActive) + $3 $4 $6) } -activation :: { Activation } -- Omitted means AlwaysActive - : {- empty -} { AlwaysActive } - | explicit_activation { $1 } - -inverse_activation :: { Activation } -- Omitted means NeverActive - : {- empty -} { NeverActive } - | explicit_activation { $1 } +activation :: { Maybe Activation } + : {- empty -} { Nothing } + | explicit_activation { Just $1 } explicit_activation :: { Activation } -- In brackets : '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) } @@ -768,7 +773,7 @@ type :: { LHsType RdrName } gentype :: { LHsType RdrName } : btype { $1 } | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 } - | btype '`' tyvar '`' gentype { LL $ HsOpTy $1 $3 $5 } + | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 } | btype '->' gentype { LL $ HsFunTy $1 $3 } btype :: { LHsType RdrName } @@ -846,11 +851,6 @@ akind :: { Kind } ----------------------------------------------------------------------------- -- Datatype declarations -newconstr :: { LConDecl RdrName } - : conid atype { LL $ ConDecl $1 [] (noLoc []) (PrefixCon [$2]) } - | conid '{' var '::' ctype '}' - { LL $ ConDecl $1 [] (noLoc []) (RecCon [($3, $5)]) } - gadt_constrlist :: { Located [LConDecl RdrName] } : '{' gadt_constrs '}' { LL (unLoc $2) } | vocurly gadt_constrs close { $2 } @@ -860,9 +860,30 @@ gadt_constrs :: { Located [LConDecl RdrName] } | gadt_constrs ';' { $1 } | gadt_constr { L1 [$1] } +-- We allow the following forms: +-- C :: Eq a => a -> T a +-- C :: forall a. Eq a => !a -> T a +-- D { x,y :: a } :: T a +-- forall a. Eq a => D { x,y :: a } :: T a + gadt_constr :: { LConDecl RdrName } - : qcon '::' sigtype - { LL (GadtDecl $1 $3) } + : con '::' sigtype + { LL (mkGadtDecl $1 $3) } + -- Syntax: Maybe merge the record stuff with the single-case above? + -- (to kill the mostly harmless reduce/reduce error) + -- XXX revisit autrijus + | constr_stuff_record '::' sigtype + { let (con,details) = unLoc $1 in + LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3)) } +{- + | forall context '=>' constr_stuff_record '::' sigtype + { let (con,details) = unLoc $4 in + LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6)) } + | forall constr_stuff_record '::' sigtype + { let (con,details) = unLoc $2 in + LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4)) } +-} + constrs :: { Located [LConDecl RdrName] } : {- empty; a GHC extension -} { noLoc [] } @@ -875,10 +896,10 @@ constrs1 :: { Located [LConDecl RdrName] } constr :: { LConDecl RdrName } : forall context '=>' constr_stuff { let (con,details) = unLoc $4 in - LL (ConDecl con (unLoc $1) $2 details) } + LL (ConDecl con Explicit (unLoc $1) $2 details ResTyH98) } | forall constr_stuff { let (con,details) = unLoc $2 in - LL (ConDecl con (unLoc $1) (noLoc []) details) } + LL (ConDecl con Explicit (unLoc $1) (noLoc []) details ResTyH98) } forall :: { Located [LHsTyVarBndr RdrName] } : 'forall' tv_bndrs '.' { LL $2 } @@ -897,6 +918,10 @@ constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrN | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL } | btype conop btype { LL ($2, InfixCon $1 $3) } +constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) } + : oqtycon '{' '}' {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) } + | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) } + fielddecls :: { [([Located RdrName], LBangType RdrName)] } : fielddecl ',' fielddecls { unLoc $1 : $3 } | fielddecl { [unLoc $1] } @@ -955,8 +980,7 @@ gdrhs :: { Located [LGRHS RdrName] } | gdrh { L1 [$1] } gdrh :: { LGRHS RdrName } - : '|' quals '=' exp { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) : - unLoc $2)) } + : '|' quals '=' exp { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 } sigdecl :: { Located (OrdList (LHsDecl RdrName)) } : infixexp '::' sigtype @@ -964,16 +988,17 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } return (LL $ unitOL (LL $ SigD s)) } -- See the above notes for why we need infixexp here | var ',' sig_vars '::' sigtype - { LL $ toOL [ LL $ SigD (Sig n $5) | n <- $1 : unLoc $3 ] } + { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] } | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1)))) | n <- unLoc $3 ] } | '{-# INLINE' activation qvar '#-}' - { LL $ unitOL (LL $ SigD (InlineSig True $3 $2)) } - | '{-# NOINLINE' inverse_activation qvar '#-}' - { LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) } + { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) } | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}' - { LL $ toOL [ LL $ SigD (SpecSig $2 t) + { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec) | t <- $4] } + | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}' + { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1))) + | t <- $5] } | '{-# SPECIALISE' 'instance' inst_type '#-}' { LL $ unitOL (LL $ SigD (SpecInstSig $3)) } @@ -996,7 +1021,7 @@ exp10 :: { LHsExpr RdrName } : '\\' aexp aexps opt_asig '->' exp {% checkPatterns ($2 : reverse $3) >>= \ ps -> return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4 - (GRHSs (unguardedRHS $6) [] + (GRHSs (unguardedRHS $6) emptyLocalBinds )])) } | 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 } | 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 } @@ -1004,12 +1029,11 @@ exp10 :: { LHsExpr RdrName } | '-' fexp { LL $ mkHsNegApp $2 } | 'do' stmtlist {% let loc = comb2 $1 $2 in - checkDo loc (unLoc $2) >>= \ stmts -> - return (L loc (mkHsDo DoExpr stmts)) } + checkDo loc (unLoc $2) >>= \ (stmts,body) -> + return (L loc (mkHsDo DoExpr stmts body)) } | 'mdo' stmtlist {% let loc = comb2 $1 $2 in - checkMDo loc (unLoc $2) >>= \ stmts -> - return (L loc (mkHsDo MDoExpr stmts)) } - + checkDo loc (unLoc $2) >>= \ (stmts,body) -> + return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) } | scc_annot exp { LL $ if opt_SccProfilingOn then HsSCC (unLoc $1) $2 else HsPar $2 } @@ -1077,7 +1101,7 @@ aexp2 :: { LHsExpr RdrName } | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp ) | TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) } - | TH_VAR_QUOTE gcon { LL $ HsBracket (VarBr (unLoc $2)) } + | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) } | TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) } | TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) } | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) } @@ -1118,13 +1142,11 @@ texps :: { [LHsExpr RdrName] } list :: { LHsExpr RdrName } : exp { L1 $ ExplicitList placeHolderType [$1] } | lexps { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) } - | exp '..' { LL $ ArithSeqIn (From $1) } - | exp ',' exp '..' { LL $ ArithSeqIn (FromThen $1 $3) } - | exp '..' exp { LL $ ArithSeqIn (FromTo $1 $3) } - | exp ',' exp '..' exp { LL $ ArithSeqIn (FromThenTo $1 $3 $5) } - | exp pquals { LL $ mkHsDo ListComp - (reverse (L (getLoc $1) (ResultStmt $1) : - unLoc $2)) } + | exp '..' { LL $ ArithSeq noPostTcExpr (From $1) } + | exp ',' exp '..' { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) } + | exp '..' exp { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) } + | exp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) } + | exp pquals { sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 } lexps :: { Located [LHsExpr RdrName] } : lexps ',' exp { LL ($3 : unLoc $1) } @@ -1164,12 +1186,9 @@ parr :: { LHsExpr RdrName } | exp { L1 $ ExplicitPArr placeHolderType [$1] } | lexps { L1 $ ExplicitPArr placeHolderType (reverse (unLoc $1)) } - | exp '..' exp { LL $ PArrSeqIn (FromTo $1 $3) } - | exp ',' exp '..' exp { LL $ PArrSeqIn (FromThenTo $1 $3 $5) } - | exp pquals { LL $ mkHsDo PArrComp - (reverse (L (getLoc $1) (ResultStmt $1) : - unLoc $2)) - } + | exp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) } + | exp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) } + | exp pquals { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 } -- We are reusing `lexps' and `pquals' from the list case. @@ -1205,8 +1224,7 @@ gdpats :: { Located [LGRHS RdrName] } | gdpat { L1 [$1] } gdpat :: { LGRHS RdrName } - : '|' quals '->' exp { let r = L (getLoc $4) (ResultStmt $4) - in LL $ GRHS (reverse (r : unLoc $2)) } + : '|' quals '->' exp { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 } ----------------------------------------------------------------------------- -- Statement sequences @@ -1216,7 +1234,7 @@ stmtlist :: { Located [LStmt RdrName] } | vocurly stmts close { $2 } -- do { ;; s ; s ; ; s ;; } --- The last Stmt should be a ResultStmt, but that's hard to enforce +-- The last Stmt should be an expression, but that's hard to enforce -- here, because we need too much lookahead if we see do { e ; } -- So we use ExprStmts throughout, and switch the last one over -- in ParseUtils.checkDo instead @@ -1238,13 +1256,13 @@ maybe_stmt :: { Maybe (LStmt RdrName) } stmt :: { LStmt RdrName } : qual { $1 } | infixexp '->' exp {% checkPattern $3 >>= \p -> - return (LL $ BindStmt p $1) } - | 'rec' stmtlist { LL $ RecStmt (unLoc $2) undefined undefined undefined } + return (LL $ mkBindStmt p $1) } + | 'rec' stmtlist { LL $ mkRecStmt (unLoc $2) } qual :: { LStmt RdrName } : infixexp '<-' exp {% checkPattern $1 >>= \p -> - return (LL $ BindStmt p $3) } - | exp { L1 $ ExprStmt $1 placeHolderType } + return (LL $ mkBindStmt p $3) } + | exp { L1 $ mkExprStmt $1 } | 'let' binds { LL $ LetStmt (unLoc $2) } ----------------------------------------------------------------------------- @@ -1273,14 +1291,12 @@ dbinds :: { Located [LIPBind RdrName] } dbind :: { LIPBind RdrName } dbind : ipvar '=' exp { LL (IPBind (unLoc $1) $3) } ------------------------------------------------------------------------------ --- Variables, Constructors and Operators. +ipvar :: { Located (IPName RdrName) } + : IPDUPVARID { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) } + | IPSPLITVARID { L1 (Linear (mkUnqual varName (getIPSPLITVARID $1))) } -identifier :: { Located RdrName } - : qvar { $1 } - | gcon { $1 } - | qvarop { $1 } - | qconop { $1 } +----------------------------------------------------------------------------- +-- Deprecations depreclist :: { Located [RdrName] } depreclist : deprec_var { L1 [unLoc $1] } @@ -1288,49 +1304,25 @@ depreclist : deprec_var { L1 [unLoc $1] } deprec_var :: { Located RdrName } deprec_var : var { $1 } - | tycon { $1 } - -gcon :: { Located RdrName } -- Data constructor namespace - : sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) } - | qcon { $1 } --- the case of '[:' ':]' is part of the production `parr' - -sysdcon :: { Located DataCon } -- Wired in data constructors - : '(' ')' { LL unitDataCon } - | '(' commas ')' { LL $ tupleCon Boxed $2 } - | '[' ']' { LL nilDataCon } - -var :: { Located RdrName } - : varid { $1 } - | '(' varsym ')' { LL (unLoc $2) } - -qvar :: { Located RdrName } - : qvarid { $1 } - | '(' varsym ')' { LL (unLoc $2) } - | '(' qvarsym1 ')' { LL (unLoc $2) } --- We've inlined qvarsym here so that the decision about --- whether it's a qvar or a var can be postponed until --- *after* we see the close paren. - -ipvar :: { Located (IPName RdrName) } - : IPDUPVARID { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) } - | IPSPLITVARID { L1 (Linear (mkUnqual varName (getIPSPLITVARID $1))) } + | con { $1 } +----------------------------------------- +-- Data constructors qcon :: { Located RdrName } : qconid { $1 } | '(' qconsym ')' { LL (unLoc $2) } + | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) } +-- The case of '[:' ':]' is part of the production `parr' -varop :: { Located RdrName } - : varsym { $1 } - | '`' varid '`' { LL (unLoc $2) } - -qvarop :: { Located RdrName } - : qvarsym { $1 } - | '`' qvarid '`' { LL (unLoc $2) } +con :: { Located RdrName } + : conid { $1 } + | '(' consym ')' { LL (unLoc $2) } + | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) } -qvaropm :: { Located RdrName } - : qvarsym_no_minus { $1 } - | '`' qvarid '`' { LL (unLoc $2) } +sysdcon :: { Located DataCon } -- Wired in data constructors + : '(' ')' { LL unitDataCon } + | '(' commas ')' { LL $ tupleCon Boxed $2 } + | '[' ']' { LL nilDataCon } conop :: { Located RdrName } : consym { $1 } @@ -1359,10 +1351,6 @@ qtyconop :: { Located RdrName } -- Qualified or unqualified : qtyconsym { $1 } | '`' qtycon '`' { LL (unLoc $2) } -tyconop :: { Located RdrName } -- Unqualified - : tyconsym { $1 } - | '`' tycon '`' { LL (unLoc $2) } - qtycon :: { Located RdrName } -- Qualified or unqualified : QCONID { L1 $! mkQual tcClsName (getQCONID $1) } | tycon { $1 } @@ -1378,12 +1366,16 @@ tyconsym :: { Located RdrName } : CONSYM { L1 $! mkUnqual tcClsName (getCONSYM $1) } ----------------------------------------------------------------------------- --- Any operator +-- Operators op :: { Located RdrName } -- used in infix decls : varop { $1 } | conop { $1 } +varop :: { Located RdrName } + : varsym { $1 } + | '`' varid '`' { LL (unLoc $2) } + qop :: { LHsExpr RdrName } -- used in sections : qvarop { L1 $ HsVar (unLoc $1) } | qconop { L1 $ HsVar (unLoc $1) } @@ -1392,8 +1384,52 @@ qopm :: { LHsExpr RdrName } -- used in sections : qvaropm { L1 $ HsVar (unLoc $1) } | qconop { L1 $ HsVar (unLoc $1) } +qvarop :: { Located RdrName } + : qvarsym { $1 } + | '`' qvarid '`' { LL (unLoc $2) } + +qvaropm :: { Located RdrName } + : qvarsym_no_minus { $1 } + | '`' qvarid '`' { LL (unLoc $2) } + +----------------------------------------------------------------------------- +-- Type variables + +tyvar :: { Located RdrName } +tyvar : tyvarid { $1 } + | '(' tyvarsym ')' { LL (unLoc $2) } + +tyvarop :: { Located RdrName } +tyvarop : '`' tyvarid '`' { LL (unLoc $2) } + | tyvarsym { $1 } + +tyvarid :: { Located RdrName } + : VARID { L1 $! mkUnqual tvName (getVARID $1) } + | special_id { L1 $! mkUnqual tvName (unLoc $1) } + | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") } + | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") } + | 'threadsafe' { L1 $! mkUnqual tvName FSLIT("threadsafe") } + +tyvarsym :: { Located RdrName } +-- Does not include "!", because that is used for strictness marks +-- or ".", because that separates the quantified type vars from the rest +-- or "*", because that's used for kinds +tyvarsym : VARSYM { L1 $! mkUnqual tvName (getVARSYM $1) } + ----------------------------------------------------------------------------- --- VarIds +-- Variables + +var :: { Located RdrName } + : varid { $1 } + | '(' varsym ')' { LL (unLoc $2) } + +qvar :: { Located RdrName } + : qvarid { $1 } + | '(' varsym ')' { LL (unLoc $2) } + | '(' qvarsym1 ')' { LL (unLoc $2) } +-- We've inlined qvarsym here so that the decision about +-- whether it's a qvar or a var can be postponed until +-- *after* we see the close paren. qvarid :: { Located RdrName } : varid { $1 } @@ -1410,30 +1446,6 @@ varid_no_unsafe :: { Located RdrName } | special_id { L1 $! mkUnqual varName (unLoc $1) } | 'forall' { L1 $! mkUnqual varName FSLIT("forall") } -tyvar :: { Located RdrName } - : VARID { L1 $! mkUnqual tvName (getVARID $1) } - | special_id { L1 $! mkUnqual tvName (unLoc $1) } - | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") } - | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") } - | 'threadsafe' { L1 $! mkUnqual tvName FSLIT("threadsafe") } - --- These special_ids are treated as keywords in various places, --- but as ordinary ids elsewhere. 'special_id' collects all these --- except 'unsafe' and 'forall' whose treatment differs depending on context -special_id :: { Located UserFS } -special_id - : 'as' { L1 FSLIT("as") } - | 'qualified' { L1 FSLIT("qualified") } - | 'hiding' { L1 FSLIT("hiding") } - | 'export' { L1 FSLIT("export") } - | 'label' { L1 FSLIT("label") } - | 'dynamic' { L1 FSLIT("dynamic") } - | 'stdcall' { L1 FSLIT("stdcall") } - | 'ccall' { L1 FSLIT("ccall") } - ------------------------------------------------------------------------------ --- Variables - qvarsym :: { Located RdrName } : varsym { $1 } | qvarsym1 { $1 } @@ -1454,8 +1466,21 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-' | special_sym { L1 $ mkUnqual varName (unLoc $1) } --- See comments with special_id -special_sym :: { Located UserFS } +-- These special_ids are treated as keywords in various places, +-- but as ordinary ids elsewhere. 'special_id' collects all these +-- except 'unsafe' and 'forall' whose treatment differs depending on context +special_id :: { Located FastString } +special_id + : 'as' { L1 FSLIT("as") } + | 'qualified' { L1 FSLIT("qualified") } + | 'hiding' { L1 FSLIT("hiding") } + | 'export' { L1 FSLIT("export") } + | 'label' { L1 FSLIT("label") } + | 'dynamic' { L1 FSLIT("dynamic") } + | 'stdcall' { L1 FSLIT("stdcall") } + | 'ccall' { L1 FSLIT("ccall") } + +special_sym :: { Located FastString } special_sym : '!' { L1 FSLIT("!") } | '.' { L1 FSLIT(".") } | '*' { L1 FSLIT("*") } @@ -1541,6 +1566,8 @@ getPRIMINTEGER (L _ (ITprimint x)) = x getPRIMFLOAT (L _ (ITprimfloat x)) = x getPRIMDOUBLE (L _ (ITprimdouble x)) = x getTH_ID_SPLICE (L _ (ITidEscape x)) = x +getINLINE (L _ (ITinline_prag b)) = b +getSPEC_INLINE (L _ (ITspec_inline_prag b)) = b -- Utilities for combining source spans comb2 :: Located a -> Located b -> SrcSpan