X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y;h=9dc85a293cc243a757d5a7d20611112320d8b9f8;hb=292c077de7dbe98eb44911648f16e243b40db2ac;hp=51bd67a90188b3c1662b104977e44b8f11ce7257;hpb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 51bd67a..9dc85a2 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.31 2000/05/25 12:41:17 simonpj Exp $ +$Id: Parser.y,v 1.48 2000/11/16 11:39:37 simonmar Exp $ Haskell grammar. @@ -9,18 +9,18 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999 -} { -module Parser ( parse ) where +module Parser ( ParseStuff(..), parse ) where import HsSyn -import HsPragmas import HsTypes ( mkHsTupCon ) +import HsPat ( InPat(..) ) import RdrHsSyn import Lex import ParseUtil import RdrName -import PrelInfo ( mAIN_Name ) -import OccName ( varName, ipName, tcName, dataName, tcClsName, tvName ) +import PrelNames +import OccName ( UserFS, varName, ipName, tcName, dataName, tcClsName, tvName ) import SrcLoc ( SrcLoc ) import Module import CallConv @@ -30,6 +30,7 @@ import Panic import GlaExts import FastString ( tailFS ) +import Outputable #include "HsVersions.h" } @@ -112,6 +113,8 @@ Conflicts: 14 shift/reduce '{-# DEPRECATED' { ITdeprecated_prag } '#-}' { ITclose_prag } + '__expr' { ITexpr } + {- '__interface' { ITinterface } -- interface keywords '__export' { IT__export } @@ -127,6 +130,7 @@ Conflicts: 14 shift/reduce '__float' { ITfloat_lit } '__rational' { ITrational_lit } '__addr' { ITaddr_lit } + '__label' { ITlabel_lit } '__litlit' { ITlit_lit } '__string' { ITstring_lit } '__ccall' { ITccall $$ } @@ -155,10 +159,10 @@ Conflicts: 14 shift/reduce '!' { ITbang } '.' { ITdot } - '/\\' { ITbiglam } -- GHC-extension symbols - '{' { ITocurly } -- special symbols '}' { ITccurly } + '{|' { ITocurlybar } + '|}' { ITccurlybar } vccurly { ITvccurly } -- virtual close curly (from layout) '[' { ITobrack } ']' { ITcbrack } @@ -181,8 +185,6 @@ Conflicts: 14 shift/reduce IPVARID { ITipvarid $$ } -- GHC extension - PRAGMA { ITpragma $$ } - CHAR { ITchar $$ } STRING { ITstring $$ } INTEGER { ITinteger $$ } @@ -195,8 +197,6 @@ Conflicts: 14 shift/reduce PRIMDOUBLE { ITprimdouble $$ } CLITLIT { ITlitlit $$ } - UNKNOWN { ITunknown $$ } - %monad { P } { thenP } { returnP } %lexer { lexer } { ITeof } %name parse @@ -204,6 +204,13 @@ Conflicts: 14 shift/reduce %% ----------------------------------------------------------------------------- +-- Entry points + +parse :: { ParseStuff } + : module { PModule $1 } + | '__expr' exp { PExpr $2 } + +----------------------------------------------------------------------------- -- Module Header -- The place for module deprecation is really too restrictive, but if it @@ -228,8 +235,8 @@ body :: { ([RdrNameImportDecl], [RdrNameHsDecl]) } | layout_on top close { $2 } top :: { ([RdrNameImportDecl], [RdrNameHsDecl]) } - : importdecls ';' cvtopdecls { (reverse $1,$3) } - | importdecls { (reverse $1,[]) } + : importdecls { (reverse $1,[]) } + | importdecls ';' cvtopdecls { (reverse $1,$3) } | cvtopdecls { ([],$1) } cvtopdecls :: { [RdrNameHsDecl] } @@ -279,7 +286,7 @@ importdecls :: { [RdrNameImportDecl] } importdecl :: { RdrNameImportDecl } : 'import' srcloc maybe_src optqualified CONID maybeas maybeimpspec - { ImportDecl (mkSrcModuleFS $5) $3 $4 $6 $7 $2 } + { ImportDecl (mkModuleNameFS $5) $3 $4 $6 $7 $2 } maybe_src :: { WhereFrom } : '{-# SOURCE' '#-}' { ImportByUserSource } @@ -333,31 +340,26 @@ topdecl :: { RdrBinding } | srcloc 'data' ctype '=' constrs deriving {% checkDataHeader $3 `thenP` \(cs,c,ts) -> returnP (RdrHsDecl (TyClD - (TyData DataType cs c ts (reverse $5) (length $5) $6 - NoDataPragmas $1))) } + (mkTyData DataType cs c ts (reverse $5) (length $5) $6 $1))) } | srcloc 'newtype' ctype '=' newconstr deriving {% checkDataHeader $3 `thenP` \(cs,c,ts) -> returnP (RdrHsDecl (TyClD - (TyData NewType cs c ts [$5] 1 $6 - NoDataPragmas $1))) } + (mkTyData NewType cs c ts [$5] 1 $6 $1))) } | srcloc 'class' ctype fds where {% checkDataHeader $3 `thenP` \(cs,c,ts) -> - let (binds,sigs) - = cvMonoBindsAndSigs cvClassOpSig - (groupBindings $5) + let + (binds,sigs) = cvMonoBindsAndSigs cvClassOpSig (groupBindings $5) in returnP (RdrHsDecl (TyClD - (mkClassDecl cs c ts $4 sigs binds - NoClassPragmas $1))) } + (mkClassDecl cs c ts $4 sigs binds $1))) } | srcloc 'instance' inst_type where { let (binds,sigs) = cvMonoBindsAndSigs cvInstDeclSig (groupBindings $4) - in RdrHsDecl (InstD - (InstDecl $3 binds sigs dummyRdrVarName $1)) } + in RdrHsDecl (InstD (InstDecl $3 binds sigs Nothing $1)) } | srcloc 'default' '(' types0 ')' { RdrHsDecl (DefD (DefaultDecl $4 $1)) } @@ -454,7 +456,7 @@ deprecations :: { RdrBinding } -- SUP: TEMPORARY HACK, not checking for `module Foo' deprecation :: { RdrBinding } - : srcloc exportlist STRING + : srcloc depreclist STRING { foldr RdrAndBindings RdrNullBind [ RdrHsDecl (DeprecD (Deprecation n $3 $1)) | n <- $2 ] } @@ -493,7 +495,7 @@ sigtypes :: { [RdrNameHsType] } | sigtypes ',' sigtype { $3 : $1 } sigtype :: { RdrNameHsType } - : ctype { mkHsForAllTy Nothing [] $1 } + : ctype { (mkHsForAllTy Nothing [] $1) } sig_vars :: { [RdrName] } : sig_vars ',' var { $3 : $1 } @@ -506,16 +508,21 @@ sig_vars :: { [RdrName] } ctype :: { RdrNameHsType } : 'forall' tyvars '.' ctype { mkHsForAllTy (Just $2) [] $4 } | context type { mkHsForAllTy Nothing $1 $2 } - -- A type of form (context => type) is an *implicit* HsForAllTy + -- A type of form (context => type) is an *implicit* HsForAllTy | type { $1 } type :: { RdrNameHsType } - : btype '->' type { HsFunTy $1 $3 } + : gentype '->' type { HsFunTy $1 $3 } | ipvar '::' type { mkHsIParamTy $1 $3 } - | btype { $1 } + | gentype { $1 } + +gentype :: { RdrNameHsType } + : btype { $1 } +-- Generics + | atype tyconop atype { HsOpTy $1 $2 $3 } btype :: { RdrNameHsType } - : btype atype { HsAppTy $1 $2 } + : btype atype { (HsAppTy $1 $2) } | atype { $1 } atype :: { RdrNameHsType } @@ -524,14 +531,9 @@ atype :: { RdrNameHsType } | '(' type ',' types ')' { HsTupleTy (mkHsTupCon tcName Boxed ($2:$4)) ($2 : reverse $4) } | '(#' types '#)' { HsTupleTy (mkHsTupCon tcName Unboxed $2) (reverse $2) } | '[' type ']' { HsListTy $2 } - | '(' ctype ')' { $2 } - -gtycon :: { RdrName } - : qtycon { $1 } - | '(' ')' { unitTyCon_RDR } - | '(' '->' ')' { funTyCon_RDR } - | '[' ']' { listTyCon_RDR } - | '(' commas ')' { tupleTyCon_RDR $2 } + | '(' ctype ')' { $2 } +-- Generics + | INTEGER { HsNumTy $1 } -- An inst_type is what occurs in the head of an instance decl -- e.g. (Foo a, Gaz b) => Wibble a b @@ -573,6 +575,11 @@ varids0 :: { [RdrName] } ----------------------------------------------------------------------------- -- Datatype declarations +newconstr :: { RdrNameConDecl } + : srcloc conid atype { mkConDecl $2 [] [] (VanillaCon [Unbanged $3]) $1 } + | srcloc conid '{' var '::' type '}' + { mkConDecl $2 [] [] (RecCon [([$4], Unbanged $6)]) $1 } + constrs :: { [RdrNameConDecl] } : constrs '|' constr { $3 : $1 } | constr { [$1] } @@ -591,33 +598,22 @@ context :: { RdrNameContext } : btype '=>' {% checkContext $1 } constr_stuff :: { (RdrName, RdrNameConDetails) } - : scontype { (fst $1, VanillaCon (snd $1)) } + : btype {% mkVanillaCon $1 [] } + | btype '!' atype satypes {% mkVanillaCon $1 (Banged $3 : $4) } + | gtycon '{' fielddecls '}' {% mkRecCon $1 $3 } | sbtype conop sbtype { ($2, InfixCon $1 $3) } - | con '{' fielddecls '}' { ($1, RecCon (reverse $3)) } - -newconstr :: { RdrNameConDecl } - : srcloc conid atype { mkConDecl $2 [] [] (NewCon $3 Nothing) $1 } - | srcloc conid '{' var '::' type '}' - { mkConDecl $2 [] [] (NewCon $6 (Just $4)) $1 } - -scontype :: { (RdrName, [RdrNameBangType]) } - : btype {% splitForConApp $1 [] } - | scontype1 { $1 } -scontype1 :: { (RdrName, [RdrNameBangType]) } - : btype '!' atype {% splitForConApp $1 [Banged $3] } - | scontype1 satype { (fst $1, snd $1 ++ [$2] ) } - -satype :: { RdrNameBangType } - : atype { Unbanged $1 } - | '!' atype { Banged $2 } +satypes :: { [RdrNameBangType] } + : atype satypes { Unbanged $1 : $2 } + | '!' atype satypes { Banged $2 : $3 } + | {- empty -} { [] } sbtype :: { RdrNameBangType } : btype { Unbanged $1 } | '!' atype { Banged $2 } fielddecls :: { [([RdrName],RdrNameBangType)] } - : fielddecls ',' fielddecl { $3 : $1 } + : fielddecl ',' fielddecls { $1 : $3 } | fielddecl { [$1] } fielddecl :: { ([RdrName],RdrNameBangType) } @@ -661,15 +657,16 @@ dclasses :: { [RdrName] } -} valdef :: { RdrBinding } - : infixexp srcloc opt_sig rhs {% checkValDef $1 $3 $4 $2 } - | infixexp srcloc '::' sigtype {% checkValSig $1 $4 $2 } + : infixexp srcloc opt_sig rhs {% (checkValDef $1 $3 $4 $2) } + | infixexp srcloc '::' sigtype {% (checkValSig $1 $4 $2) } | var ',' sig_vars srcloc '::' sigtype { foldr1 RdrAndBindings [ RdrSig (Sig n $6 $4) | n <- $1:$3 ] - } + } + rhs :: { RdrNameGRHSs } - : '=' srcloc exp wherebinds { GRHSs (unguardedRHS $3 $2) - $4 Nothing} + : '=' srcloc exp wherebinds { (GRHSs (unguardedRHS $3 $2) + $4 Nothing)} | gdrhs wherebinds { GRHSs (reverse $1) $2 Nothing } gdrhs :: { [RdrNameGRHS] } @@ -683,13 +680,14 @@ gdrh :: { RdrNameGRHS } -- Expressions exp :: { RdrNameHsExpr } - : infixexp '::' sigtype { ExprWithTySig $1 $3 } + : infixexp '::' sigtype { (ExprWithTySig $1 $3) } | infixexp 'with' dbinding { HsWith $1 $3 } | infixexp { $1 } infixexp :: { RdrNameHsExpr } : exp10 { $1 } - | infixexp qop exp10 { OpApp $1 $2 (panic "fixity") $3 } + | infixexp qop exp10 { (OpApp $1 (HsVar $2) + (panic "fixity") $3 )} exp10 :: { RdrNameHsExpr } : '\\' aexp aexps opt_asig '->' srcloc exp @@ -700,7 +698,7 @@ exp10 :: { RdrNameHsExpr } | 'let' declbinds 'in' exp { HsLet $2 $4 } | 'if' srcloc exp 'then' exp 'else' exp { HsIf $3 $5 $7 $2 } | 'case' srcloc exp 'of' altslist { HsCase $3 $5 $2 } - | '-' fexp { NegApp $2 (error "NegApp") } + | '-' fexp { mkHsNegApp $2 } | srcloc 'do' stmtlist { HsDo DoStmt $3 $1 } | '_ccall_' ccallid aexps0 { HsCCall $2 $3 False False cbot } @@ -719,43 +717,47 @@ ccallid :: { FAST_STRING } | CONID { $1 } fexp :: { RdrNameHsExpr } - : fexp aexp { HsApp $1 $2 } + : fexp aexp { (HsApp $1 $2) } | aexp { $1 } aexps0 :: { [RdrNameHsExpr] } - : aexps { reverse $1 } + : aexps { (reverse $1) } aexps :: { [RdrNameHsExpr] } : aexps aexp { $2 : $1 } | {- empty -} { [] } aexp :: { RdrNameHsExpr } - : aexp '{' fbinds '}' {% mkRecConstrOrUpdate $1 (reverse $3) } - | aexp1 { $1 } + : var_or_con '{|' gentype '|}' { (HsApp $1 (HsType $3)) } + | aexp '{' fbinds '}' {% (mkRecConstrOrUpdate $1 + (reverse $3)) } + | aexp1 { $1 } + +var_or_con :: { RdrNameHsExpr } + : qvar { HsVar $1 } + | gcon { HsVar $1 } aexp1 :: { RdrNameHsExpr } - : qvar { HsVar $1 } - | ipvar { HsIPVar $1 } - | gcon { HsVar $1 } - | literal { HsLit $1 } + : ipvar { HsIPVar $1 } + | var_or_con { $1 } + | literal { HsLit $1 } + | INTEGER { HsOverLit (HsIntegral $1 fromInteger_RDR) } + | RATIONAL { HsOverLit (HsFractional $1 fromRational_RDR) } | '(' exp ')' { HsPar $2 } | '(' exp ',' texps ')' { ExplicitTuple ($2 : reverse $4) Boxed} | '(#' texps '#)' { ExplicitTuple (reverse $2) Unboxed } | '[' list ']' { $2 } - | '(' infixexp qop ')' { SectionL $2 $3 } - | '(' qopm infixexp ')' { SectionR $2 $3 } + | '(' infixexp qop ')' { (SectionL $2 (HsVar $3)) } + | '(' qopm infixexp ')' { (SectionR $2 $3) } | qvar '@' aexp { EAsPat $1 $3 } | '_' { EWildPat } | '~' aexp1 { ELazyPat $2 } -commas :: { Int } - : commas ',' { $1 + 1 } - | ',' { 2 } - texps :: { [RdrNameHsExpr] } : texps ',' exp { $3 : $1 } | exp { [$1] } + ----------------------------------------------------------------------------- -- List expressions @@ -769,8 +771,14 @@ list :: { RdrNameHsExpr } | exp ',' exp '..' { ArithSeqIn (FromThen $1 $3) } | exp '..' exp { ArithSeqIn (FromTo $1 $3) } | exp ',' exp '..' exp { ArithSeqIn (FromThenTo $1 $3 $5) } - | exp srcloc '|' quals { HsDo ListComp (reverse - (ReturnStmt $1 : $4)) $2 } + | exp srcloc pquals {% let { body [qs] = qs; + body qss = [ParStmt (map reverse qss)] } + in + returnP ( HsDo ListComp + (reverse (ReturnStmt $1 : body $3)) + $2 + ) + } lexps :: { [RdrNameHsExpr] } : lexps ',' exp { $3 : $1 } @@ -779,6 +787,10 @@ lexps :: { [RdrNameHsExpr] } ----------------------------------------------------------------------------- -- List Comprehensions +pquals :: { [[RdrNameStmt]] } + : pquals '|' quals { $3 : $1 } + | '|' quals { [$2] } + quals :: { [RdrNameStmt] } : quals ',' qual { $3 : $1 } | qual { [$1] } @@ -807,9 +819,9 @@ alts1 :: { [RdrNameMatch] } alt :: { RdrNameMatch } : infixexp opt_sig ralt wherebinds - {% checkPattern $1 `thenP` \p -> + {% (checkPattern $1 `thenP` \p -> returnP (Match [] [p] $2 - (GRHSs $3 $4 Nothing)) } + (GRHSs $3 $4 Nothing)) )} ralt :: { [RdrNameGRHS] } : '->' srcloc exp { [GRHS [ExprStmt $3 $2] $2] } @@ -879,6 +891,22 @@ dbind : ipvar '=' exp { ($1, $3) } ----------------------------------------------------------------------------- -- Variables, Constructors and Operators. +depreclist :: { [RdrName] } +depreclist : deprec_var { [$1] } + | deprec_var ',' depreclist { $1 : $3 } + +deprec_var :: { RdrName } +deprec_var : var { $1 } + | tycon { $1 } + +gtycon :: { RdrName } + : qtycon { $1 } + | '(' qtyconop ')' { $2 } + | '(' ')' { unitTyCon_RDR } + | '(' '->' ')' { funTyCon_RDR } + | '[' ']' { listTyCon_RDR } + | '(' commas ')' { tupleTyCon_RDR $2 } + gcon :: { RdrName } : '(' ')' { unitCon_RDR } | '[' ']' { nilCon_RDR } @@ -898,11 +926,7 @@ qvar :: { RdrName } -- *after* we see the close paren. ipvar :: { RdrName } - : IPVARID { (mkSrcUnqual ipName (tailFS $1)) } - -con :: { RdrName } - : conid { $1 } - | '(' consym ')' { $2 } + : IPVARID { (mkUnqual ipName (tailFS $1)) } qcon :: { RdrName } : qconid { $1 } @@ -917,7 +941,7 @@ qvarop :: { RdrName } | '`' qvarid '`' { $2 } qvaropm :: { RdrName } - : qvarsymm { $1 } + : qvarsym_no_minus { $1 } | '`' qvarid '`' { $2 } conop :: { RdrName } @@ -935,9 +959,9 @@ op :: { RdrName } -- used in infix decls : varop { $1 } | conop { $1 } -qop :: { RdrNameHsExpr } -- used in sections - : qvarop { HsVar $1 } - | qconop { HsVar $1 } +qop :: { RdrName {-HsExpr-} } -- used in sections + : qvarop { $1 } + | qconop { $1 } qopm :: { RdrNameHsExpr } -- used in sections : qvaropm { HsVar $1 } @@ -948,55 +972,55 @@ qopm :: { RdrNameHsExpr } -- used in sections qvarid :: { RdrName } : varid { $1 } - | QVARID { case $1 of { (mod,n) -> - mkSrcQual varName mod n } } + | QVARID { mkQual varName $1 } varid :: { RdrName } - : VARID { mkSrcUnqual varName $1 } - | 'as' { as_var_RDR } - | 'qualified' { qualified_var_RDR } - | 'hiding' { hiding_var_RDR } - | 'forall' { forall_var_RDR } - | 'export' { export_var_RDR } - | 'label' { label_var_RDR } - | 'dynamic' { dynamic_var_RDR } - | 'unsafe' { unsafe_var_RDR } - | 'stdcall' { stdcall_var_RDR } - | 'ccall' { ccall_var_RDR } + : varid_no_unsafe { $1 } + | 'unsafe' { mkUnqual varName SLIT("unsafe") } varid_no_unsafe :: { RdrName } - : VARID { mkSrcUnqual varName $1 } - | 'as' { as_var_RDR } - | 'qualified' { qualified_var_RDR } - | 'hiding' { hiding_var_RDR } - | 'forall' { forall_var_RDR } - | 'export' { export_var_RDR } - | 'label' { label_var_RDR } - | 'dynamic' { dynamic_var_RDR } - | 'stdcall' { stdcall_var_RDR } - | 'ccall' { ccall_var_RDR } + : VARID { mkUnqual varName $1 } + | special_id { mkUnqual varName $1 } + | 'forall' { mkUnqual varName SLIT("forall") } + +tyvar :: { RdrName } + : VARID { mkUnqual tvName $1 } + | special_id { mkUnqual tvName $1 } + | 'unsafe' { mkUnqual tvName SLIT("unsafe") } + +-- These special_ids are treated as keywords in various places, +-- but as ordinary ids elsewhere. A special_id collects all thsee +-- except 'unsafe' and 'forall' whose treatment differs depending on context +special_id :: { UserFS } +special_id + : 'as' { SLIT("as") } + | 'qualified' { SLIT("qualified") } + | 'hiding' { SLIT("hiding") } + | 'export' { SLIT("export") } + | 'label' { SLIT("label") } + | 'dynamic' { SLIT("dynamic") } + | 'stdcall' { SLIT("stdcall") } + | 'ccall' { SLIT("ccall") } ----------------------------------------------------------------------------- -- ConIds qconid :: { RdrName } : conid { $1 } - | QCONID { case $1 of { (mod,n) -> - mkSrcQual dataName mod n } } + | QCONID { mkQual dataName $1 } conid :: { RdrName } - : CONID { mkSrcUnqual dataName $1 } + : CONID { mkUnqual dataName $1 } ----------------------------------------------------------------------------- -- ConSyms qconsym :: { RdrName } : consym { $1 } - | QCONSYM { case $1 of { (mod,n) -> - mkSrcQual dataName mod n } } + | QCONSYM { mkQual dataName $1 } consym :: { RdrName } - : CONSYM { mkSrcUnqual dataName $1 } + : CONSYM { mkUnqual dataName $1 } ----------------------------------------------------------------------------- -- VarSyms @@ -1005,37 +1029,39 @@ qvarsym :: { RdrName } : varsym { $1 } | qvarsym1 { $1 } -qvarsymm :: { RdrName } - : varsymm { $1 } +qvarsym_no_minus :: { RdrName } + : varsym_no_minus { $1 } | qvarsym1 { $1 } +qvarsym1 :: { RdrName } +qvarsym1 : QVARSYM { mkQual varName $1 } + varsym :: { RdrName } - : VARSYM { mkSrcUnqual varName $1 } - | '-' { minus_RDR } - | '!' { pling_RDR } - | '.' { dot_RDR } + : varsym_no_minus { $1 } + | '-' { mkUnqual varName SLIT("-") } -varsymm :: { RdrName } -- varsym not including '-' - : VARSYM { mkSrcUnqual varName $1 } - | '!' { pling_RDR } - | '.' { dot_RDR } +varsym_no_minus :: { RdrName } -- varsym not including '-' + : VARSYM { mkUnqual varName $1 } + | special_sym { mkUnqual varName $1 } -qvarsym1 :: { RdrName } - : QVARSYM { case $1 of { (mod,n) -> - mkSrcQual varName mod n } } -literal :: { HsLit } - : INTEGER { HsInt $1 } - | CHAR { HsChar $1 } - | RATIONAL { HsFrac $1 } - | STRING { HsString $1 } +-- See comments with special_id +special_sym :: { UserFS } +special_sym : '!' { SLIT("!") } + | '.' { SLIT(".") } + +----------------------------------------------------------------------------- +-- Literals +literal :: { HsLit } + : CHAR { HsChar $1 } + | STRING { HsString $1 } | PRIMINTEGER { HsIntPrim $1 } | PRIMCHAR { HsCharPrim $1 } | PRIMSTRING { HsStringPrim $1 } | PRIMFLOAT { HsFloatPrim $1 } | PRIMDOUBLE { HsDoublePrim $1 } - | CLITLIT { HsLitLit $1 } + | CLITLIT { HsLitLit $1 (error "Parser.y: CLITLIT") } srcloc :: { SrcLoc } : {% getSrcLocP } @@ -1053,35 +1079,34 @@ layout_on_for_do :: { () } : {% layoutOn False } -- Miscellaneous (mostly renamings) modid :: { ModuleName } - : CONID { mkSrcModuleFS $1 } + : CONID { mkModuleNameFS $1 } tycon :: { RdrName } - : CONID { mkSrcUnqual tcClsName $1 } + : CONID { mkUnqual tcClsName $1 } + +tyconop :: { RdrName } + : CONSYM { mkUnqual tcClsName $1 } qtycon :: { RdrName } : tycon { $1 } - | QCONID { case $1 of { (mod,n) -> - mkSrcQual tcClsName mod n } } + | QCONID { mkQual tcClsName $1 } + +qtyconop :: { RdrName } + : tyconop { $1 } + | QCONSYM { mkQual tcClsName $1 } qtycls :: { RdrName } : qtycon { $1 } -tyvar :: { RdrName } - : VARID { mkSrcUnqual tvName $1 } - | 'as' { as_tyvar_RDR } - | 'qualified' { qualified_tyvar_RDR } - | 'hiding' { hiding_tyvar_RDR } - | 'export' { export_tyvar_RDR } - | 'label' { label_tyvar_RDR } - | 'dynamic' { dynamic_tyvar_RDR } - | 'unsafe' { unsafe_tyvar_RDR } - | 'stdcall' { stdcall_tyvar_RDR } - | 'ccall' { ccall_tyvar_RDR } - -- NOTE: no 'forall' +commas :: { Int } + : commas ',' { $1 + 1 } + | ',' { 2 } ----------------------------------------------------------------------------- { +data ParseStuff = PModule RdrNameHsModule | PExpr RdrNameHsExpr + happyError :: P a happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc) }