X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y.pp;h=d49ec761c6387103877509801767f6584cf7bd43;hb=f85903abe9103e545ea5b1dc6fdd6b672da4f3f2;hp=9378f768db272d734173e91d7a505cd0790514e2;hpb=9e4a57507258b242de787bd4263887ba90760139;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp index 9378f76..d49ec76 100644 --- a/ghc/compiler/parser/Parser.y.pp +++ b/ghc/compiler/parser/Parser.y.pp @@ -25,18 +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 Panic import FastString import Maybes ( orElse ) @@ -184,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 } @@ -280,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 @@ -361,7 +368,7 @@ qcnames :: { [RdrName] } qcname :: { Located RdrName } -- Variable or data constructor : qvar { $1 } - | gcon { $1 } + | qcon { $1 } ----------------------------------------------------------------------------- -- Import Declarations @@ -447,18 +454,16 @@ tycl_decl :: { LTyClDecl RdrName } {% do { (tc,tvs) <- checkSynHdr $2 ; return (LL (TySynonym tc tvs $4)) } } - | 'data' tycl_hdr constrs deriving + | 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 DataType $2 Nothing (reverse (unLoc $3)) (unLoc $4)) } + (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 @@ -467,6 +472,10 @@ 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 } @@ -500,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 } ----------------------------------------------------------------------------- @@ -521,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) } - -activation :: { Activation } -- Omitted means AlwaysActive - : {- empty -} { AlwaysActive } - | explicit_activation { $1 } + { LL $ RuleD (HsRule (getSTRING $1) + ($2 `orElse` AlwaysActive) + $3 $4 placeHolderNames $6 placeHolderNames) } -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)) } @@ -767,7 +774,7 @@ gentype :: { LHsType RdrName } : btype { $1 } | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 } | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 } - | btype '->' gentype { LL $ HsFunTy $1 $3 } + | btype '->' ctype { LL $ HsFunTy $1 $3 } btype :: { LHsType RdrName } : btype atype { LL $ HsAppTy $1 $2 } @@ -777,10 +784,10 @@ atype :: { LHsType RdrName } : gtycon { L1 (HsTyVar (unLoc $1)) } | tyvar { L1 (HsTyVar (unLoc $1)) } | strict_mark atype { LL (HsBangTy (unLoc $1) $2) } - | '(' type ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) } + | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) } | '(#' comma_types1 '#)' { LL $ HsTupleTy Unboxed $2 } - | '[' type ']' { LL $ HsListTy $2 } - | '[:' type ':]' { LL $ HsPArrTy $2 } + | '[' ctype ']' { LL $ HsListTy $2 } + | '[:' ctype ':]' { LL $ HsPArrTy $2 } | '(' ctype ')' { LL $ HsParTy $2 } | '(' ctype '::' kind ')' { LL $ HsKindSig $2 $4 } -- Generics @@ -802,8 +809,8 @@ comma_types0 :: { [LHsType RdrName] } | {- empty -} { [] } comma_types1 :: { [LHsType RdrName] } - : type { [$1] } - | type ',' comma_types1 { $1 : $3 } + : ctype { [$1] } + | ctype ',' comma_types1 { $1 : $3 } tv_bndrs :: { [LHsTyVarBndr RdrName] } : tv_bndr tv_bndrs { $1 : $2 } @@ -844,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 } @@ -858,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 [] } @@ -873,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 } @@ -895,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] } @@ -941,6 +968,10 @@ deriving :: { Located (Maybe [LHsType RdrName]) } decl :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } + | '!' infixexp rhs {% do { pat <- checkPattern $2; + return (LL $ unitOL $ LL $ ValD $ + PatBind (LL $ BangPat pat) (unLoc $3) + placeHolderType placeHolderNames) } } | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3; return (LL $ unitOL (LL $ ValD r)) } } @@ -953,8 +984,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 @@ -962,16 +992,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)) } @@ -994,7 +1025,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 } @@ -1002,12 +1033,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 } @@ -1037,6 +1067,7 @@ aexps :: { [LHsExpr RdrName] } aexp :: { LHsExpr RdrName } : qvar '@' aexp { LL $ EAsPat $1 $3 } | '~' aexp { LL $ ELazyPat $2 } +-- | '!' aexp { LL $ EBangPat $2 } | aexp1 { $1 } aexp1 :: { LHsExpr RdrName } @@ -1060,7 +1091,7 @@ aexp2 :: { LHsExpr RdrName } | INTEGER { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) } | RATIONAL { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) } | '(' exp ')' { LL (HsPar $2) } - | '(' exp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed } + | '(' texp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed } | '(#' texps '#)' { LL $ ExplicitTuple (reverse $2) Unboxed } | '[' list ']' { LL (unLoc $2) } | '[:' parr ':]' { LL (unLoc $2) } @@ -1075,7 +1106,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) } @@ -1102,9 +1133,15 @@ cvtopdecls0 :: { [LHsDecl RdrName] } : {- empty -} { [] } | cvtopdecls { $1 } +texp :: { LHsExpr RdrName } + : exp { $1 } + | qopm infixexp { LL $ SectionR $1 $2 } + -- The second production is really here only for bang patterns + -- but + texps :: { [LHsExpr RdrName] } - : texps ',' exp { $3 : $1 } - | exp { [$1] } + : texps ',' texp { $3 : $1 } + | texp { [$1] } ----------------------------------------------------------------------------- @@ -1114,19 +1151,17 @@ texps :: { [LHsExpr RdrName] } -- avoiding another shift/reduce-conflict. list :: { LHsExpr RdrName } - : exp { L1 $ ExplicitList placeHolderType [$1] } + : texp { 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)) } + | texp '..' { LL $ ArithSeq noPostTcExpr (From $1) } + | texp ',' exp '..' { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) } + | texp '..' exp { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) } + | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) } + | texp pquals { sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 } lexps :: { Located [LHsExpr RdrName] } - : lexps ',' exp { LL ($3 : unLoc $1) } - | exp ',' exp { LL [$3,$1] } + : lexps ',' texp { LL ($3 : unLoc $1) } + | texp ',' texp { LL [$3,$1] } ----------------------------------------------------------------------------- -- List Comprehensions @@ -1162,12 +1197,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. @@ -1203,8 +1235,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 @@ -1214,7 +1245,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 @@ -1236,13 +1267,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 } + : exp '<-' exp {% checkPattern $1 >>= \p -> + return (LL $ mkBindStmt p $3) } + | exp { L1 $ mkExprStmt $1 } | 'let' binds { LL $ LetStmt (unLoc $2) } ----------------------------------------------------------------------------- @@ -1271,14 +1302,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] } @@ -1286,49 +1315,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 } @@ -1372,12 +1377,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) } @@ -1386,23 +1395,16 @@ qopm :: { LHsExpr RdrName } -- used in sections : qvaropm { L1 $ HsVar (unLoc $1) } | qconop { L1 $ HsVar (unLoc $1) } ------------------------------------------------------------------------------ --- VarIds - -qvarid :: { Located RdrName } - : varid { $1 } - | QVARID { L1 $ mkQual varName (getQVARID $1) } +qvarop :: { Located RdrName } + : qvarsym { $1 } + | '`' qvarid '`' { LL (unLoc $2) } -varid :: { Located RdrName } - : varid_no_unsafe { $1 } - | 'unsafe' { L1 $! mkUnqual varName FSLIT("unsafe") } - | 'safe' { L1 $! mkUnqual varName FSLIT("safe") } - | 'threadsafe' { L1 $! mkUnqual varName FSLIT("threadsafe") } +qvaropm :: { Located RdrName } + : qvarsym_no_minus { $1 } + | '`' qvarid '`' { LL (unLoc $2) } -varid_no_unsafe :: { Located RdrName } - : VARID { L1 $! mkUnqual varName (getVARID $1) } - | special_id { L1 $! mkUnqual varName (unLoc $1) } - | 'forall' { L1 $! mkUnqual varName FSLIT("forall") } +----------------------------------------------------------------------------- +-- Type variables tyvar :: { Located RdrName } tyvar : tyvarid { $1 } @@ -1425,23 +1427,36 @@ tyvarsym :: { Located RdrName } -- or "*", because that's used for kinds tyvarsym : VARSYM { L1 $! mkUnqual tvName (getVARSYM $1) } --- 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 +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 } + | QVARID { L1 $ mkQual varName (getQVARID $1) } + +varid :: { Located RdrName } + : varid_no_unsafe { $1 } + | 'unsafe' { L1 $! mkUnqual varName FSLIT("unsafe") } + | 'safe' { L1 $! mkUnqual varName FSLIT("safe") } + | 'threadsafe' { L1 $! mkUnqual varName FSLIT("threadsafe") } + +varid_no_unsafe :: { Located RdrName } + : VARID { L1 $! mkUnqual varName (getVARID $1) } + | special_id { L1 $! mkUnqual varName (unLoc $1) } + | 'forall' { L1 $! mkUnqual varName FSLIT("forall") } + qvarsym :: { Located RdrName } : varsym { $1 } | qvarsym1 { $1 } @@ -1462,8 +1477,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("*") } @@ -1549,6 +1577,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