X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2Fhsparser.y;h=58db2df53fa576d32c45dd49888895b3e13e80c7;hb=9c26739695219d8343505a88457cb55c76b65449;hp=5e9018bc5e26f5bb87b2408dcd7867faa8e2fde1;hpb=b4255f2c320f852d7dfb0afc0bc9f64765aece0c;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/hsparser.y b/ghc/compiler/parser/hsparser.y index 5e9018b..58db2df 100644 --- a/ghc/compiler/parser/hsparser.y +++ b/ghc/compiler/parser/hsparser.y @@ -47,6 +47,7 @@ static char *the_module_name; static maybe module_exports; extern list Lnil; +extern list reverse_list(); extern tree root; /* For FN, PREVPATT and SAMEFN macros */ @@ -124,9 +125,9 @@ BOOLEAN inpat; * * **********************************************************************/ -%token OCURLY CCURLY VCCURLY SEMI -%token OBRACK CBRACK OPAREN CPAREN -%token COMMA BQUOTE +%token OCURLY CCURLY VCCURLY +%token COMMA SEMI OBRACK CBRACK +%token WILDCARD BQUOTE OPAREN CPAREN /********************************************************************** @@ -137,9 +138,9 @@ BOOLEAN inpat; * * **********************************************************************/ -%token DOTDOT DCOLON EQUAL -%token LAMBDA VBAR RARROW -%token LARROW MINUS +%token DOTDOT DCOLON EQUAL LAMBDA +%token VBAR RARROW LARROW +%token AT LAZY DARROW /********************************************************************** @@ -165,12 +166,12 @@ BOOLEAN inpat; /********************************************************************** * * * * -* Valid symbols/identifiers which need to be recognised * +* Special symbols/identifiers which need to be recognised * * * * * **********************************************************************/ -%token WILDCARD AT LAZY BANG +%token MINUS BANG PLUS %token AS HIDING QUALIFIED @@ -184,7 +185,8 @@ BOOLEAN inpat; %token INTERFACE_UPRAGMA SPECIALISE_UPRAGMA %token INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA -%token DEFOREST_UPRAGMA END_UPRAGMA +%token DEFOREST_UPRAGMA END_UPRAGMA +%token SOURCE_UPRAGMA /********************************************************************** * * @@ -200,7 +202,7 @@ BOOLEAN inpat; SCC CASM CCALL CASM_GC CCALL_GC %left VARSYM CONSYM QVARSYM QCONSYM - MINUS BQUOTE BANG DARROW + MINUS BQUOTE BANG DARROW PLUS %left DCOLON @@ -223,44 +225,42 @@ BOOLEAN inpat; %type caserest alts alt quals dorest stmts stmt - rbinds rpats list_exps + rbinds rbinds1 rpats rpats1 list_exps list_rest qvarsk qvars_list constrs constr1 fields types atypes batypes types_and_maybe_ids - pats context context_list tyvar_list + pats context context_list /* tyvar_list */ export_list enames import_list inames impdecls maybeimpdecls impdecl maybefixes fixes fix ops dtyclses dtycls_list gdrhs gdpat valrhs - lampats cexps + lampats cexps gd -%type maybeexports impas maybeimpspec deriving - -%type impspec +%type maybeexports impspec deriving %type lit_constant %type exp oexp dexp kexp fexp aexp rbind texps expL oexpL kexpL expLno oexpLno dexpLno kexpLno - vallhs funlhs qual gd leftexp - pat bpat apat apatc conpat rpat - patk bpatk apatck conpatk + vallhs funlhs qual leftexp + pat cpat bpat apat apatc conpat rpat + patk bpatk apatck conpatk -%type MINUS DARROW AS LAZY +%type MINUS PLUS DARROW AS LAZY VARID CONID VARSYM CONSYM var con varop conop op vark varid varsym varsym_nominus - tycon modid impmod ccallid + tycon modid ccallid %type QVARID QCONID QVARSYM QCONSYM qvarid qconid qvarsym qconsym qvar qcon qvarop qconop qop qvark qconk qtycon qtycls - gcon gconk gtycon qop1 qvarop1 + gcon gconk gtycon itycon qop1 qvarop1 ename iname %type topdecl topdecls letdecls @@ -270,12 +270,12 @@ BOOLEAN inpat; %type valrhs1 altrest -%type simple ctype type atype btype - gtyconapp ntyconapp ntycon gtyconvars - bbtype batype btyconapp - class restrict_inst general_inst tyvar +%type simple ctype sigtype sigarrowtype type atype bigatype btype + gtyconvars + bbtype batype bxtype wierd_atype + class tyvar contype -%type constr field +%type constr constr_after_context field %type FLOAT INTEGER INTPRIM FLOATPRIM DOUBLEPRIM CLITLIT @@ -284,7 +284,7 @@ BOOLEAN inpat; %type export import -%type commas impqual +%type commas importkey /********************************************************************** * * @@ -380,32 +380,20 @@ impdecls: impdecl { $$ = $1; } ; -impdecl : importkey impqual impmod impas maybeimpspec - { - $$ = lsing(mkimport($3,$2,$4,$5,startlineno)); - } - ; - -impmod : modid { $$ = $1; } - ; - -impqual : /* noqual */ { $$ = 0; } - | QUALIFIED { $$ = 1; } - ; - -impas : /* noas */ { $$ = mknothing(); } - | AS modid { $$ = mkjust($2); } - ; - -maybeimpspec : /* empty */ { $$ = mknothing(); } - | impspec { $$ = mkjust($1); } +impdecl : importkey modid impspec + { $$ = lsing(mkimport($2,0,mknothing(),$3,$1,startlineno)); } + | importkey QUALIFIED modid impspec + { $$ = lsing(mkimport($3,1,mknothing(),$4,$1,startlineno)); } + | importkey QUALIFIED modid AS modid impspec + { $$ = lsing(mkimport($3,1,mkjust($5),$6,$1,startlineno)); } ; -impspec : OPAREN CPAREN { $$ = mkleft(Lnil); } - | OPAREN import_list CPAREN { $$ = mkleft($2); } - | OPAREN import_list COMMA CPAREN { $$ = mkleft($2); } - | HIDING OPAREN import_list CPAREN { $$ = mkright($3); } - | HIDING OPAREN import_list COMMA CPAREN { $$ = mkright($3); } +impspec : /* empty */ { $$ = mknothing(); } + | OPAREN CPAREN { $$ = mkjust(mkleft(Lnil)); } + | OPAREN import_list CPAREN { $$ = mkjust(mkleft($2)); } + | OPAREN import_list COMMA CPAREN { $$ = mkjust(mkleft($2)); } + | HIDING OPAREN import_list CPAREN { $$ = mkjust(mkright($3)); } + | HIDING OPAREN import_list COMMA CPAREN { $$ = mkjust(mkright($3)); } ; import_list: @@ -414,10 +402,16 @@ import_list: ; import : var { $$ = mkentid(mknoqual($1)); } - | tycon { $$ = mkenttype(mknoqual($1)); } - | tycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall(mknoqual($1)); } - | tycon OPAREN CPAREN { $$ = mkenttypenamed(mknoqual($1),Lnil); } - | tycon OPAREN inames CPAREN { $$ = mkenttypenamed(mknoqual($1),$3); } + | itycon { $$ = mkenttype($1); } + | itycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); } + | itycon OPAREN CPAREN { $$ = mkenttypenamed($1,Lnil);} + | itycon OPAREN inames CPAREN { $$ = mkenttypenamed($1,$3); } + ; + +itycon : tycon { $$ = mknoqual($1); } + | OBRACK CBRACK { $$ = creategid(-1); } + | OPAREN CPAREN { $$ = creategid(0); } + | OPAREN commas CPAREN { $$ = creategid($2); } ; inames : iname { $$ = lsing($1); } @@ -481,12 +475,12 @@ topdecls: topdecl } ; -topdecl : typed { $$ = $1; } - | datad { $$ = $1; } - | newtd { $$ = $1; } - | classd { $$ = $1; } - | instd { $$ = $1; } - | defaultd { $$ = $1; } +topdecl : typed { $$ = $1; FN = NULL; SAMEFN = 0; } + | datad { $$ = $1; FN = NULL; SAMEFN = 0; } + | newtd { $$ = $1; FN = NULL; SAMEFN = 0; } + | classd { $$ = $1; FN = NULL; SAMEFN = 0; } + | instd { $$ = $1; FN = NULL; SAMEFN = 0; } + | defaultd { $$ = $1; FN = NULL; SAMEFN = 0; } | decl { $$ = $1; } ; @@ -521,9 +515,9 @@ cbody : /* empty */ { $$ = mknullbind(); } | WHERE vocurly decls vccurly { checkorder($3); $$ = $3; } ; -instd : instkey context DARROW gtycon restrict_inst rinst +instd : instkey context DARROW gtycon atype rinst { $$ = mkibind($2,$4,$5,$6,startlineno); } - | instkey gtycon general_inst rinst + | instkey gtycon atype rinst { $$ = mkibind(Lnil,$2,$3,$4,startlineno); } ; @@ -532,6 +526,13 @@ rinst : /* empty */ { $$ = mknullbind(); } | WHERE vocurly instdefs vccurly { $$ = $3; } ; +/* I now allow a general type in instance declarations, relying + on the type checker to reject instance decls which are ill-formed. + Some (non-standard) extensions of Haskell may allow more general + types than the Report syntax permits, and in any case not all things + can be checked in the syntax (eg repeated type variables). + SLPJ Jan 97 + restrict_inst : gtycon { $$ = mktname($1); } | OPAREN gtyconvars CPAREN { $$ = $2; } | OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); } @@ -540,11 +541,12 @@ restrict_inst : gtycon { $$ = mktname($1); } ; general_inst : gtycon { $$ = mktname($1); } - | OPAREN gtyconapp CPAREN { $$ = $2; } + | OPAREN gtyconapp1 CPAREN { $$ = $2; } | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); } | OBRACK type CBRACK { $$ = mktllist($2); } | OPAREN btype RARROW type CPAREN { $$ = mktfun($2,$4); } ; +*/ defaultd: defaultkey OPAREN types CPAREN { $$ = mkdbind($3,startlineno); } | defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); } @@ -569,7 +571,7 @@ decls : decl to real mischief (ugly, but likely to work). */ -decl : qvarsk DCOLON ctype +decl : qvarsk DCOLON sigtype { $$ = mksbind($1,$3,startlineno); PREVPATT = NULL; FN = NULL; SAMEFN = 0; } @@ -587,7 +589,7 @@ decl : qvarsk DCOLON ctype PREVPATT = NULL; FN = NULL; SAMEFN = 0; } - | SPECIALISE_UPRAGMA INSTANCE gtycon general_inst END_UPRAGMA + | SPECIALISE_UPRAGMA INSTANCE gtycon atype END_UPRAGMA { $$ = mkispec_uprag($3, $4, startlineno); PREVPATT = NULL; FN = NULL; SAMEFN = 0; @@ -661,35 +663,38 @@ type_and_maybe_id : context. Blaach! */ - /* 1 S/R conflict at DARROW -> shift */ -ctype : type DARROW type { $$ = mkcontext(type2context($1),$3); } - | type +/* A sigtype is a rank 2 type; it can have for-alls as function args: + f :: All a => (All b => ...) -> Int +*/ +sigtype : type DARROW sigarrowtype { $$ = mkcontext(type2context($1),$3); } + | sigarrowtype ; - /* 1 S/R conflict at RARROW -> shift */ -type : btype { $$ = $1; } - | btype RARROW type { $$ = mktfun($1,$3); } - ; +sigarrowtype : bigatype RARROW sigarrowtype { $$ = mktfun($1,$3); } + | btype RARROW sigarrowtype { $$ = mktfun($1,$3); } + | btype + ; -/* btype is split so we can parse gtyconapp without S/R conflicts */ -btype : gtyconapp { $$ = $1; } - | ntyconapp { $$ = $1; } +/* A "big" atype can be a forall-type in brackets. */ +bigatype: OPAREN type DARROW type CPAREN { $$ = mkcontext(type2context($2),$4); } ; -ntyconapp: ntycon { $$ = $1; } - | ntyconapp atype { $$ = mktapp($1,$2); } + /* 1 S/R conflict at DARROW -> shift */ +ctype : type DARROW type { $$ = mkcontext(type2context($1),$3); } + | type ; -gtyconapp: gtycon { $$ = mktname($1); } - | gtyconapp atype { $$ = mktapp($1,$2); } + /* 1 S/R conflict at RARROW -> shift */ +type : btype RARROW type { $$ = mktfun($1,$3); } + | btype { $$ = $1; } ; - -atype : gtycon { $$ = mktname($1); } - | ntycon { $$ = $1; } +btype : btype atype { $$ = mktapp($1,$2); } + | atype { $$ = $1; } ; -ntycon : tyvar { $$ = $1; } +atype : gtycon { $$ = mktname($1); } + | tyvar { $$ = $1; } | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); } | OBRACK type CBRACK { $$ = mktllist($2); } | OPAREN type CPAREN { $$ = $2; } @@ -745,33 +750,70 @@ constrs : constr { $$ = lsing($1); } | constrs VBAR constr { $$ = lapp($1,$3); } ; -constr : btyconapp { qid tyc; list tys; +constr : constr_after_context + | type DARROW constr_after_context { $$ = mkconstrcxt ( type2context($1), $3 ); } + ; + +constr_after_context : + + /* We have to parse the constructor application as a *type*, else we get + into terrible ambiguity problems. Consider the difference between + + data T = S Int Int Int `R` Int + and + data T = S Int Int Int + + It isn't till we get to the operator that we discover that the "S" is + part of a type in the first, but part of a constructor application in the + second. + */ + +/* Con !Int (Tree a) */ + contype { qid tyc; list tys; splittyconapp($1, &tyc, &tys); $$ = mkconstrpre(tyc,tys,hsplineno); } - | OPAREN qconsym CPAREN { $$ = mkconstrpre($2,Lnil,hsplineno); } + +/* !Int `Con` Tree a */ + | bbtype qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); } + +/* (::) (Tree a) Int */ | OPAREN qconsym CPAREN batypes { $$ = mkconstrpre($2,$4,hsplineno); } - | btyconapp qconop bbtype { checknobangs($1); - $$ = mkconstrinf($1,$2,$3,hsplineno); } - | ntyconapp qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); } - | BANG atype qconop bbtype { $$ = mkconstrinf(mktbang($2),$3,$4,hsplineno); } - /* 1 S/R conflict on OCURLY -> shift */ +/* Con { op1 :: Int } */ | gtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); } + /* 1 S/R conflict on OCURLY -> shift */ + ; + + +/* contype has to reduce to a btype unless there are !'s, so that + we don't get reduce/reduce conflicts with the second production of constr. + But as soon as we see a ! we must switch to using bxtype. */ + +contype : btype { $$ = $1 } + | bxtype { $$ = $1 } ; -btyconapp: gtycon { $$ = mktname($1); } - | btyconapp batype { $$ = mktapp($1,$2); } +/* S !Int Bool; at least one ! */ +bxtype : btype wierd_atype { $$ = mktapp($1, $2); } + | bxtype batype { $$ = mktapp($1, $2); } ; bbtype : btype { $$ = $1; } - | BANG atype { $$ = mktbang($2); } + | wierd_atype { $$ = $1; } ; batype : atype { $$ = $1; } - | BANG atype { $$ = mktbang($2); } + | wierd_atype { $$ = $1; } ; -batypes : batype { $$ = lsing($1); } +/* A wierd atype is one that isn't a regular atype; + it starts with a "!", or with a forall. */ +wierd_atype : BANG bigatype { $$ = mktbang( $2 ) } + | BANG atype { $$ = mktbang( $2 ) } + | bigatype + ; + +batypes : { $$ = Lnil; } | batypes batype { $$ = lapp($1,$2); } ; @@ -780,8 +822,9 @@ fields : field { $$ = lsing($1); } | fields COMMA field { $$ = lapp($1,$3); } ; -field : qvars_list DCOLON type { $$ = mkfield($1,$3); } +field : qvars_list DCOLON ctype { $$ = mkfield($1,$3); } | qvars_list DCOLON BANG atype { $$ = mkfield($1,mktbang($4)); } + | qvars_list DCOLON BANG bigatype { $$ = mkfield($1,mktbang($4)); } ; constr1 : gtycon atype { $$ = lsing(mkconstrnew($1,$2,hsplineno)); } @@ -900,10 +943,12 @@ gdrhs : gd EQUAL exp { $$ = lsing(mkpgdexp($1,$3)); } maybe_where: WHERE ocurly decls ccurly { $$ = $3; } | WHERE vocurly decls vccurly { $$ = $3; } + /* A where containing no decls is OK */ + | WHERE SEMI { $$ = mknullbind(); } | /* empty */ { $$ = mknullbind(); } ; -gd : VBAR oexp { $$ = $2; } +gd : VBAR quals { $$ = $2; } ; @@ -923,7 +968,7 @@ exp : oexp DCOLON ctype { $$ = mkrestr($1,$3); } Operators must be left-associative at the same precedence for precedence parsing to work. */ - /* 9 S/R conflicts on qop -> shift */ + /* 8 S/R conflicts on qop -> shift */ oexp : oexp qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); } | dexp ; @@ -965,9 +1010,11 @@ kexp : kexpL | kexpLno ; +/* kexpL = a let expression */ kexpL : letdecls IN exp { $$ = mklet($1,$3); } ; +/* kexpLno = any other expression more tightly binding than operator application */ kexpLno : LAMBDA { hsincindent(); /* push new context for FN = NULL; */ FN = NULL; /* not actually concerned about indenting */ @@ -1023,7 +1070,6 @@ aexp : qvar { $$ = mkident($1); } | gcon { $$ = mkident($1); } | lit_constant { $$ = mklit($1); } | OPAREN exp CPAREN { $$ = mkpar($2); } /* mkpar: stop infix parsing at ()'s */ - | qcon OCURLY CCURLY { $$ = mkrecord($1,Lnil); } | qcon OCURLY rbinds CCURLY { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */ | OBRACK list_exps CBRACK { $$ = mkllist($2); } | OPAREN exp COMMA texps CPAREN { if (ttree($4) == tuple) @@ -1032,7 +1078,7 @@ aexp : qvar { $$ = mkident($1); } $$ = mktuple(ldub($2, $4)); } /* only in expressions ... */ - | aexp OCURLY rbinds CCURLY { $$ = mkrupdate($1,$3); } + | aexp OCURLY rbinds1 CCURLY { $$ = mkrupdate($1,$3); } | OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); } | OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); } | OBRACK exp COMMA exp DOTDOT CBRACK { $$ = mkeenum($2,mkjust($4),mknothing()); } @@ -1060,8 +1106,12 @@ dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; } | vocurly stmts vccurly { checkdostmts($2); $$ = $2; } ; -rbinds : rbind { $$ = lsing($1); } - | rbinds COMMA rbind { $$ = lapp($1,$3); } +rbinds : /* empty */ { $$ = Lnil; } + | rbinds1 + ; + +rbinds1 : rbind { $$ = lsing($1); } + | rbinds1 COMMA rbind { $$ = lapp($1,$3); } ; rbind : qvar { $$ = mkrbind($1,mknothing()); } @@ -1080,10 +1130,22 @@ texps : exp { $$ = mkpar($1); } /* mkpar: so we don't flatten last element in t /* right recursion? WDP */ ; - list_exps : exp { $$ = lsing($1); } + | exp COMMA exp { $$ = mklcons( $1, lsing($3) ); } + | exp COMMA exp COMMA list_rest { $$ = mklcons( $1, mklcons( $3, reverse_list( $5 ))); } + ; + +/* Use left recusion for list_rest, because we sometimes get programs with + very long explicit lists. */ +list_rest : exp { $$ = lsing($1); } + | list_rest COMMA exp { $$ = mklcons( $3, $1 ); } + ; + +/* + exp { $$ = lsing($1); } | exp COMMA list_exps { $$ = mklcons($1, $3); } +*/ /* right recursion? (WDP) It has to be this way, though, otherwise you @@ -1095,7 +1157,6 @@ list_exps : (In fact, if you change the grammar and throw yacc/bison at it, it *will* do the wrong thing [WDP 94/06]) */ - ; letdecls: LET ocurly decls ccurly { $$ = $3 } | LET vocurly decls vccurly { $$ = $3 } @@ -1107,7 +1168,8 @@ quals : qual { $$ = lsing($1); } qual : letdecls { $$ = mkseqlet($1); } | expL { $$ = $1; } - | {inpat=TRUE;} expLno {inpat=FALSE;}leftexp + | {inpat=TRUE;} expLno + {inpat=FALSE;} leftexp { if ($4 == NULL) { expORpat(LEGIT_EXPR,$2); $$ = mkguard($2); @@ -1140,7 +1202,7 @@ stmts : stmt { $$ = $1; } stmt : /* empty */ { $$ = Lnil; } | letdecls { $$ = lsing(mkseqlet($1)); } - | expL { $$ = lsing($1); } + | expL { $$ = lsing(mkdoexp($1,hsplineno)); } | {inpat=TRUE;} expLno {inpat=FALSE;} leftexp { if ($4 == NULL) { expORpat(LEGIT_EXPR,$2); @@ -1164,13 +1226,17 @@ leftexp : LARROW exp { $$ = $2; } * * **********************************************************************/ -pat : pat qconop bpat { $$ = mkinfixap($2,$1,$3); } +pat : qvar PLUS INTEGER { $$ = mkplusp($1, mkinteger($3)); } + | cpat + ; + +cpat : cpat qconop bpat { $$ = mkinfixap($2,$1,$3); } | bpat ; bpat : apatc | conpat - | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); } + | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); } | MINUS INTEGER { $$ = mknegate(mklit(mkinteger($2))); } | MINUS FLOAT { $$ = mknegate(mklit(mkfloatr($2))); } ; @@ -1217,8 +1283,12 @@ pats : pat COMMA pats { $$ = mklcons($1, $3); } /* right recursion? (WDP) */ ; -rpats : rpat { $$ = lsing($1); } - | rpats COMMA rpat { $$ = lapp($1,$3); } +rpats : /* empty */ { $$ = Lnil; } + | rpats1 + ; + +rpats1 : rpat { $$ = lsing($1); } + | rpats1 COMMA rpat { $$ = lapp($1,$3); } ; rpat : qvar { $$ = mkrbind($1,mknothing()); } @@ -1272,7 +1342,8 @@ gconk : qconk * * **********************************************************************/ -importkey: IMPORT { setstartlineno(); } +importkey: IMPORT { setstartlineno(); $$ = 0; } + | IMPORT SOURCE_UPRAGMA { setstartlineno(); $$ = 1; } ; datakey : DATA { setstartlineno(); @@ -1437,6 +1508,12 @@ varsym : varsym_nominus | MINUS { $$ = install_literal("-"); } ; +/* PLUS, BANG are valid varsyms */ +varsym_nominus : VARSYM + | PLUS { $$ = install_literal("+"); } + | BANG { $$ = install_literal("!"); } + ; + /* AS HIDING QUALIFIED are valid varids */ varid : VARID | AS { $$ = install_literal("as"); } @@ -1444,11 +1521,6 @@ varid : VARID | QUALIFIED { $$ = install_literal("qualified"); } ; -/* DARROW BANG are valid varsyms */ -varsym_nominus : VARSYM - | DARROW { $$ = install_literal("=>"); } - | BANG { $$ = install_literal("!"); } - ; ccallid : VARID | CONID @@ -1461,9 +1533,11 @@ tycon : CONID modid : CONID ; +/* tyvar_list: tyvar { $$ = lsing($1); } | tyvar_list COMMA tyvar { $$ = lapp($1,$3); } ; +*/ /********************************************************************** * * @@ -1563,7 +1637,7 @@ yyerror(s) /*NOTHING*/; } else { - fprintf(stderr, "\"%s\", line %d, column %d: %s on input: ", + fprintf(stderr, "%s:%d:%d: %s on input: ", input_filename, hsplineno, hspcolno + 1, s); if (yyleng == 1 && *yytext == '\0')