/* -------------------------------------------------------------------------- * Hugs parser (included as part of input.c) * * Expect 16 shift/reduce conflicts when passing this grammar through yacc, * but don't worry; they should all be resolved in an appropriate manner. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved. It is distributed as free software under * the license in the file "License", which is included in the distribution. * * $RCSfile: parser.y,v $ * $Revision: 1.50 $ * $Date: 2006/08/30 18:57:13 $ * ------------------------------------------------------------------------*/ %{ %} %token EXPR CTXT SCRIPT %token CASEXP OF DATA TYPE IF_T %token THEN ELSE_T WHERE LET IN %token INFIXN INFIXL INFIXR PRIMITIVE TNEWTYPE %token DEFAULT_T DERIVING DO_T TCLASS TINSTANCE /*#if MUDO*/ %token MDO /*#endif*/ %token REPEAT ALL NUMLIT CHARLIT STRINGLIT %token VAROP VARID CONOP CONID %token QVAROP QVARID QCONOP QCONID /*#if TREX*/ %token RECSELID IPVARID /*#endif*/ %token COCO '=' UPTO '@' '\\' %token '|' '-' FROM ARROW '~' %token '!' IMPLIES '(' ',' ')' %token '[' ';' ']' '`' '.' %token TMODULE IMPORT HIDING QUALIFIED ASMOD %token NEEDPRIMS %token FOREIGN %% /*- Top level script/module structure -------------------------------------*/ /* start : EXPR exp lwherePart | CTXT context | SCRIPT topModule | error ; */ start : topModule | modBody ; /*- Haskell module header/import parsing: ----------------------------------- * Syntax for Haskell modules (module headers and imports) is parsed but * most of it is ignored. However, module names in import declarations * are used, of course, if import chasing is turned on. *-------------------------------------------------------------------------*/ /* In Haskell 1.2, the default module header was "module Main where" * In 1.3, this changed to "module Main(main) where". * We use the 1.2 header because it breaks much less pre-module code. */ topModule : startMain begin modBody end | startMain '{' modBody '}' | TMODULE modname expspec WHERE '{' modBody end | TMODULE modname expspec WHERE error | TMODULE error ; /* To implement the Haskell module system, we have to keep track of the * current module. We rely on the use of LALR parsing to ensure that this * side effect happens before any declarations within the module. */ startMain : /* empty */ ; modname : qconid ; modid : qconid | STRINGLIT ; modBody : /* empty */ | ';' modBody | topDecls | impDecls chase | impDecls ';' chase topDecls ; /*- Exports: --------------------------------------------------------------*/ expspec : /* empty */ | '(' ')' | '(' ',' ')' | '(' exports ')' | '(' exports ',' ')' ; exports : exports ',' export | export ; /* The qcon should be qconid. * Relaxing the rule lets us explicitly export (:) from the Prelude. */ export : qvar | qcon | qconid '(' UPTO ')' | qconid '(' qnames ')' | TMODULE modid ; qnames : /* empty */ | ',' | qnames1 | qnames1 ',' ; qnames1 : qnames1 ',' qname | qname ; qname : qvar | qcon ; /*- Import declarations: --------------------------------------------------*/ impDecls : impDecls ';' impDecl | impDecls ';' | impDecl ; chase : /* empty */ ; /* Note that qualified import ignores the import list. */ impDecl : IMPORT modid impspec | IMPORT modid ASMOD modid impspec | IMPORT QUALIFIED modid ASMOD modid impspec | IMPORT QUALIFIED modid impspec | IMPORT error ; impspec : /* empty */ | HIDING '(' imports ')' | '(' imports ')' ; imports : /* empty */ | ',' | imports1 | imports1 ',' ; imports1 : imports1 ',' import | import ; import : var | CONID | CONID '(' UPTO ')' | CONID '(' names ')' ; names : /* empty */ | ',' | names1 | names1 ',' ; names1 : names1 ',' name | name ; name : var | con ; /*- Top-level declarations: -----------------------------------------------*/ topDecls : topDecls ';' | topDecls ';' topDecl | topDecls ';' decl | topDecl | decl ; /*- Type declarations: ----------------------------------------------------*/ topDecl : TYPE tyLhs '=' type | TYPE tyLhs '=' type IN invars | TYPE error | DATA btype2 '=' constrs deriving | DATA context IMPLIES tyLhs '=' constrs deriving | DATA btype2 | DATA context IMPLIES tyLhs | DATA error | TNEWTYPE btype2 '=' nconstr deriving | TNEWTYPE context IMPLIES tyLhs '=' nconstr deriving | TNEWTYPE error | NEEDPRIMS NUMLIT | NEEDPRIMS error ; tyLhs : tyLhs varid | CONID | error ; invars : invars ',' invar | invar ; invar : var COCO topType | var ; constrs : constrs '|' pconstr | pconstr ; pconstr : ALL varids '.' qconstr | constr ; qconstr : context IMPLIES constr | constr ; constr : '!' btype conop bbtype | btype1 conop bbtype | btype2 conop bbtype | bpolyType conop bbtype | btype2 | btype3 | con '{' fieldspecs '}' | con '{' '}' | error ; btype3 : btype2 '!' atype | btype2 bpolyType | btype3 atype | btype3 '!' atype | btype3 bpolyType | '(' CONOP ')' ; bbtype : '!' btype | btype | bpolyType ; nconstr : pconstr ; fieldspecs: fieldspecs ',' fieldspec | fieldspec ; fieldspec : vars COCO polyType | vars COCO type | vars COCO '!' type ; deriving : /* empty */ | DERIVING qconid | DERIVING '(' derivs0 ')' ; derivs0 : /* empty */ | derivs ; derivs : derivs ',' qconid | qconid ; /*- Processing definitions of primitives ----------------------------------*/ topDecl : PRIMITIVE prims COCO topType ; prims : prims ',' prim | prim | error ; prim : var STRINGLIT | var ; /*- Foreign Function Interface --------------------------------------------*/ topDecl : FOREIGN IMPORT var STRINGLIT var COCO topType | FOREIGN IMPORT var var COCO topType | FOREIGN IMPORT var var STRINGLIT var COCO topType | FOREIGN IMPORT var var var COCO topType | FOREIGN var var STRINGLIT var COCO topType ; /*- Class declarations: ---------------------------------------------------*/ topDecl : TCLASS crule fds wherePart | TINSTANCE irule wherePart | DEFAULT_T '(' dtypes ')' | TCLASS error | TINSTANCE error | DEFAULT_T error ; crule : context IMPLIES btype2 | btype2 ; irule : context IMPLIES btype2 | btype2 ; dtypes : /* empty */ | dtypes1 ; dtypes1 : dtypes1 ',' type | type ; fds : /* empty */ | '|' fds1 ; fds1 : fds1 ',' fd | fd ; fd : varids0 ARROW varids0 | error ; varids0 : /* empty */ | varids0 varid ; /*- Type expressions: -----------------------------------------------------*/ topType : ALL varids '.' topType0 | topType0 ; topType0 : context IMPLIES topType1 | topType1 ; topType1 : bpolyType ARROW topType1 | btype1 ARROW topType1 | btype2 ARROW topType1 | btype ; polyType : ALL varids '.' sigType | bpolyType ; bpolyType : '(' polyType ')' | '(' lcontext IMPLIES type ')' ; varids : varids varid | varid ; sigType : context IMPLIES type | type ; context : '(' ')' | btype2 | '(' btype2 ')' | '(' btypes2 ')' | lacks | '(' lacks1 ')' ; lcontext : lacks | '(' lacks1 ')' ; lacks : varid '\\' varid | IPVARID COCO type ; lacks1 : btypes2 ',' lacks | lacks1 ',' btype2 | lacks1 ',' lacks | btype2 ',' lacks | lacks ; type : type1 | btype2 ; type1 : btype1 | bpolyType ARROW type | btype1 ARROW type | btype2 ARROW type | error ; btype : btype1 | btype2 ; btype1 : btype1 atype | atype1 ; btype2 : btype2 atype | qconid ; atype : atype1 | qconid ; atype1 : varid | '(' ')' | '(' ARROW ')' | '(' type1 ')' | '(' btype2 ')' | '(' tupCommas ')' | '(' btypes2 ')' | '(' typeTuple ')' | '(' tfields ')' | '(' tfields '|' type ')' | '[' type ']' | '[' ']' | '_' ; btypes2 : btypes2 ',' btype2 | btype2 ',' btype2 ; typeTuple : type1 ',' type | btype2 ',' type1 | btypes2 ',' type1 | typeTuple ',' type ; /*#if TREX*/ tfields : tfields ',' tfield | tfield ; tfield : varid COCO type ; /*#endif*/ /*- Value declarations: ---------------------------------------------------*/ gendecl : INFIXN optDigit ops | INFIXN error | INFIXL optDigit ops | INFIXL error | INFIXR optDigit ops | INFIXR error | vars COCO topType | vars COCO error ; optDigit : NUMLIT | /* empty */ ; ops : ops ',' op | op ; vars : vars ',' var | var ; decls : '{' decls0 end | '{' decls1 end ; decls0 : /* empty */ | decls0 ';' | decls1 ';' ; decls1 : decls0 decl ; decl : gendecl | funlhs rhs | funlhs COCO type rhs | pat0 rhs ; funlhs : funlhs0 | funlhs1 | npk ; funlhs0 : pat10_vI varop pat0 | infixPat varop pat0 | NUMLIT varop pat0 | var varop_pl pat0 | var '+' pat0_INT ; funlhs1 : '(' funlhs0 ')' apat | '(' funlhs1 ')' apat | '(' npk ')' apat | var apat | funlhs1 apat ; rhs : rhs1 wherePart | error ; rhs1 : '=' exp | gdrhs ; gdrhs : gdrhs gddef | gddef ; gddef : '|' exp0 '=' exp ; wherePart : /* empty */ | WHERE decls ; /* lwherePart and ldecls permit the binding of both 'normal' * and implicit parameter bindings. */ lwherePart : /* empty */ | WHERE ldecls ; ldecls : '{' ldecls0 end | '{' ldecls1 end ; ldecls0 : /* empty */ | ldecls0 ';' | ldecls1 ';' ; ldecls1 : ldecls0 ldecl ; ldecl : IPVARID '=' exp | IPVARID error | decl ; /*- Patterns: -------------------------------------------------------------*/ pat : npk | pat_npk ; pat_npk : pat0 COCO type | pat0 ; npk : var '+' NUMLIT ; pat0 : var | NUMLIT | pat0_vI ; pat0_INT : var | pat0_vI ; pat0_vI : pat10_vI | infixPat ; infixPat : '-' pat10 | '-' error | var qconop pat10 | var qconop '-' pat10 | NUMLIT qconop pat10 | NUMLIT qconop '-' pat10 | pat10_vI qconop pat10 | pat10_vI qconop '-' pat10 | infixPat qconop pat10 | infixPat qconop '-' pat10 ; pat10 : fpat | apat ; pat10_vI : fpat | apat_vI ; fpat : fpat apat | gcon apat ; apat : NUMLIT | var | apat_vI ; apat_vI : var '@' apat | gcon | qcon '{' patbinds '}' | CHARLIT | STRINGLIT | '_' | '(' pat_npk ')' | '(' npk ')' | '(' pats2 ')' | '[' pats1 ']' | '~' apat /*#if TREX*/ | '(' patfields ')' | '(' patfields '|' pat ')' /*#endif TREX*/ ; pats2 : pats2 ',' pat | pat ',' pat ; pats1 : pats1 ',' pat | pat ; patbinds : /* empty */ | patbinds1 ; patbinds1 : patbinds1 ',' patbind | patbind ; patbind : qvar '=' pat | var ; /*#if TREX*/ patfields : patfields ',' patfield | patfield ; patfield : varid '=' pat ; /*#endif TREX*/ /*- Expressions: ----------------------------------------------------------*/ exp : exp_err | error ; exp_err : exp0a COCO sigType | exp0 ; exp0 : exp0a | exp0b ; exp0a : infixExpa | exp10a ; exp0b : infixExpb | exp10b ; infixExpa : infixExpa qop '-' exp10a | infixExpa qop exp10a | '-' exp10a | exp10a qop '-' exp10a | exp10a qop exp10a ; infixExpb : infixExpa qop '-' exp10b | infixExpa qop exp10b | '-' exp10b | exp10a qop '-' exp10b | exp10a qop exp10b ; exp10a : CASEXP exp OF '{' alts end | DO_T '{' stmts end | MDO '{' stmts end | appExp ; exp10b : '\\' pats ARROW exp | LET ldecls IN exp | IF_T exp then_exp else_exp ; /* Allow optional semicolons before 'then' and 'else' (as suggested by John Meacham), to remove a common pitfall when using if-then-else inside do expressions with implicit layout. */ then_exp : ';' THEN exp | THEN exp ; else_exp : ';' ELSE_T exp | ELSE_T exp ; pats : pats apat | apat ; appExp : appExp aexp | aexp ; aexp : qvar | qvar '@' aexp | '~' aexp | IPVARID | '_' | gcon | qcon '{' fbinds '}' | aexp '{' fbinds '}' | NUMLIT | CHARLIT | STRINGLIT | REPEAT | '(' exp ')' | '(' exps2 ')' /*#if TREX*/ | '(' vfields ')' | '(' vfields '|' exp ')' | RECSELID /*#endif*/ | '[' list ']' | '(' exp10a qop ')' | '(' qvarop_mi exp0 ')' | '(' qconop exp0 ')' ; exps2 : exps2 ',' exp | exp ',' exp ; /*#if TREX*/ vfields : vfields ',' vfield | vfield ; vfield : varid '=' exp ; /*#endif*/ alts : alts1 | ';' alts ; alts1 : alts1 ';' alt | alts1 ';' | alt ; alt : pat altRhs wherePart ; altRhs : guardAlts | ARROW exp | error ; guardAlts : guardAlts guardAlt | guardAlt ; guardAlt : '|' exp0 ARROW exp ; stmts : stmts1 | ';' stmts ; stmts1 : stmts1 ';' stmt | stmts1 ';' | stmt ; stmt : exp_err FROM exp | LET ldecls /* | IF_T exp */ | exp_err ; fbinds : /* empty */ | fbinds1 ; fbinds1 : fbinds1 ',' fbind | fbind ; fbind : var | qvar '=' exp ; /*- List Expressions: -------------------------------------------------------*/ list : exp | exps2 | exp zipquals | exp UPTO exp | exp ',' exp UPTO | exp UPTO | exp ',' exp UPTO exp ; zipquals : zipquals '|' quals | '|' quals ; quals : quals ',' qual | qual ; qual : exp FROM exp | exp | LET ldecls ; /*- Identifiers and symbols: ----------------------------------------------*/ gcon : qcon | '(' ')' | '[' ']' | '(' tupCommas ')' ; tupCommas : tupCommas ',' | ',' ; varid : VARID | HIDING | QUALIFIED | ASMOD ; qconid : QCONID | CONID ; var : varid | '(' VAROP ')' | '(' '+' ')' | '(' '-' ')' | '(' '!' ')' | '(' '.' ')' ; qvar : QVARID | '(' QVAROP ')' | var ; con : CONID | '(' CONOP ')' ; qcon : QCONID | '(' QCONOP ')' | con ; varop : '+' | '-' | varop_mipl ; varop_mi : '+' | varop_mipl ; varop_pl : '-' | varop_mipl ; varop_mipl: VAROP | '`' varid '`' | '!' | '.' ; qvarop : '-' | qvarop_mi ; qvarop_mi : QVAROP | '`' QVARID '`' | varop_mi ; conop : CONOP | '`' CONID '`' ; qconop : QCONOP | '`' QCONID '`' | conop ; op : varop | conop ; qop : qvarop | qconop ; /*- Tricks to force insertion of leading and closing braces ---------------*/ begin : /* empty */ ; /* deal with trailing semicolon */ end : '}' | error ; /*-------------------------------------------------------------------------*/ %%