diff options
Diffstat (limited to 'src/HsParser.ly')
| -rw-r--r-- | src/HsParser.ly | 1024 |
1 files changed, 0 insertions, 1024 deletions
diff --git a/src/HsParser.ly b/src/HsParser.ly deleted file mode 100644 index c3edd3ce..00000000 --- a/src/HsParser.ly +++ /dev/null @@ -1,1024 +0,0 @@ ------------------------------------------------------------------------------ -$Id: HsParser.ly,v 1.21 2004/08/09 11:55:07 simonmar Exp $ - -(c) Simon Marlow, Sven Panne 1997-2002 - -Haskell grammar. ------------------------------------------------------------------------------ - -ToDo: Is (,) valid as exports? We don't allow it. -ToDo: Check exactly which names must be qualified with Prelude (commas and friends) -ToDo: Inst (MPCs?) -ToDo: Polish constr a bit -ToDo: Ugly: exp0b is used for lhs, pat, exp0, ... -ToDo: Differentiate between record updates and labeled construction. - -> { -> module HsParser (parse) where -> -> import Monad -> import HsSyn2 -> import HsParseMonad -> import HsLexer -> import HsParseUtils -> import HaddockLex2 hiding (Token) -> import HaddockParse2 -> import HaddockUtil hiding (splitTyConApp) -> import Char ( isSpace ) -> } - ------------------------------------------------------------------------------ -Conflicts: 3 shift/reduce - -2 for ambiguity in 'case x of y | let z = y in z :: a -> b' - (don't know whether to reduce 'True' as a btype or shift the '->'. - Similarly lambda and if. This is a rather arcane special case: - the default resolution in favour of the shift does what the Report - specifies, but the result will always fail to type-check.) - -1 for ambiguity in 'x @ Rec{..}'. - Only sensible parse is 'x @ (Rec{..})', which is what resolving - to shift gives us. - ------------------------------------------------------------------------------ - -> %token -> VARID { VarId $$ } -> IPVARID { IPVarId $$ } -> QVARID { QVarId $$ } -> CONID { ConId $$ } -> QCONID { QConId $$ } -> VARSYM { VarSym $$ } -> CONSYM { ConSym $$ } -> QVARSYM { QVarSym $$ } -> QCONSYM { QConSym $$ } -> INT { IntTok $$ } -> RATIONAL { FloatTok $$ } -> CHAR { Character $$ } -> STRING { StringTok $$ } - -> PRIMINT { PrimInt $$ } -> PRIMSTRING { PrimString $$ } -> PRIMFLOAT { PrimFloat $$ } -> PRIMDOUBLE { PrimDouble $$ } -> PRIMCHAR { PrimChar $$ } - -Docs - -> DOCNEXT { DocCommentNext $$ } -> DOCPREV { DocCommentPrev $$ } -> DOCNAMED { DocCommentNamed $$ } -> DOCSECTION { DocSection _ _ } -> DOCOPTIONS { DocOptions $$ } - -Symbols - -> '(' { LeftParen } -> ')' { RightParen } -> '(#' { LeftUT } -> '#)' { RightUT } -> ';' { SemiColon } -> '{' { LeftCurly } -> '}' { RightCurly } -> vccurly { VRightCurly } -- a virtual close brace -> '[' { LeftSquare } -> ']' { RightSquare } -> ',' { Comma } -> '_' { Underscore } -> '`' { BackQuote } - -Reserved operators - -> '.' { Dot } -> '..' { DotDot } -> '::' { DoubleColon } -> '=' { Equals } -> '\\' { Backslash } -> '|' { Bar } -> '<-' { LeftArrow } -> '->' { RightArrow } -> '@' { At } -> '~' { Tilde } -> '=>' { DoubleArrow } -> '-' { Minus } -> '!' { Exclamation } - -Reserved Ids - -> 'as' { KW_As } -> 'case' { KW_Case } -> 'ccall' { KW_CCall } -> 'class' { KW_Class } -> 'data' { KW_Data } -> 'default' { KW_Default } -> 'deriving' { KW_Deriving } -> 'do' { KW_Do } -> 'dotnet' { KW_DotNet } -> 'else' { KW_Else } -> 'export' { KW_Export } -> 'forall' { KW_Forall } -> 'foreign' { KW_Foreign } -> 'hiding' { KW_Hiding } -> 'if' { KW_If } -> 'import' { KW_Import } -> 'in' { KW_In } -> 'infix' { KW_Infix } -> 'infixl' { KW_InfixL } -> 'infixr' { KW_InfixR } -> 'instance' { KW_Instance } -> 'let' { KW_Let } -> 'module' { KW_Module } -> 'newtype' { KW_NewType } -> 'of' { KW_Of } -> 'safe' { KW_Safe } -> 'stdcall' { KW_StdCall } -> 'then' { KW_Then } -> 'threadsafe' { KW_ThreadSafe } -> 'type' { KW_Type } -> 'unsafe' { KW_Unsafe } -> 'where' { KW_Where } -> 'qualified' { KW_Qualified } - -> %monad { P } { thenP } { returnP } -> %lexer { lexer } { EOF } -> %name parse -> %tokentype { Token } -> %% - ------------------------------------------------------------------------------ -Module Header - -> module :: { HsModule } -> : optdoc 'module' srcloc modid maybeexports 'where' body -> { case $1 of { (opts,info,doc) -> -> HsModule $3 $4 $5 (reverse (fst $7)) (snd $7) -> opts info doc } } -> | body srcloc -> { HsModule $2 main_mod Nothing (reverse (fst $1)) (snd $1) -> Nothing emptyModuleInfo Nothing } - -> optdoc :: { (Maybe String,ModuleInfo,Maybe Doc) } -> : moduleheader { (Nothing, fst $1, snd $1) } -> | DOCOPTIONS { (Just $1, emptyModuleInfo,Nothing) } -> | DOCOPTIONS moduleheader { (Just $1, fst $2, snd $2) } -> | moduleheader DOCOPTIONS { (Just $2, fst $1, snd $1) } -> | {- empty -} { (Nothing, emptyModuleInfo,Nothing) } - -> body :: { ([HsImportDecl],[HsDecl]) } -> : '{' bodyaux '}' { $2 } -> | layout_on bodyaux close { $2 } - -> bodyaux :: { ([HsImportDecl],[HsDecl]) } -> : impdecls ';' topdecls { ($1, $3) } -> | topdecls { ([], $1) } -> | impdecls { ($1, []) } - -> optsemi :: { () } -> : ';' { () } -> | {- empty -} { () } - ------------------------------------------------------------------------------ -The Export List - -> maybeexports :: { Maybe [HsExportSpec] } -> : exports { Just $1 } -> | {- empty -} { Nothing } - -> exports :: { [HsExportSpec] } -> : '(' exportlist ')' { $2 } - -> exportlist :: { [HsExportSpec] } -> : export exportlist1 { $1 : $2 } -> | exp_doc exportlist { $1 : $2 } -> | {- empty -} { [] } - -> exportlist1 :: { [HsExportSpec] } -> : exp_doc exportlist1 { $1 : $2 } -> | ',' exportlist { $2 } -> | {- empty -} { [] } - -> exp_doc :: { HsExportSpec } -> : docsection { case $1 of { (i,s) -> HsEGroup i s } } -> | docnamed { HsEDocNamed (fst $1) } -> | docnext { HsEDoc $1 } - -> export :: { HsExportSpec } -> : qvar { HsEVar $1 } -> | qgtycon { HsEAbs $1 } -> | qgtycon '(' '..' ')' { HsEThingAll $1 } -> | qgtycon '(' ')' { HsEThingWith $1 [] } -> | qgtycon '(' qcnames ')' { HsEThingWith $1 (reverse $3) } -> | 'module' modid { HsEModuleContents $2 } - -> qcnames :: { [HsQName] } -> : qcnames ',' qcname { $3 : $1 } -> | qcname { [$1] } - -> qcname :: { HsQName } -> : qvar { $1 } -> | gcon { $1 } - ------------------------------------------------------------------------------ -Import Declarations - -> impdecls :: { [HsImportDecl] } -> : impdecls ';' impdecl { $3 : $1 } -> | impdecl { [$1] } - -> impdecl :: { HsImportDecl } -> : 'import' srcloc optqualified modid maybeas maybeimpspec -> { HsImportDecl $2 $4 $3 $5 $6 } - -> optqualified :: { Bool } -> : 'qualified' { True } -> | {- empty -} { False } - -> maybeas :: { Maybe Module } -> : 'as' modid { Just $2 } -> | {- empty -} { Nothing } - - -> maybeimpspec :: { Maybe (Bool, [HsImportSpec]) } -> : impspec { Just $1 } -> | {- empty -} { Nothing } - -> impspec :: { (Bool, [HsImportSpec]) } -> : '(' importlist ')' { (False, reverse $2) } -> | 'hiding' '(' importlist ')' { (True, reverse $3) } - -> importlist :: { [HsImportSpec] } -> : importlist ',' import { $3 : $1 } -> | importlist ',' { $1 } -> | import { [$1] } -> | {- empty -} { [] } - -> import :: { HsImportSpec } -> : var { HsIVar $1 } -> | gtycon { HsIAbs $1 } -> | gtycon '(' '..' ')' { HsIThingAll $1 } -> | gtycon '(' ')' { HsIThingWith $1 [] } -> | gtycon '(' cnames ')' { HsIThingWith $1 (reverse $3) } - -> gtycon :: { HsName } -> : tyconorcls { $1 } -> | '(' ')' { unit_tycon_name } -> | '(' '->' ')' { fun_tycon_name } -> | '[' ']' { list_tycon_name } -> | '(' commas ')' { tuple_tycon_name $2 } - -> cnames :: { [HsName] } -> : cnames ',' cname { $3 : $1 } -> | cname { [$1] } - -> cname :: { HsName } -> : var { $1 } -> | con { $1 } - ------------------------------------------------------------------------------ -Fixity Declarations - -> fixdecl :: { HsDecl } -> : srcloc infix prec ops { HsInfixDecl $1 $2 $3 (reverse $4) } - -> prec :: { Int } -> : {- empty -} { 9 } -> | INT {% checkPrec $1 `thenP` \p -> -> returnP (fromIntegral $1) } - -> infix :: { HsAssoc } -> : 'infix' { HsAssocNone } -> | 'infixl' { HsAssocLeft } -> | 'infixr' { HsAssocRight } - -> ops :: { [HsName] } -> : ops ',' op { $3 : $1 } -> | op { [$1] } - ------------------------------------------------------------------------------ -Top-Level Declarations - -> topdecls :: { [HsDecl] } -> : topdecl ';' topdecls { $1 : $3 } -> | ';' topdecls { $2 } -> | docdecl topdecls { $1 : $2 } -> | topdecl { [$1] } -> | {- empty -} { [] } - -> topdecl :: { HsDecl } -> : 'type' simpletype srcloc '=' ctypedoc -> { HsTypeDecl $3 (fst $2) (snd $2) $5 Nothing } -> | 'data' ctype srcloc constrs deriving -> {% checkDataHeader $2 `thenP` \(cs,c,t) -> -> returnP (HsDataDecl $3 cs c t $4 $5 Nothing) } -> | 'newtype' ctype srcloc '=' constr deriving -> {% checkDataHeader $2 `thenP` \(cs,c,t) -> -> returnP (HsNewTypeDecl $3 cs c t $5 $6 Nothing) } -> | 'class' srcloc ctype fds optcbody -> {% checkClassHeader $3 `thenP` \(ctxt,n,tys) -> -> returnP (HsClassDecl $2 ctxt n tys $4 $5 Nothing) } -> | 'instance' srcloc ctype optvaldefs -> {% checkInstHeader $3 `thenP` \(ctxt,asst) -> -> returnP (HsInstDecl $2 ctxt asst $4) } -> | 'default' srcloc '(' typelist ')' -> { HsDefaultDecl $2 $4 } -> | 'foreign' fdecl { $2 } -> | decl { $1 } - -> typelist :: { [HsType] } -> : types { $1 } -> | type { [$1] } -> | {- empty -} { [] } - -> decls :: { [HsDecl] } -> : decl ';' decls { $1 : $3 } -> | docdecl decls { $1 : $2 } -> | ';' decls { $2 } -> | decl { [$1] } -> | {- empty -} { [] } - -> decl :: { HsDecl } -> : signdecl { $1 } -> | fixdecl { $1 } -> | valdef { $1 } - -> docdecl :: { HsDecl } -> : srcloc docnext { HsDocCommentNext $1 $2 } -> | srcloc docprev { HsDocCommentPrev $1 $2 } -> | srcloc docnamed { case $2 of { (n,s) -> -> HsDocCommentNamed $1 n s } } -> | srcloc docsection { case $2 of { (i,s) -> HsDocGroup $1 i s } } - -> decllist :: { [HsDecl] } -> : '{' decls '}' { $2 } -> | layout_on decls close { $2 } - -> signdecl :: { HsDecl } -> : vars srcloc '::' ctypedoc { HsTypeSig $2 (reverse $1) $4 Nothing } - -ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var -instead of qvar, we get another shift/reduce-conflict. Consider the -following programs: - - { (+) :: ... } only var - { (+) x y = ... } could (incorrectly) be qvar - -We re-use expressions for patterns, so a qvar would be allowed in patterns -instead of a var only (which would be correct). But deciding what the + is, -would require more lookahead. So let's check for ourselves... - -> vars :: { [HsName] } -> : vars ',' var { $3 : $1 } -> | qvar {% checkUnQual $1 `thenP` \n -> -> returnP [n] } - ------------------------------------------------------------------------------ -Foreign Declarations - -> fdecl :: { HsDecl } -> fdecl : srcloc 'import' callconv safety fspec -> { case $5 of (spec,nm,ty) -> HsForeignImport $1 $3 $4 spec nm ty Nothing } -> | srcloc 'import' callconv fspec -> { case $4 of (spec,nm,ty) -> HsForeignImport $1 $3 HsFISafe spec nm ty Nothing } -> | srcloc 'export' callconv fspec -> { case $4 of (spec,nm,ty) -> HsForeignExport $1 $3 spec nm ty } - -> callconv :: { HsCallConv } -> : 'stdcall' { HsStdCall } -> | 'ccall' { HsCCall } -> | 'dotnet' { HsDotNetCall } - -> safety :: { HsFISafety } -> : 'unsafe' { HsFIUnsafe } -> | 'safe' { HsFISafe } -> | 'threadsafe' { HsFIThreadSafe } - -> fspec :: { (String, HsName, HsType) } -> : STRING varid '::' ctypedoc { ($1, $2, $4) } -> | varid '::' ctypedoc { ("", $1, $3) } - ------------------------------------------------------------------------------ -Types - -> doctype :: { HsType } -> : tydoc '->' doctype { HsTyFun $1 $3 } -> | tydoc { $1 } - -> tydoc :: { HsType } -> : btype { $1 } -> | btype docprev { HsTyDoc $1 $2 } - -> type :: { HsType } -> : ipvar '::' type1 { HsTyIP $1 $3 } -> | type1 { $1 } - -> type1 :: { HsType } -> : btype { $1 } -> | btype '->' type1 { HsTyFun $1 $3 } - -> btype :: { HsType } -> : btype atype { HsTyApp $1 $2 } -> | atype { $1 } - -> atype :: { HsType } -> : qgtycon { HsTyCon $1 } -> | tyvar { HsTyVar $1 } -> | '(' types ')' { HsTyTuple True $2 } -> | '(#' type '#)' { HsTyTuple False [$2] } -> | '(#' types '#)' { HsTyTuple False $2 } -> | '[' type ']' { HsTyApp list_tycon $2 } -> | '(' ctype ')' { $2 } - -> qgtycon :: { HsQName } -> : qtycls { $1 } -> | '(' ')' { unit_tycon_qname } -> | '(' '->' ')' { fun_tycon_qname } -> | '[' ']' { list_tycon_qname } -> | '(' commas ')' { tuple_tycon_qname $2 } - -(Slightly edited) Comment from GHC's hsparser.y: -"context => type" vs "type" is a problem, because you can't distinguish between - - foo :: (Baz a, Baz a) - bar :: (Baz a, Baz a) => [a] -> [a] -> [a] - -with one token of lookahead. The HACK is to parse the context as a btype -(more specifically as a tuple type), then check that it has the right form -C a, or (C1 a, C2 b, ... Cn z) and convert it into a context. Blaach! - -> ctype :: { HsType } -> : 'forall' tyvars '.' ctype { mkHsForAllType (Just $2) [] $4 } -> | context '=>' type { mkHsForAllType Nothing $1 $3 } -> | type { $1 } - -> ctypedoc :: { HsType } -> : 'forall' tyvars '.' ctypedoc { mkHsForAllType (Just $2) [] $4 } -> | context '=>' doctype { mkHsForAllType Nothing $1 $3 } -> | doctype { $1 } - -> context :: { HsIPContext } -> : btype {% checkContext $1 } - -> types :: { [HsType] } -> : type ',' types { $1 : $3 } -> | type ',' type { [$1,$3] } - -> simpletype :: { (HsName, [HsName]) } -> : tycon tyvars { ($1,$2) } - -> tyvars :: { [HsName] } -> : tyvar tyvars { $1 : $2 } -> | {- empty -} { [] } - ------------------------------------------------------------------------------ -Datatype declarations - -> constrs :: { [HsConDecl] } -> : {- empty; a GHC extension -} { [] } -> | maybe_docnext '=' constrs1 { addConDocs $3 $1 } - -> constrs1 :: { [HsConDecl] } -> : constr maybe_docnext '|' maybe_docprev constrs1 -> { addConDoc $1 $4 : addConDocs $5 $2 } -> | constr { [$1] } - -> constr :: { HsConDecl } -> : srcloc maybe_docnext forall_stuff constr_stuff maybe_docprev -> { HsConDecl $1 (fst $4) $3 [] (snd $4) ($2 `mplus` $5) } -> | srcloc maybe_docnext forall_stuff context '=>' constr_stuff maybe_docprev -> {% checkIPContext $4 `thenP` \ ctxt -> returnP (HsConDecl $1 (fst $6) $3 ctxt (snd $6) ($2 `mplus` $7)) } -> | srcloc maybe_docnext forall_stuff con '{' fielddecls '}' maybe_docprev -> { HsRecDecl $1 $4 $3 [] $6 ($2 `mplus` $8) } -> | srcloc maybe_docnext forall_stuff context '=>' con '{' fielddecls '}' maybe_docprev -> {% checkIPContext $4 `thenP` \ ctxt -> returnP (HsRecDecl $1 $6 $3 ctxt $8 ($2 `mplus` $10)) } - -> forall_stuff :: { [HsName] } -> : 'forall' tyvars '.' { $2 } -> | {- empty -} { [] } - -> constr_stuff :: { (HsName, [HsBangType]) } -> : scontype { $1 } -> | sbtype conop sbtype { ($2, [$1,$3]) } - -> scontype :: { (HsName, [HsBangType]) } -> : btype {% splitTyConApp $1 `thenP` \(c,ts) -> -> returnP (toVarHsName c, -> map HsUnBangedTy ts) } -> | scontype1 { $1 } - -> scontype1 :: { (HsName, [HsBangType]) } -> : btype '!' atype {% splitTyConApp $1 `thenP` \(c,ts) -> -> returnP (toVarHsName c, -> map HsUnBangedTy ts++ -> [HsBangedTy $3]) } -> | scontype1 satype { (fst $1, snd $1 ++ [$2] ) } - -> satype :: { HsBangType } -> : atype { HsUnBangedTy $1 } -> | '!' atype { HsBangedTy $2 } - -> sbtype :: { HsBangType } -> : btype { HsUnBangedTy $1 } -> | '!' atype { HsBangedTy $2 } - -> fielddecls :: { [HsFieldDecl] } -> : fielddecl maybe_docnext ',' maybe_docprev fielddecls -> { addFieldDoc $1 $4 : addFieldDocs $5 $2 } -> | ',' fielddecls { $2 } -> | fielddecl { [$1] } -> | {- empty -} { [] } - -> fielddecl :: { HsFieldDecl } -> : maybe_docnext vars '::' stype maybe_docprev -> { HsFieldDecl (reverse $2) $4 ($1 `mplus` $5) } - -> stype :: { HsBangType } -> : ctype { HsUnBangedTy $1 } -> | '!' atype { HsBangedTy $2 } - -> deriving :: { [HsQName] } -> : {- empty -} { [] } -> | 'deriving' qtycls { [$2] } -> | 'deriving' '(' ')' { [] } -> | 'deriving' '(' dclasses ')' { reverse $3 } - -> dclasses :: { [HsQName] } -> : dclasses ',' qtycls { $3 : $1 } -> | qtycls { [$1] } - ------------------------------------------------------------------------------ -Class declarations - -> fds :: { [HsFunDep] } -> : {- empty -} { [] } -> | '|' fds1 { reverse $2 } - -> fds1 :: { [HsFunDep] } -> : fds1 ',' fd { $3 : $1 } -> | fd { [$1] } - -> fd :: { HsFunDep } -> : varids0 '->' varids0 { (reverse $1, reverse $3) } - -> varids0 :: { [HsName] } -> : {- empty -} { [] } -> | varids0 tyvar { $2 : $1 } - -> optcbody :: { [HsDecl] } -> : 'where' decllist { $2 } -> | {- empty -} { [] } - -> dbinds :: { [HsDecl] } -> : dbinds ';' dbind { $3 : $1 } -> | dbinds ';' { $1 } -> | dbind { [$1] } -> -> dbind :: { HsDecl } -> dbind : ipvar '=' srcloc exp {% checkValDef ($3, HsVar (UnQual $1), HsUnGuardedRhs $4, []) } - -> binds :: { [HsDecl] } -> : decllist { $1 } -> | '{' dbinds '}' { $2 } -> | layout_on dbinds close { $2 } - - -> wherebinds :: { [HsDecl] } -> : 'where' binds { $2 } -> | {- empty -} { [] } - ------------------------------------------------------------------------------ -Instance declarations - -> optvaldefs :: { [HsDecl] } -> : 'where' '{' valdefs '}' { $3 } -> | 'where' layout_on valdefs close { $3 } -> | {- empty -} { [] } - -> valdefs :: { [HsDecl] } -> : valdefs ';' valdef { $3 : $1 } -> | valdefs ';' { $1 } -> | valdef { [$1] } -> | {- empty -} { [] } - ------------------------------------------------------------------------------ -Value definitions - -> valdef :: { HsDecl } -> : exp0b srcloc rhs -> {% checkValDef ($2, $1, $3, [])} - -> rhs :: { HsRhs } -> : '=' exp wherebinds {% checkExpr $2 `thenP` \e -> -> returnP (HsUnGuardedRhs e) } -> | gdrhs wherebinds { HsGuardedRhss (reverse $1) } - -> gdrhs :: { [HsGuardedRhs] } -> : gdrhs gdrh { $2 : $1 } -> | gdrh { [$1] } - -> gdrh :: { HsGuardedRhs } -> : '|' srcloc quals '=' exp {% checkExpr $5 `thenP` \e -> -> returnP (HsGuardedRhs $2 $3 e) } - ------------------------------------------------------------------------------ -Expressions - -Note: The Report specifies a meta-rule for lambda, let and if expressions -(the exp's that end with a subordinate exp): they extend as far to -the right as possible. That means they cannot be followed by a type -signature or infix application. To implement this without shift/reduce -conflicts, we split exp10 into these expressions (exp10a) and the others -(exp10b). That also means that only an exp0 ending in an exp10b (an exp0b) -can followed by a type signature or infix application. So we duplicate -the exp0 productions to distinguish these from the others (exp0a). - -> exp :: { HsExp } -> : exp0b '::' srcloc ctype { HsExpTypeSig $3 $1 $4 } -> | exp0 { $1 } - -> exp0 :: { HsExp } -> : exp0a { $1 } -> | exp0b { $1 } - -> exp0a :: { HsExp } -> : exp0b qop exp10a { HsInfixApp $1 $2 $3 } -> | exp10a { $1 } - -> exp0b :: { HsExp } -> : exp0b qop exp10b { HsInfixApp $1 $2 $3 } -> | exp10b { $1 } - -> exp10a :: { HsExp } -> : '\\' aexps '->' exp {% checkPatterns (reverse $2) `thenP` \ps -> -> returnP (HsLambda ps $4) } -> | 'let' binds 'in' exp { HsLet $2 $4 } -> | 'if' exp 'then' exp 'else' exp { HsIf $2 $4 $6 } - -> exp10b :: { HsExp } -> : 'case' exp 'of' altslist { HsCase $2 $4 } -> | '-' fexp { HsNegApp $2 } -> | 'do' stmtlist { HsDo $2 } -> | fexp { $1 } - -> fexp :: { HsExp } -> : fexp aexp { HsApp $1 $2 } -> | aexp { $1 } - -> aexps :: { [HsExp] } -> : aexps aexp { $2 : $1 } -> | aexp { [$1] } - -UGLY: Because patterns and expressions are mixed, aexp has to be split into -two rules: One left-recursive and one right-recursive. Otherwise we get two -reduce/reduce-errors (for as-patterns and irrefutable patters). - -Note: The first alternative of aexp is not neccessarily a record update, it -could be a labeled construction, too. - -> aexp :: { HsExp } -> : aexp '{' '}' {% mkRecConstrOrUpdate $1 [] } -> | aexp '{' fbinds '}' {% mkRecConstrOrUpdate $1 (reverse $3) } -> | aexp1 { $1 } - -Even though the variable in an as-pattern cannot be qualified, we use -qvar here to avoid a shift/reduce conflict, and then check it ourselves -(as for vars above). - -Bug: according to the Report, left sections should be (exp0 qop), but -that would cause a shift/reduce conflict in which shifting would be no -different from specifying (exp0b qop). The only consolation is that -other implementations don't manage this either. - -> aexp1 :: { HsExp } -> : ipvar { HsIPVar (UnQual $1) } -> | qvar { HsVar $1 } -> | gcon { HsCon $1 } -> | literal { $1 } -> | '(' exp ')' { HsParen $2 } -> | '(' texps ')' { HsTuple True $2 } -> | '(#' exp '#)' { HsTuple False [$2] } -> | '(#' texps '#)' { HsTuple False $2 } -> | '[' list ']' { $2 } -> | '(' exp0b qop ')' { HsLeftSection $3 $2 } -> | '(' qopm exp0 ')' { HsRightSection $3 $2 } -> | qvar '@' aexp {% checkUnQual $1 `thenP` \n -> -> returnP (HsAsPat n $3) } -> | '_' { HsWildCard } -> | '~' aexp1 { HsIrrPat $2 } - -> commas :: { Int } -> : commas ',' { $1 + 1 } -> | ',' { 1 } - -> texps :: { [HsExp] } -> : exp ',' texps { $1 : $3 } -> | exp ',' exp { [$1,$3] } - ------------------------------------------------------------------------------ -List expressions - -The rules below are little bit contorted to keep lexps left-recursive while -avoiding another shift/reduce-conflict. - -> list :: { HsExp } -> : exp { HsList [$1] } -> | lexps { HsList (reverse $1) } -> | exp '..' { HsEnumFrom $1 } -> | exp ',' exp '..' { HsEnumFromThen $1 $3 } -> | exp '..' exp { HsEnumFromTo $1 $3 } -> | exp ',' exp '..' exp { HsEnumFromThenTo $1 $3 $5 } -> | exp pquals { HsListComp $1 (reverse $2) } - -> lexps :: { [HsExp] } -> : lexps ',' exp { $3 : $1 } -> | exp ',' exp { [$3,$1] } - ------------------------------------------------------------------------------ -List comprehensions - -> pquals :: { [HsStmt] } -> : pquals1 { case $1 of -> [qs] -> qs -> qss -> [HsParStmt (concat qss)] -> } - -> pquals1 :: { [[HsStmt]] } -> : pquals1 '|' quals { $3 : $1 } -> | '|' quals { [$2] } - -> quals :: { [HsStmt] } -> : quals ',' qual { $3 : $1 } -> | qual { [$1] } - -> qual :: { HsStmt } -> : pat '<-' exp { HsGenerator $1 $3 } -> | exp { HsQualifier $1 } -> | 'let' binds { HsLetStmt $2 } - ------------------------------------------------------------------------------ -Case alternatives - -> altslist :: { [HsAlt] } -> : '{' alts optsemi '}' { reverse $2 } -> | layout_on alts optsemi close { reverse $2 } - - -> alts :: { [HsAlt] } -> : alts ';' alt { $3 : $1 } -> | alt { [$1] } - -> alt :: { HsAlt } -> : pat srcloc ralt wherebinds -> { HsAlt $2 $1 $3 $4 } - -> ralt :: { HsGuardedAlts } -> : '->' exp { HsUnGuardedAlt $2 } -> | gdpats { HsGuardedAlts (reverse $1) } - -> gdpats :: { [HsGuardedAlt] } -> : gdpats gdpat { $2 : $1 } -> | gdpat { [$1] } - -> gdpat :: { HsGuardedAlt } -> : '|' srcloc quals '->' exp { HsGuardedAlt $2 $3 $5 } - -> pat :: { HsPat } -> : exp0b {% checkPattern $1 } - ------------------------------------------------------------------------------ -Statement sequences - -> stmtlist :: { [HsStmt] } -> : '{' stmts '}' { $2 } -> | layout_on stmts close { $2 } - -The last Stmt should be a HsQualifier, but that's hard to enforce here, -because we need too much lookahead if we see do { e ; }, so it has to -be checked for later. - -> stmts :: { [HsStmt] } -> : qual stmts1 { $1 : $2 } -> | ';' stmts { $2 } -> | {- empty -} { [] } - -> stmts1 :: { [HsStmt] } -> : ';' stmts { $2 } -> | {- empty -} { [] } - ------------------------------------------------------------------------------ -Record Field Update/Construction - -> fbinds :: { [HsFieldUpdate] } -> : fbinds ',' fbind { $3 : $1 } -> | fbind { [$1] } - -> fbind :: { HsFieldUpdate } -> : qvar '=' exp { HsFieldUpdate $1 $3 } - ------------------------------------------------------------------------------ -Variables, Constructors and Operators. - -> gcon :: { HsQName } -> : '(' ')' { unit_con_name } -> | '[' ']' { nil_con_name } -> | '(' commas ')' { tuple_con_name $2 } -> | qcon { $1 } - -> var :: { HsName } -> : varid { $1 } -> | '(' varsym ')' { $2 } - -> qvar :: { HsQName } -> : qvarid { $1 } -> | '(' qvarsym ')' { $2 } - -> con :: { HsName } -> : conid { $1 } -> | '(' consym ')' { $2 } - -> ipvar :: { HsName } -> : IPVARID { HsVarName (HsIdent $1) } - -> qcon :: { HsQName } -> : qconid { $1 } -> | '(' qconsym ')' { $2 } - -> varop :: { HsName } -> : varsym { $1 } -> | '`' varid '`' { $2 } - -> qvarop :: { HsQName } -> : qvarsym { $1 } -> | '`' qvarid '`' { $2 } - -> qvaropm :: { HsQName } -> : qvarsymm { $1 } -> | '`' qvarid '`' { $2 } - -> conop :: { HsName } -> : consym { $1 } -> | '`' conid '`' { $2 } - -> qconop :: { HsQName } -> : qconsym { $1 } -> | '`' qconid '`' { $2 } - -> op :: { HsName } -> : varop { $1 } -> | conop { $1 } - -> qop :: { HsExp } -> : qvarop { HsVar $1 } -> | qconop { HsCon $1 } - -> qopm :: { HsExp } -> : qvaropm { HsVar $1 } -> | qconop { HsCon $1 } - -> qvarid :: { HsQName } -> : varid { UnQual $1 } -> | QVARID { Qual (Module (fst $1)) (HsVarName (HsIdent (snd $1))) } - -> varid :: { HsName } -> : 'forall' { forall_name } -> | varid_no_forall { $1 } - -> varid_no_forall :: { HsName } -> : VARID { HsVarName (HsIdent $1) } -> | 'as' { as_name } -> | 'unsafe' { unsafe_name } -> | 'safe' { safe_name } -> | 'threadsafe' { threadsafe_name } -> | 'qualified' { qualified_name } -> | 'hiding' { hiding_name } -> | 'export' { export_name } -> | 'stdcall' { stdcall_name } -> | 'ccall' { ccall_name } -> | 'dotnet' { dotnet_name } - -> qconid :: { HsQName } -> : conid { UnQual $1 } -> | QCONID { Qual (Module (fst $1)) (HsVarName (HsIdent (snd $1))) } - -> conid :: { HsName } -> : CONID { HsVarName (HsIdent $1) } - -> qconsym :: { HsQName } -> : consym { UnQual $1 } -> | QCONSYM { Qual (Module (fst $1)) (HsVarName (HsSymbol (snd $1))) } - -> consym :: { HsName } -> : CONSYM { HsVarName (HsSymbol $1) } - -> qvarsym :: { HsQName } -> : varsym { UnQual $1 } -> | qvarsym1 { $1 } - -> qvarsymm :: { HsQName } -> : varsymm { UnQual $1 } -> | qvarsym1 { $1 } - -> varsym :: { HsName } -> : VARSYM { HsVarName (HsSymbol $1) } -> | '.' { dot_name } -> | '-' { minus_name } -> | '!' { pling_name } - -> varsymm :: { HsName } -- varsym not including '-' -> : VARSYM { HsVarName (HsSymbol $1) } -> | '.' { dot_name } -> | '!' { pling_name } - -> qvarsym1 :: { HsQName } -> : QVARSYM { Qual (Module (fst $1)) (HsVarName (HsSymbol (snd $1))) } - -> literal :: { HsExp } -> : INT { HsLit (HsInt $1) } -> | CHAR { HsLit (HsChar $1) } -> | RATIONAL { HsLit (HsFrac (readRational $1)) } -> | STRING { HsLit (HsString $1) } -> | PRIMINT { HsLit (HsIntPrim $1) } -> | PRIMCHAR { HsLit (HsCharPrim $1) } -> | PRIMFLOAT { HsLit (HsFloatPrim (readRational $1)) } -> | PRIMDOUBLE { HsLit (HsDoublePrim (readRational $1)) } -> | PRIMSTRING { HsLit (HsStringPrim $1) } - -> srcloc :: { SrcLoc } : {% getSrcLoc } - ------------------------------------------------------------------------------ -Layout - -> close :: { () } -> : vccurly { () } -- context popped in lexer. -> | error {% popContext } - -> layout_on :: { () } : {% getSrcLoc `thenP` \(SrcLoc r c f) -> -> pushContext (Layout c) } - ------------------------------------------------------------------------------ -Miscellaneous (mostly renamings) - -> modid :: { Module } -> : CONID { Module $1 } -> | QCONID { Module (fst $1 ++ '.':snd $1) } - -> tyconorcls :: { HsName } -> : CONID { HsTyClsName (HsIdent $1) } - -> tycon :: { HsName } -> : CONID { HsTyClsName (HsIdent $1) } - -> qtycls :: { HsQName } -> : CONID { UnQual (HsTyClsName (HsIdent $1)) } -> | QCONID { Qual (Module (fst $1)) (HsTyClsName (HsIdent (snd $1))) } - -> tyvar :: { HsName } -> : varid_no_forall { $1 } - ------------------------------------------------------------------------------ -Documentation comments - -> docnext :: { Doc } -> : DOCNEXT {% case parseParas (tokenise $1) of { -> Left err -> parseError err; -> Right doc -> returnP doc } } - -> docprev :: { Doc } -> : DOCPREV {% case parseParas (tokenise $1) of { -> Left err -> parseError err; -> Right doc -> returnP doc } } - -> docnamed :: { (String,Doc) } -> : DOCNAMED {% let (name,rest) = break isSpace $1 in -> case parseParas (tokenise rest) of { -> Left err -> parseError err; -> Right doc -> returnP (name,doc) } } - -> docsection :: { (Int,Doc) } -> : DOCSECTION {% case $1 of { DocSection n s -> -> case parseString (tokenise s) of { -> Left err -> parseError err; -> Right doc -> returnP (n, doc) } } } - -> maybe_docprev :: { Maybe Doc } -> : docprev { Just $1 } -> | {- empty -} { Nothing } - -> maybe_docnext :: { Maybe Doc } -> : docnext { Just $1 } -> | {- empty -} { Nothing } - -> moduleheader :: { (ModuleInfo,Maybe Doc) } -> : DOCNEXT {% case parseModuleHeader $1 of { -> Right (str,info) -> -> case parseParas (tokenise str) of { -> Left err -> parseError err; -> Right doc -> returnP (info,Just doc); -> }; -> Left err -> parseError err -> } } - ------------------------------------------------------------------------------ - -> { -> happyError = parseError "Parse error" -> } |