static maybe module_exports;
extern list Lnil;
+extern list reverse_list();
extern tree root;
/* For FN, PREVPATT and SAMEFN macros */
long source_version = 0;
-BOOLEAN inpat;
%}
%union {
* *
**********************************************************************/
-%token MINUS BANG
+%token MINUS BANG PLUS
%token AS HIDING QUALIFIED
**********************************************************************/
%token INTERFACE_UPRAGMA SPECIALISE_UPRAGMA
-%token INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
-%token DEFOREST_UPRAGMA END_UPRAGMA
+%token INLINE_UPRAGMA NOINLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
+%token END_UPRAGMA
+%token SOURCE_UPRAGMA
/**********************************************************************
* *
SCC CASM CCALL CASM_GC CCALL_GC
%left VARSYM CONSYM QVARSYM QCONSYM
- MINUS BQUOTE BANG DARROW
+ MINUS BQUOTE BANG DARROW PLUS
%left DCOLON
%type <ulist> 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 simple_context simple_context_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 <umaybe> maybeexports impspec deriving
%type <utree> 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 <uid> MINUS DARROW AS LAZY
+%type <uid> MINUS PLUS DARROW AS LAZY
VARID CONID VARSYM CONSYM
var con varop conop op
vark varid varsym varsym_nominus
%type <upbinding> valrhs1 altrest
-%type <uttype> simple ctype type atype btype
- gtyconapp ntyconapp ntycon gtyconvars
- bbtype batype btyconapp
- class restrict_inst general_inst tyvar
+%type <uttype> ctype sigtype sigarrowtype type atype bigatype btype
+ bbtype batype bxtype wierd_atype
+ simple_con_app simple_con_app1 tyvar contype inst_type
-%type <uconstr> constr field
+%type <uconstr> constr constr_after_context field
%type <ustring> FLOAT INTEGER INTPRIM
FLOATPRIM DOUBLEPRIM CLITLIT
%type <uentid> export import
-%type <ulong> commas
+%type <ulong> commas importkey get_line_no
/**********************************************************************
* *
impdecl : importkey modid impspec
- { $$ = lsing(mkimport($2,0,mknothing(),$3,startlineno)); }
+ { $$ = lsing(mkimport($2,0,mknothing(),$3,$1,startlineno)); }
| importkey QUALIFIED modid impspec
- { $$ = lsing(mkimport($3,1,mknothing(),$4,startlineno)); }
+ { $$ = lsing(mkimport($3,1,mknothing(),$4,$1,startlineno)); }
| importkey QUALIFIED modid AS modid impspec
- { $$ = lsing(mkimport($3,1,mkjust($5),$6,startlineno)); }
+ { $$ = lsing(mkimport($3,1,mkjust($5),$6,$1,startlineno)); }
+ | importkey modid AS modid impspec
+ { $$ = lsing(mkimport($3,1,mkjust($4),$5,$1,startlineno)); }
;
impspec : /* empty */ { $$ = mknothing(); }
;
itycon : tycon { $$ = mknoqual($1); }
- | OBRACK CBRACK { $$ = creategid(-1); }
- | OPAREN CPAREN { $$ = creategid(0); }
+ | OBRACK CBRACK { $$ = creategid(NILGID); }
+ | OPAREN CPAREN { $$ = creategid(UNITGID); }
| OPAREN commas CPAREN { $$ = creategid($2); }
;
ops { $$ = $3; }
;
-ops : op { $$ = lsing(mkfixop(mknoqual($1),infixint(Fixity),Precedence)); }
- | ops COMMA op { $$ = lapp($1,mkfixop(mknoqual($3),infixint(Fixity),Precedence)); }
+ops : op { $$ = lsing(mkfixop(mknoqual($1),infixint(Fixity),Precedence,startlineno)); }
+ | ops COMMA op { $$ = lapp($1,mkfixop(mknoqual($3),infixint(Fixity),Precedence,startlineno)); }
;
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; }
;
-typed : typekey simple EQUAL type { $$ = mknbind($2,$4,startlineno); }
+typed : typekey simple_con_app EQUAL type { $$ = mknbind($2,$4,startlineno); }
;
-datad : datakey simple EQUAL constrs deriving
+datad : datakey simple_con_app EQUAL constrs deriving
{ $$ = mktbind(Lnil,$2,$4,$5,startlineno); }
- | datakey context DARROW simple EQUAL constrs deriving
+ | datakey simple_context DARROW simple_con_app EQUAL constrs deriving
{ $$ = mktbind($2,$4,$6,$7,startlineno); }
;
-newtd : newtypekey simple EQUAL constr1 deriving
+newtd : newtypekey simple_con_app EQUAL constr1 deriving
{ $$ = mkntbind(Lnil,$2,$4,$5,startlineno); }
- | newtypekey context DARROW simple EQUAL constr1 deriving
+ | newtypekey simple_context DARROW simple_con_app EQUAL constr1 deriving
{ $$ = mkntbind($2,$4,$6,$7,startlineno); }
;
| DERIVING dtyclses { $$ = mkjust($2); }
;
-classd : classkey context DARROW class cbody
- { $$ = mkcbind($2,$4,$5,startlineno); }
- | classkey class cbody
- { $$ = mkcbind(Lnil,$2,$3,startlineno); }
+classd : classkey btype DARROW simple_con_app1 cbody
+ /* Context can now be more than simple_context */
+ { $$ = mkcbind(type2context($2),$4,$5,startlineno); }
+ | classkey btype cbody
+ /* We have to say btype rather than simple_con_app1, else
+ we get reduce/reduce errs */
+ { check_class_decl_head($3);
+ $$ = mkcbind(Lnil,$2,$3,startlineno); }
;
cbody : /* empty */ { $$ = mknullbind(); }
| WHERE vocurly decls vccurly { checkorder($3); $$ = $3; }
;
-instd : instkey context DARROW gtycon restrict_inst rinst
- { $$ = mkibind($2,$4,$5,$6,startlineno); }
- | instkey gtycon general_inst rinst
- { $$ = mkibind(Lnil,$2,$3,$4,startlineno); }
+instd : instkey inst_type rinst { $$ = mkibind($2,$3,startlineno); }
;
+/* Compare ctype */
+inst_type : type DARROW type { is_context_format( $3, 0 ); /* Check the instance head */
+ $$ = mkcontext(type2context($1),$3); }
+ | btype { is_context_format( $1, 0 ); /* Check the instance head */
+ $$ = $1; }
+ ;
+
+
rinst : /* empty */ { $$ = mknullbind(); }
| WHERE ocurly instdefs ccurly { $$ = $3; }
| WHERE vocurly instdefs vccurly { $$ = $3; }
;
-restrict_inst : gtycon { $$ = mktname($1); }
- | OPAREN gtyconvars CPAREN { $$ = $2; }
- | OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); }
- | OBRACK tyvar CBRACK { $$ = mktllist($2); }
- | OPAREN tyvar RARROW tyvar CPAREN { $$ = mktfun($2,$4); }
- ;
-
-general_inst : gtycon { $$ = mktname($1); }
- | OPAREN gtyconapp 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); }
;
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;
}
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;
PREVPATT = NULL; FN = NULL; SAMEFN = 0;
}
- | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
+ | NOINLINE_UPRAGMA qvark END_UPRAGMA
{
- $$ = mkmagicuf_uprag($2, $3, startlineno);
+ $$ = mknoinline_uprag($2, startlineno);
PREVPATT = NULL; FN = NULL; SAMEFN = 0;
}
- | DEFOREST_UPRAGMA qvark END_UPRAGMA
- {
- $$ = mkdeforest_uprag($2, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+ | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
+ {
+ $$ = mkmagicuf_uprag($2, $3, startlineno);
+ PREVPATT = NULL; FN = NULL; SAMEFN = 0;
}
/* end of user-specified pragmas */
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 : btype 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 btype DARROW type CPAREN { $$ = mkcontext(type2context($2),$4); }
;
-ntyconapp: ntycon { $$ = $1; }
- | ntyconapp atype { $$ = mktapp($1,$2); }
+ /* 1 S/R conflict at DARROW -> shift */
+ctype : btype 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; }
;
gtycon : qtycon
- | OPAREN RARROW CPAREN { $$ = creategid(-2); }
- | OBRACK CBRACK { $$ = creategid(-1); }
- | OPAREN CPAREN { $$ = creategid(0); }
+ | OPAREN RARROW CPAREN { $$ = creategid(ARROWGID); }
+ | OBRACK CBRACK { $$ = creategid(NILGID); }
+ | OPAREN CPAREN { $$ = creategid(UNITGID); }
| OPAREN commas CPAREN { $$ = creategid($2); }
;
* *
**********************************************************************/
-simple : gtycon { $$ = mktname($1); }
- | gtyconvars { $$ = $1; }
+/* C a b c, where a,b,c are type variables */
+/* C can be a class or tycon */
+simple_con_app: gtycon { $$ = mktname($1); }
+ | simple_con_app1 { $$ = $1; }
;
-
-gtyconvars: gtycon tyvar { $$ = mktapp(mktname($1),$2); }
- | gtyconvars tyvar { $$ = mktapp($1,$2); }
- ;
-
-context : OPAREN context_list CPAREN { $$ = $2; }
- | class { $$ = lsing($1); }
+
+simple_con_app1: gtycon tyvar { $$ = mktapp(mktname($1),$2); }
+ | simple_con_app tyvar { $$ = mktapp($1, $2); }
;
-context_list: class { $$ = lsing($1); }
- | context_list COMMA class { $$ = lapp($1,$3); }
+simple_context : OPAREN simple_context_list CPAREN { $$ = $2; }
+ | simple_con_app1 { $$ = lsing($1); }
;
-class : gtycon tyvar { $$ = mktapp(mktname($1),$2); }
+simple_context_list: simple_con_app1 { $$ = lsing($1); }
+ | simple_context_list COMMA simple_con_app1 { $$ = lapp($1,$3); }
;
constrs : constr { $$ = lsing($1); }
| constrs VBAR constr { $$ = lapp($1,$3); }
;
-constr : btyconapp { qid tyc; list tys;
+constr : constr_after_context
+ | btype 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 */
- | gtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
+/* Con { op1 :: Int } */
+ | qtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
+ | OPAREN qconsym CPAREN OCURLY fields CCURLY { $$ = mkconstrrec($2,$5,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); }
;
| 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)); }
PREVPATT = NULL; FN = NULL; SAMEFN = 0;
}
+ | NOINLINE_UPRAGMA qvark END_UPRAGMA
+ {
+ $$ = mknoinline_uprag($2, startlineno);
+ PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+ }
+
| MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
{
$$ = mkmagicuf_uprag($2, $3, startlineno);
valdef : vallhs
+
{
tree fn = function($1);
PREVPATT = $1;
#else
fprintf(stderr,"%u\tvaldef\n",startlineno);
#endif
- }
+ }
+
+ get_line_no
valrhs
{
if ( lhs_is_patt($1) )
{
- $$ = mkpbind($3, startlineno);
+ $$ = mkpbind($4, $3);
FN = NULL;
SAMEFN = 0;
}
else
- $$ = mkfbind($3,startlineno);
+ $$ = mkfbind($4, $3);
PREVPATT = NULL;
}
;
+get_line_no : { $$ = startlineno; }
+ ;
+
vallhs : patk { $$ = $1; }
| patk qvarop pat { $$ = mkinfixap($2,$1,$3); }
| funlhs { $$ = $1; }
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; }
;
We need to factor out a leading let expression so we can set
inpat=TRUE when parsing (non let) expressions inside stmts and quals
*/
-expLno : oexpLno DCOLON ctype { $$ = mkrestr($1,$3); }
- | oexpLno
+expLno : oexpLno DCOLON ctype { $$ = mkrestr($1,$3); }
+ | oexpLno
;
oexpLno : oexpLno qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
| dexpLno
| 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 */
/* SCC Expression */
| SCC STRING exp
{ if (ignoreSCC) {
- $$ = $3;
+ if (warnSCC) {
+ fprintf(stderr,
+ "\"%s\":%d: _scc_ (`set [profiling] cost centre') ignored\n",
+ input_filename, hsplineno);
+ }
+ $$ = mkpar($3); /* Note the mkpar(). If we don't have it, then
+ (x >> _scc_ y >> z) parses as (x >> (y >> z)),
+ right associated. But the precedence reorganiser expects
+ the parser to *left* associate all operators unless there
+ are explicit parens. The _scc_ acts like an explicit paren,
+ so if we omit it we'd better add explicit parens instead. */
} else {
$$ = mkscc($2, $3);
}
| 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)
$$ = 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()); }
/* only in patterns ... */
/* these add 2 S/R conflict with with aexp . OCURLY rbinds CCURLY */
- | qvar AT aexp { checkinpat(); $$ = mkas($1,$3); }
- | LAZY aexp { checkinpat(); $$ = mklazyp($2); }
- | WILDCARD { checkinpat(); $$ = mkwildp(); }
+ | qvar AT aexp { $$ = mkas($1,$3); }
+ | LAZY aexp { $$ = mklazyp($2); }
+ | WILDCARD { $$ = mkwildp(); }
;
/* ccall arguments */
caserest: ocurly alts ccurly { $$ = $2; }
| vocurly alts vccurly { $$ = $2; }
-dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; }
+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()); }
/* 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
(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 }
+letdecls: LET ocurly decls ccurly { $$ = $3; }
+ | LET vocurly decls vccurly { $$ = $3; }
;
quals : qual { $$ = lsing($1); }
qual : letdecls { $$ = mkseqlet($1); }
| expL { $$ = $1; }
- | {inpat=TRUE;} expLno {inpat=FALSE;}leftexp
- { if ($4 == NULL) {
- expORpat(LEGIT_EXPR,$2);
- $$ = mkguard($2);
+ | expLno leftexp
+ { if ($2 == NULL) {
+ expORpat(LEGIT_EXPR,$1);
+ $$ = mkguard($1);
} else {
- expORpat(LEGIT_PATT,$2);
- $$ = mkqual($2,$4);
+ expORpat(LEGIT_PATT,$1);
+ $$ = mkqual($1,$2);
}
}
;
| alts SEMI alt { $$ = lconc($1,$3); }
;
-alt : pat { PREVPATT = $1; } altrest { $$ = lsing($3); PREVPATT = NULL; }
+alt : pat { PREVPATT = $1; } altrest { expORpat(LEGIT_PATT,$1); $$ = lsing($3); PREVPATT = NULL; }
| /* empty */ { $$ = Lnil; }
;
| gd RARROW exp gdpat { $$ = mklcons(mkpgdexp($1,$3),$4); }
;
-stmts : stmt { $$ = $1; }
+stmts : stmt { $$ = $1; }
| stmts SEMI stmt { $$ = lconc($1,$3); }
;
-stmt : /* empty */ { $$ = Lnil; }
- | letdecls { $$ = lsing(mkseqlet($1)); }
- | expL { $$ = lsing($1); }
- | {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
- { if ($4 == NULL) {
- expORpat(LEGIT_EXPR,$2);
- $$ = lsing(mkdoexp($2,endlineno));
+stmt : /* empty */ { $$ = Lnil; }
+ | letdecls { $$ = lsing(mkseqlet($1)); }
+ | expL { $$ = lsing(mkdoexp($1,hsplineno)); }
+ | expLno leftexp
+ { if ($2 == NULL) {
+ expORpat(LEGIT_EXPR,$1);
+ $$ = lsing(mkdoexp($1,endlineno));
} else {
- expORpat(LEGIT_PATT,$2);
- $$ = lsing(mkdobind($2,$4,endlineno));
+ expORpat(LEGIT_PATT,$1);
+ $$ = lsing(mkdobind($1,$2,endlineno));
}
}
;
* *
**********************************************************************/
-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))); }
;
/* 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()); }
gcon : qcon
- | OBRACK CBRACK { $$ = creategid(-1); }
- | OPAREN CPAREN { $$ = creategid(0); }
+ | OBRACK CBRACK { $$ = creategid(NILGID); }
+ | OPAREN CPAREN { $$ = creategid(UNITGID); }
| OPAREN commas CPAREN { $$ = creategid($2); }
;
gconk : qconk
- | obrackkey CBRACK { $$ = creategid(-1); }
- | oparenkey CPAREN { $$ = creategid(0); }
+ | obrackkey CBRACK { $$ = creategid(NILGID); }
+ | oparenkey CPAREN { $$ = creategid(UNITGID); }
| oparenkey commas CPAREN { $$ = creategid($2); }
;
* *
**********************************************************************/
-importkey: IMPORT { setstartlineno(); }
+importkey: IMPORT { setstartlineno(); $$ = 0; }
+ | IMPORT SOURCE_UPRAGMA { setstartlineno(); $$ = 1; }
;
datakey : DATA { setstartlineno();
| 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"); }
| QUALIFIED { $$ = install_literal("qualified"); }
;
-/* BANG are valid varsyms */
-varsym_nominus : VARSYM
- | BANG { $$ = install_literal("!"); }
- ;
ccallid : VARID
| CONID
modid : CONID
;
+/*
tyvar_list: tyvar { $$ = lsing($1); }
| tyvar_list COMMA tyvar { $$ = lapp($1,$3); }
;
+*/
/**********************************************************************
* *
FN = NULL; SAMEFN = 0; PREVPATT = NULL;
hsendindent();
}
- ;
+ ;
%%
* *
**********************************************************************/
+
+/*
void
checkinpat()
{
if(!inpat)
hsperror("pattern syntax used in expression");
}
-
+*/
/* The parser calls "hsperror" when it sees a
`report this and die' error. It sets the stage
/*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')
projects / ghc-hetmet.git / blobdiff