diff options
Diffstat (limited to 'ghc/compiler/yaccParser/hsparser-DPH.y')
| -rw-r--r-- | ghc/compiler/yaccParser/hsparser-DPH.y | 1555 |
1 files changed, 1555 insertions, 0 deletions
diff --git a/ghc/compiler/yaccParser/hsparser-DPH.y b/ghc/compiler/yaccParser/hsparser-DPH.y new file mode 100644 index 0000000000..55749cd24c --- /dev/null +++ b/ghc/compiler/yaccParser/hsparser-DPH.y @@ -0,0 +1,1555 @@ +/************************************************************************** +* File: hsparser.y * +* * +* Author: Maria M. Gutierrez * +* Modified by: Kevin Hammond * +* Last date revised: December 13 1991. KH. * +* Modification: o Haskell 1.1 Syntax. * +* o Data Parallel Syntax. * +* * +* * +* Description: This file contains the LALR(1) grammar for Haskell. * +* * +* Entry Point: module * +* * +* Problems: None known. * +* * +* * +* LALR(1) Syntax for Haskell 1.2 + Data Parallelism * +* * +**************************************************************************/ + + +%{ +#ifdef DEBUG +# define YYDEBUG 1 +#endif + +#include <stdio.h> +#include <ctype.h> +#include <string.h> +#include "hspincl.h" +#include "constants.h" +#include "utils.h" + + + +/********************************************************************** +* * +* * +* Imported Variables and Functions * +* * +* * +**********************************************************************/ + +extern BOOLEAN nonstandardFlag; +extern BOOLEAN expect_ccurly; +extern BOOLEAN etags; + +extern BOOLEAN ispatt PROTO((tree, BOOLEAN)); +extern tree function PROTO((tree)); + +static char modname[MODNAME_SIZE]; +static char *the_module_name; +static char iface_name[MODNAME_SIZE]; +static char interface_filename[FILENAME_SIZE]; + +static list module_exports; /* Exported entities */ +static list prelude_imports; /* Entities imported from the Prelude */ + +extern list all; /* All valid deriving classes */ + +extern tree niltree; +extern list Lnil; + +extern tree root; + +/* For FN, PREVPATT and SAMEFN macros */ +extern tree fns[]; +extern short samefn[]; +extern tree prevpatt[]; +extern short icontexts; + + +/* Line Numbers */ +extern int hsplineno; +extern int startlineno; + +/********************************************************************** +* * +* * +* Fixity and Precedence Declarations * +* * +* * +**********************************************************************/ + +list fixlist; +static int Fixity = 0, Precedence = 0; +struct infix; + +char *ineg(); + +static BOOLEAN hidden = FALSE; /* Set when HIDING used */ + +extern BOOLEAN inpat; /* True when parsing a pattern */ +extern BOOLEAN implicitPrelude; /* True when we should read the Prelude if not given */ + +%} + +%union { + tree utree; + list ulist; + ttype uttype; + atype uatype; + binding ubinding; + pbinding upbinding; + finfot ufinfo; + impidt uimpid; + entidt uentid; + id uid; + int uint; + float ufloat; + char *ustring; + hpragma uhpragma; +} + + +/********************************************************************** +* * +* * +* These are lexemes. * +* * +* * +**********************************************************************/ + + +%token VARID CONID + VARSYM CONSYM MINUS + +%token INTEGER FLOAT CHAR STRING + CHARPRIM INTPRIM FLOATPRIM DOUBLEPRIM + CLITLIT VOIDPRIM + + + +/********************************************************************** +* * +* * +* Special Symbols * +* * +* * +**********************************************************************/ + +%token OCURLY CCURLY VCCURLY SEMI +%token OBRACK CBRACK OPAREN CPAREN +%token COMMA BQUOTE +%token OPOD CPOD OPROC CPROC + + +/********************************************************************** +* * +* * +* Reserved Operators * +* * +* * +**********************************************************************/ + +%token RARROW +%token VBAR EQUAL DARROW DOTDOT +%token DCOLON LARROW +%token WILDCARD AT LAZY LAMBDA +%token DRAWNFROM INDEXFROM + + +/********************************************************************** +* * +* * +* Reserved Identifiers * +* * +* * +**********************************************************************/ + +%token LET IN +%token WHERE CASE OF +%token TYPE DATA CLASS INSTANCE DEFAULT +%token INFIX INFIXL INFIXR +%token MODULE IMPORT INTERFACE HIDING +%token CCALL CCALL_DANGEROUS CASM CASM_DANGEROUS SCC + +%token IF THEN ELSE +%token RENAMING DERIVING TO + +/********************************************************************** +* * +* * +* Special Symbols for the Lexer * +* * +* * +**********************************************************************/ + +%token LEOF +%token ARITY_PRAGMA SPECIALIZE_PRAGMA STRICTNESS_PRAGMA UPDATE_PRAGMA +%token END_PRAGMA + +/********************************************************************** +* * +* * +* Precedences of the various tokens * +* * +* * +**********************************************************************/ + + +%left CASE LET IN LAMBDA + IF ELSE CCALL CCALL_DANGEROUS + CASM CASM_DANGEROUS SCC AT + +%left VARSYM CONSYM PLUS MINUS BQUOTE + +%left DCOLON + +%left SEMI COMMA + +%left OCURLY OBRACK OPAREN + +%left OPOD OPROC + +%left EQUAL + +%right DARROW +%right RARROW + + + +/********************************************************************** +* * +* * +* Type Declarations * +* * +* * +**********************************************************************/ + + +%type <ulist> alt alts altrest quals vars varsrest cons + tyvars constrs dtypes types atypes + exps pats context context_list tyvar_list + maybeexports export_list + impspec maybeimpspec import_list + impdecls maybeimpdecls impdecl + renaming renamings renaming_list + tyclses tycls_list + gdrhs gdpat valrhs valrhs1 + lampats + upto + cexp + tyvar_pids + parquals + pragmas + + +%type <utree> exp dexp fexp kexp oexp aexp literal + tuple list sequence comprehension qual qualrest + gd + apat bpat pat apatc conpat dpat fpat opat aapat + dpatk fpatk opatk aapatk + texps + processor parqual + +%type <uid> MINUS VARID CONID VARSYM CONSYM + var vark con conk varop varop1 conop op op1 + varid conid varsym consym minus plus + tycls tycon modid ccallid + +%type <ubinding> topdecl topdecls + typed datad classd instd defaultd + decl decls valdef valdefs sign + iimport iimports maybeiimports + ityped idatad iclassd iinstd ivarsd + itopdecl itopdecls + maybe_where + interface readinterface ibody + cbody rinst + impdecl_rest + +%type <uttype> simple simple_long type atype btype ttype ntatype inst class + tyvar + +%type <uatype> constr + +%type <ustring> STRING FLOAT INTEGER CHARPRIM INTPRIM FLOATPRIM DOUBLEPRIM CLITLIT VOIDPRIM +%type <uint> CHAR +%type <uentid> export import +%type <uhpragma> pragma + + +/********************************************************************** +* * +* * +* Start Symbol for the Parser * +* * +* * +**********************************************************************/ + +%start pmodule + + +%% + +pmodule : readprelude module + ; + +module : MODULE modid maybeexports + { the_module_name = $2; module_exports = $3; } + WHERE body + | { the_module_name = install_literal("Main"); module_exports = Lnil; } + body + ; + +body : ocurly maybeimpdecls maybefixes topdecls ccurly + { + root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,$4); + } + | vocurly maybeimpdecls maybefixes topdecls vccurly + { + root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,$4); + } + + | vocurly impdecls vccurly + { + root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,mknullbind()); + } + | ocurly impdecls ccurly + { + root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,mknullbind()); + } + +/* Adds 1 S/R, 2 R/R conflicts, alternatives add 3 R/R conflicts */ + | vocurly maybeimpdecls vccurly + { + root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,mknullbind()); + } + | ocurly maybeimpdecls ccurly + { + root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,mknullbind()); + } + ; + + +maybeexports : /* empty */ { $$ = Lnil; } + | OPAREN export_list CPAREN { $$ = $2; } + ; + +export_list: + export { $$ = lsing($1); } + | export_list COMMA export { $$ = lapp($1,$3); } + ; + +export : + var { $$ = mkentid($1); } + | tycon { $$ = mkenttype($1); } + | tycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); } + | tycon OPAREN cons CPAREN + { $$ = mkenttypecons($1,$3); + /* should be a datatype with cons representing all constructors */ + } + | tycon OPAREN vars CPAREN + { $$ = mkentclass($1,$3); + /* should be a class with vars representing all Class operations */ + } + | tycon OPAREN CPAREN + { $$ = mkentclass($1,Lnil); + /* "tycon" should be a class with no operations */ + } + | tycon DOTDOT + { $$ = mkentmod($1); + /* "tycon" is a module id (but "modid" is bad for your identifier's health [KH]) */ + } + ; + + +impspec : OPAREN import_list CPAREN { $$ = $2; hidden = FALSE; } + | HIDING OPAREN import_list CPAREN { $$ = $3; hidden = TRUE; } + | OPAREN CPAREN { $$ = Lnil; hidden = FALSE; } + ; + +maybeimpspec : /* empty */ { $$ = Lnil; } + | impspec { $$ = $1; } + ; + +import_list: + import { $$ = lsing($1); } + | import_list COMMA import { $$ = lapp($1,$3); } + ; + +import : + var { $$ = mkentid($1); } + | tycon { $$ = mkenttype($1); } + | tycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); } + | tycon OPAREN cons CPAREN + { $$ = mkenttypecons($1,$3); + /* should be a datatype with cons representing all constructors */ + } + | tycon OPAREN vars CPAREN + { $$ = mkentclass($1,$3); + /* should be a class with vars representing all Class operations */ + } + | tycon OPAREN CPAREN + { $$ = mkentclass($1,Lnil); + /* "tycon" should be a class with no operations */ + } + ; + + +pragmas: + pragma { $$ = lsing($1); } + | pragmas pragma { $$ = lapp($1,$2); } + | /* empty */ { $$ = Lnil; } + ; + +pragma: + ARITY_PRAGMA var EQUAL INTEGER END_PRAGMA + { $$ = mkarity_pragma($2,$4); } + + | SPECIALIZE_PRAGMA var EQUAL ivarsd END_PRAGMA + { $$ = mkspecialize_pragma($2, $4); } + + | STRICTNESS_PRAGMA var EQUAL STRING pragmas END_PRAGMA + { $$ = mkstrictness_pragma($2, $4, $5); } + + | UPDATE_PRAGMA var EQUAL INTEGER END_PRAGMA + { $$ = mkupdate_pragma($2, $4); } + ; + + +readprelude : + { + if ( implicitPrelude ) { + find_module_on_imports_dirlist("Prelude",TRUE,interface_filename); + } else { + find_module_on_imports_dirlist("PreludeNull_",TRUE,interface_filename); + } + setyyin(interface_filename); + enteriscope(); + } + readinterface + { + binding prelude = mkimport(installid(iface_name),Lnil,Lnil,$2,xstrdup(interface_filename),hsplineno); + prelude_imports = implicitPrelude? lsing(prelude): Lnil; + } + ; + +maybeimpdecls : /* empty */ { $$ = Lnil; } + | impdecls SEMI { $$ = $1; } + ; + +impdecls: impdecl { $$ = $1; } + | impdecls SEMI impdecl { $$ = lconc($1,$3); } + ; + +impdecl : IMPORT modid + { /* filename returned in "interface_filename" */ + char *module_name = id_to_string($2); + find_module_on_imports_dirlist(module_name,FALSE,interface_filename); + setyyin(interface_filename); + enteriscope(); + if(strcmp(module_name,"Prelude")==0) + prelude_imports = Lnil; + } + impdecl_rest + { + if (hidden) + $4->tag = hiding; + $$ = lsing($4); + } + +impdecl_rest: + readinterface maybeimpspec + { $$ = mkimport(installid(iface_name),$2,Lnil,$1,xstrdup(interface_filename),hsplineno); } + /* WDP: uncertain about those hsplinenos */ + | readinterface maybeimpspec RENAMING renamings + { $$ = mkimport(installid(iface_name),$2,$4,$1,xstrdup(interface_filename),hsplineno); } + ; + +readinterface: + interface LEOF + { + exposeis(); /* partain: expose infix ops at level i+1 to level i */ + $$ = $1; + } + ; + +renamings: OPAREN renaming_list CPAREN { $$ = $2; } + ; + +renaming_list: renaming { $$ = lsing($1); } + | renaming_list COMMA renaming { $$ = lapp($1,$3); } + ; + +renaming: var TO var { $$ = ldub($1,$3); } + | con TO con { $$ = ldub($1,$3); } + ; + +maybeiimports : /* empty */ { $$ = mknullbind(); } + | iimports SEMI { $$ = $1; } + ; + +iimports : iimports SEMI iimport { $$ = mkabind($1,$3); } + | iimport { $$ = $1; } + ; + +iimport : importkey modid OPAREN import_list CPAREN + { $$ = mkmbind($2,$4,Lnil,startlineno); } + | importkey modid OPAREN import_list CPAREN RENAMING renamings + { $$ = mkmbind($2,$4,$7,startlineno); } + ; + + +interface: + INTERFACE modid + { fixlist = Lnil; + strcpy(iface_name, id_to_string($2)); + } + WHERE ibody + { + /* WDP: not only do we not check the module name + but we take the one in the interface to be what we really want + -- we need this for Prelude jiggery-pokery. (Blech. KH) + ToDo: possibly revert.... + checkmodname(modname,id_to_string($2)); + */ + $$ = $5; + } + ; + + +ibody : ocurly maybeiimports maybefixes itopdecls ccurly + { + $$ = mkabind($2,$4); + } + | ocurly iimports ccurly + { + $$ = $2; + } + | vocurly maybeiimports maybefixes itopdecls vccurly + { + $$ = mkabind($2,$4); + } + | vocurly iimports vccurly + { + $$ = $2; + } + ; + +maybefixes: /* empty */ + | fixes SEMI + ; + + +fixes : fixes SEMI fix + | fix + ; + +fix : INFIXL INTEGER + { Precedence = checkfixity($2); Fixity = INFIXL; } + ops + | INFIXR INTEGER + { Precedence = checkfixity($2); Fixity = INFIXR; } + ops + | INFIX INTEGER + { Precedence = checkfixity($2); Fixity = INFIX; } + ops + | INFIXL + { Fixity = INFIXL; Precedence = 9; } + ops + | INFIXR + { Fixity = INFIXR; Precedence = 9; } + ops + | INFIX + { Fixity = INFIX; Precedence = 9; } + ops + ; + +ops : op { makeinfix(id_to_string($1),Fixity,Precedence); } + | ops COMMA op { makeinfix(id_to_string($3),Fixity,Precedence); } + ; + +topdecls: topdecls SEMI topdecl + { + if($1 != NULL) + if($3 != NULL) + if(SAMEFN) + { + extendfn($1,$3); + $$ = $1; + } + else + $$ = mkabind($1,$3); + else + $$ = $1; + else + $$ = $3; + SAMEFN = 0; + } + | topdecl + ; + +topdecl : typed { $$ = $1; } + | datad { $$ = $1; } + | classd { $$ = $1; } + | instd { $$ = $1; } + | defaultd { $$ = $1; } + | decl { $$ = $1; } + ; + +typed : typekey simple EQUAL type { $$ = mknbind($2,$4,startlineno,mkno_pramga()); } + ; + + +datad : datakey context DARROW simple EQUAL constrs + { $$ = mktbind($2,$4,$6,all,startlineno,mkno_pragma()); } + | datakey simple EQUAL constrs + { $$ = mktbind(Lnil,$2,$4,all,startlineno,mkno_pragma()); } + | datakey context DARROW simple EQUAL constrs DERIVING tyclses + { $$ = mktbind($2,$4,$6,$8,startlineno,mkno_pragma()); } + | datakey simple EQUAL constrs DERIVING tyclses + { $$ = mktbind(Lnil,$2,$4,$6,startlineno,mkno_pragma()); } + ; + +classd : classkey context DARROW class cbody { $$ = mkcbind($2,$4,$5,startlineno,Lnil); } + | classkey class cbody { $$ = mkcbind(Lnil,$2,$3,startlineno,Lnil); } + ; + +cbody : /* empty */ { $$ = mknullbind(); } + | WHERE ocurly decls ccurly { checkorder($3); $$ = $3; } + | WHERE vocurly decls vccurly { checkorder($3); $$ =$3; } + ; + + +instd : instkey context DARROW tycls inst rinst { $$ = mkibind($2,$4,$5,$6,startlineno,Lnil); } + | instkey tycls inst rinst { $$ = mkibind(Lnil,$2,$3,$4,startlineno,Lnil); } + ; + +rinst : /* empty */ { $$ = mknullbind(); } + | WHERE ocurly valdefs ccurly { $$ = $3; } + | WHERE vocurly valdefs vccurly { $$ = $3; } + ; + +inst : tycon { $$ = mktname($1,Lnil); } + | OPAREN simple_long CPAREN { $$ = $2; } + /* partain?: "simple" requires k >= 0, not k > 0 (hence "simple_long" hack) */ + | OPAREN tyvar_list CPAREN { $$ = mkttuple($2); } + | OPAREN CPAREN { $$ = mkttuple(Lnil); } + | OBRACK tyvar CBRACK { $$ = mktllist($2); } + | OPAREN tyvar RARROW tyvar CPAREN { $$ = mktfun($2,$4); } + | OPOD tyvar CPOD { $$ = mktpod($2); } + | OPROC tyvar_pids SEMI tyvar CPROC { $$ = mktproc($2,$4); } + | OPOD tyvar_pids SEMI tyvar CPOD { $$ = mktpod(mktproc($2,$4));} + | OPOD OPROC tyvar_pids SEMI tyvar CPROC CPOD + { $$ = mktpod(mktproc($3,$5)); } + ; + +/* Note (hilly) : Similar to tyvar_list except k>=1 not k>=2 */ + +tyvar_pids : tyvar COMMA tyvar_pids { $$ = mklcons($1,$3); } + | tyvar { $$ = lsing($1); } + ; + +defaultd: defaultkey dtypes + { + $$ = mkdbind($2,startlineno); + } + ; + +dtypes : OPAREN type COMMA types CPAREN { $$ = mklcons($2,$4); } + | ttype { $$ = lsing($1); } +/* Omitting this forces () to be the *type* (), which never defaults. This is a KLUDGE */ +/* | OPAREN CPAREN { $$ = Lnil; }*/ + ; + +decls : decls SEMI decl + { + if(SAMEFN) + { + extendfn($1,$3); + $$ = $1; + } + else + $$ = mkabind($1,$3); + } + | decl + ; + +/* partain: this "DCOLON context" vs "DCOLON 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 have "DCOLON ttype" + [tuple type] in the first case, then check that it has the right + form C a, or (C1 a, C2 b, ... Cn z) and convert it into a + context. Blaach! + (FIXED 90/06/06) +*/ + +decl : vars DCOLON type DARROW type iclasop_pragma + { /* type2context.c for code */ + $$ = mksbind($1,mkcontext(type2context($3),$5),startlineno,$6); + PREVPATT = NULL; + FN = NULL; + SAMEFN = 0; + } + | sign + | valdef + | /* empty */ { $$ = mknullbind(); PREVPATT = NULL; FN = NULL; SAMEFN = 0; } + ; + +sign : vars DCOLON type iclasop_pragma + { + $$ = mksbind($1,$3,startlineno,$4); + PREVPATT = NULL; + FN = NULL; + SAMEFN = 0; + } + ; + + + +itopdecls : itopdecls SEMI itopdecl { $$ = mkabind($1,$3); } + | itopdecl { $$ = $1; } + ; + +itopdecl: ityped { $$ = $1; } + | idatad { $$ = $1; } + | iclassd { $$ = $1; } + | iinstd { $$ = $1; } + | ivarsd { $$ = $1; } + | /* empty */ { $$ = mknullbind(); } + ; + + /* partain: see comment elsewhere about why "type", not "context" */ +ivarsd : vars DCOLON type DARROW type ival_pragma + { $$ = mksbind($1,mkcontext(type2context($3),$5),startlineno,$6); } + | vars DCOLON type ival_pragma + { $$ = mksbind($1,$3,startlineno,$4); } + ; + +ityped : typekey simple EQUAL type itype_pragma { $$ = mknbind($2,$4,startlineno,$5); } + ; + +idatad : datakey context DARROW simple idata_pragma { $$ = mktbind($2,$4,Lnil,Lnil,startlineno,$5); } + | datakey simple idata_pragma { $$ = mktbind(Lnil,$2,Lnil,Lnil,startlineno,$3); } + | datakey context DARROW simple EQUAL constrs { $$ = mktbind($2,$4,$6,Lnil,startlineno,mk_nopragma()); } + | datakey simple EQUAL constrs { $$ = mktbind(Lnil,$2,$4,Lnil,startlineno,mk_nopragma()); } + | datakey context DARROW simple EQUAL constrs DERIVING tyclses { $$ = mktbind($2,$4,$6,$8,startlineno,mk_nopragma()); } + | datakey simple EQUAL constrs DERIVING tyclses { $$ = mktbind(Lnil,$2,$4,$6,startlineno,mk_nopragma()); } + ; + + +iclassd : classkey context DARROW class cbody pragmas + { $$ = mkcbind($2,$4,$5,startlineno,$6); } + | classkey class cbody pragmas + { $$ = mkcbind(Lnil,$2,$3,startlineno,$4); } + ; + +iinstd : instkey context DARROW tycls inst pragmas + { $$ = mkibind($2,$4,$5,mknullbind(),startlineno,$6); } + | instkey tycls inst pragmas + { $$ = mkibind(Lnil,$2,$3,mknullbind(),startlineno,$4); } + ; + + +/* obsolete: "(C a, ...)" cause r/r conflict, resolved in favour of context rather than type */ + +class : tycon tyvar { $$ = mktname($1,lsing($2)); } + /* partain: changed "tycls" to "tycon" */ + ; + +types : types COMMA type { $$ = lapp($1,$3); } + | type { $$ = lsing($1); } + ; + +type : btype { $$ = $1; } + | btype RARROW type { $$ = mktfun($1,$3); } + +btype : atype { $$ = $1; } + | tycon atypes { $$ = mktname($1,$2); } + ; + +atypes : atypes atype { $$ = lapp($1,$2); } + | atype { $$ = lsing($1); } + ; + +/* The split with ntatype allows us to use the same syntax for defaults as for types */ +ttype : ntatype { $$ = $1; } + | btype RARROW type { $$ = mktfun($1,$3); } + | tycon atypes { $$ = mktname($1,$2); } + ; + +atype : ntatype + | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); } + ; + +ntatype : tyvar { $$ = $1; } + | tycon { $$ = mktname($1,Lnil); } + | OPAREN CPAREN { $$ = mkttuple(Lnil); } + | OPAREN type CPAREN { $$ = $2; } + | OBRACK type CBRACK { $$ = mktllist($2); } + | OPOD type CPOD { $$ = mktpod($2); } + | OPROC types SEMI type CPROC { $$ = mktproc($2,$4); } + | OPOD types SEMI type CPOD { $$ = mktpod(mktproc($2,$4));} + ; + + +simple : tycon { $$ = mktname($1,Lnil); } + | tycon tyvars { $$ = mktname($1,$2); } + ; + + +simple_long : tycon tyvars { $$ = mktname($1,$2); } + ; /* partain: see comment in "inst" */ + + +constrs : constrs VBAR constr { $$ = lapp($1,$3); } + | constr { $$ = lsing($1); } + ; + +/* Using tycon rather than con avoids 5 S/R errors */ +constr : tycon atypes { $$ = mkatc($1,$2,hsplineno); } + | OPAREN consym CPAREN atypes { $$ = mkatc($2,$4,hsplineno); } + | tycon { $$ = mkatc($1,Lnil,hsplineno); } + | OPAREN consym CPAREN { $$ = mkatc($2,Lnil,hsplineno); } + | btype conop btype { $$ = mkatc($2, ldub($1,$3), hsplineno); } + ; + +tyclses : OPAREN tycls_list CPAREN { $$ = $2; } + | OPAREN CPAREN { $$ = Lnil; } + | tycls { $$ = lsing($1); } + ; + +tycls_list: tycls COMMA tycls_list { $$ = mklcons($1,$3); } + | tycls { $$ = lsing($1); } + ; + +context : OPAREN context_list CPAREN { $$ = $2; } + | class { $$ = lsing($1); } + ; + +context_list: class COMMA context_list { $$ = mklcons($1,$3); } + | class { $$ = lsing($1); } + ; + +valdefs : valdefs SEMI valdef + { + if(SAMEFN) + { + extendfn($1,$3); + $$ = $1; + } + else + $$ = mkabind($1,$3); + } + | valdef { $$ = $1; } + | /* empty */ { $$ = mknullbind(); } + ; + + +vars : vark COMMA varsrest { $$ = mklcons($1,$3); } + | vark { $$ = lsing($1); } + ; + +varsrest: varsrest COMMA var { $$ = lapp($1,$3); } + | var { $$ = lsing($1); } + ; + +cons : cons COMMA con { $$ = lapp($1,$3); } + | con { $$ = lsing($1); } + ; + + +valdef : opatk + { + tree fn = function($1); + + PREVPATT = $1; + + if(ttree(fn) == ident) + { + checksamefn(gident(fn)); + FN = fn; + } + + else if (ttree(fn) == tinfixop && ttree(ginfun((struct Sap *) fn)) == ident) + { + checksamefn(gident(ginfun((struct Sap *) fn))); + FN = ginfun((struct Sap *) fn); + } + + else if(etags) + printf("%u\n",startlineno); + } + valrhs + { + if(ispatt($1,TRUE)) + { + $$ = mkpbind($3, startlineno); + FN = NULL; + SAMEFN = 0; + } + else + $$ = mkfbind($3,startlineno); + + PREVPATT = NULL; + } + ; + +valrhs : valrhs1 maybe_where { $$ = lsing(createpat($1, $2)); } + ; + +valrhs1 : gdrhs + | EQUAL exp { $$ = lsing(mktruecase($2)); } + ; + +gdrhs : gd EQUAL exp { $$ = lsing(ldub($1,$3)); } + | gd EQUAL exp gdrhs { $$ = mklcons(ldub($1,$3),$4); } + ; + +maybe_where: + WHERE ocurly decls ccurly { $$ = $3; } + | WHERE vocurly decls vccurly { $$ = $3; } + | /* empty */ { $$ = mknullbind(); } + ; + +gd : VBAR oexp { $$ = $2; } + ; + + +lampats : apat lampats { $$ = mklcons($1,$2); } + | apat { $$ = lsing($1); } + ; + + +/* + Changed as above to allow for contexts! + KH@21/12/92 +*/ + + +exp : oexp DCOLON type DARROW type { $$ = mkrestr($1,mkcontext(type2context($3),$5)); } + | oexp DCOLON type { $$ = mkrestr($1,$3); } + | oexp + ; + +/* + Operators must be left-associative at the same precedence + for prec. parsing to work. +*/ + + /* Infix operator application */ +oexp : dexp + | oexp op oexp %prec PLUS + { $$ = mkinfixop($2,$1,$3); precparse($$); } + ; + +/* + This comes here because of the funny precedence rules concerning + prefix minus. +*/ + + +dexp : MINUS kexp { $$ = mknegate($2); } + | kexp + ; + +/* + let/if/lambda/case have higher precedence than infix operators. +*/ + +kexp : LAMBDA + { /* enteriscope(); /? I don't understand this -- KH */ + hsincindent(); /* added by partain; push new context for */ + /* FN = NULL; not actually concerned about */ + FN = NULL; /* indenting */ + $<uint>$ = hsplineno; /* remember current line number */ + } + lampats + { hsendindent(); /* added by partain */ + /* exitiscope(); /? Also not understood */ + } + RARROW exp /* lambda abstraction */ + { + $$ = mklambda($3, $6, $<uint>2); + } + + /* Let Expression */ + | LET ocurly decls ccurly IN exp { $$ = mklet($3,$6); } + | LET vocurly decls vccurly IN exp { $$ = mklet($3,$6); } + + /* If Expression */ + | IF exp THEN exp ELSE exp { $$ = mkife($2,$4,$6); } + + /* Case Expression */ + | CASE exp OF ocurly alts ccurly { $$ = mkcasee($2,$5); } + | CASE exp OF vocurly alts vccurly { $$ = mkcasee($2,$5); } + + /* CCALL/CASM Expression */ + | CCALL ccallid cexp { $$ = mkccall($2,installid("n"),$3); } + | CCALL ccallid { $$ = mkccall($2,installid("n"),Lnil); } + | CCALL_DANGEROUS ccallid cexp { $$ = mkccall($2,installid("p"),$3); } + | CCALL_DANGEROUS ccallid { $$ = mkccall($2,installid("p"),Lnil); } + | CASM CLITLIT cexp { $$ = mkccall($2,installid("N"),$3); } + | CASM CLITLIT { $$ = mkccall($2,installid("N"),Lnil); } + | CASM_DANGEROUS CLITLIT cexp { $$ = mkccall($2,installid("P"),$3); } + | CASM_DANGEROUS CLITLIT { $$ = mkccall($2,installid("P"),Lnil); } + + /* SCC Expression */ + | SCC STRING exp + { extern BOOLEAN ignoreSCC; + extern BOOLEAN warnSCC; + extern char * input_filename; + + if (ignoreSCC) { + if (warnSCC) + fprintf(stderr, + "\"%s\", line %d: scc (`set [profiling] cost centre') ignored\n", + input_filename, hsplineno); + $$ = $3; + } else { + $$ = mkscc($2, $3); + } + } + | fexp + ; + + + + /* Function application */ +fexp : fexp aexp { $$ = mkap($1,$2); } + | aexp + ; + +cexp : cexp aexp { $$ = lapp($1,$2); } + | aexp { $$ = lsing($1); } + ; + + +/* + The mkpars are so that infix parsing doesn't get confused. + + KH. +*/ + + /* Simple Expressions */ +aexp : var { $$ = mkident($1); } + | con { $$ = mkident($1); } + | literal + | OPAREN exp CPAREN { $$ = mkpar($2); } + | OPAREN oexp op CPAREN { checkprec($2,$3,FALSE); $$ = mklsection($2,$3); } + | OPAREN op1 oexp CPAREN { checkprec($3,$2,TRUE); $$ = mkrsection($2,$3); } + + /* structures */ + | tuple + | list { $$ = mkpar($1); } + | sequence { $$ = mkpar($1); } + | comprehension { $$ = mkpar($1); } + | OPOD exp VBAR parquals CPOD { $$ = mkparzf($2,$4); } + | OPOD exps CPOD { $$ = mkpod($2); } + | processor { $$ = mkpar($1); } + + /* These only occur in patterns */ + | var AT aexp { checkinpat(); $$ = mkas($1,$3); } + | WILDCARD { checkinpat(); $$ = mkwildp(); } + | LAZY aexp { checkinpat(); $$ = mklazyp($2); } + ; + + +processor : OPROC exps SEMI exp CPROC { $$ = mkproc($2,$4); } + ; + +parquals : parquals COMMA parqual { $$ = lapp($1,$3); } + | parqual { $$ = lsing($1); } + ; + +parqual : exp { $$ = mkparfilt($1); } + | processor DRAWNFROM exp + { $$ = mkpardgen($1,$3); + checkpatt($1); + } + | processor INDEXFROM exp + { $$ = mkparigen($1,$3); + checkpatt(gprocdata($1)); + } + ; + + +/* + LHS patterns are parsed in a similar way to + expressions. This avoids the horrible non-LRness + which occurs with the 1.1 syntax. + + The xpatk business is to do with accurately recording + the starting line for definitions. +*/ + +/*TESTTEST +bind : opatk + | vark lampats + { $$ = mkap($1,$2); } + | opatk varop opat %prec PLUS + { + $$ = mkinfixop($2,$1,$3); + } + ; + +opatk : dpatk + | opatk conop opat %prec PLUS + { + $$ = mkinfixop($2,$1,$3); + precparse($$); + } + ; + +*/ + +opatk : dpatk + | opatk op opat %prec PLUS + { + $$ = mkinfixop($2,$1,$3); + + if(isconstr(id_to_string($2))) + precparse($$); + else + { + checkprec($1,$2,FALSE); /* Check the precedence of the left pattern */ + checkprec($3,$2,TRUE); /* then check the right pattern */ + } + } + ; + +opat : dpat + | opat op opat %prec PLUS + { + $$ = mkinfixop($2,$1,$3); + + if(isconstr(id_to_string($2))) + precparse($$); + else + { + checkprec($1,$2,FALSE); /* Check the precedence of the left pattern */ + checkprec($3,$2,TRUE); /* then check the right pattern */ + } + } + ; + +/* + This comes here because of the funny precedence rules concerning + prefix minus. +*/ + + +dpat : MINUS fpat { $$ = mknegate($2); } + | fpat + ; + + /* Function application */ +fpat : fpat aapat { $$ = mkap($1,$2); } + | aapat + ; + +dpatk : minuskey fpat { $$ = mknegate($2); } + | fpatk + ; + + /* Function application */ +fpatk : fpatk aapat { $$ = mkap($1,$2); } + | aapatk + ; + +aapat : con { $$ = mkident($1); } + | var { $$ = mkident($1); } + | var AT apat { $$ = mkas($1,$3); } + | literal { $$ = $1; } + | WILDCARD { $$ = mkwildp(); } + | OPAREN CPAREN { $$ = mktuple(Lnil); } + | OPAREN var PLUS INTEGER CPAREN { $$ = mkplusp(mkident($2),mkinteger($4)); } + | OPAREN WILDCARD PLUS INTEGER CPAREN { $$ = mkplusp(mkwildp(),mkinteger($4)); } + | OPAREN opat CPAREN { $$ = mkpar($2); } + | OPAREN opat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); } + | OBRACK pats CBRACK { $$ = mkllist($2); } + | OBRACK CBRACK { $$ = mkllist(Lnil); } + | LAZY apat { $$ = mklazyp($2); } + | OPROC pats SEMI apat CPROC { $$ = mkproc($2,$4); } + ; + +aapatk : conk { $$ = mkident($1); } + | vark { $$ = mkident($1); } + | vark AT apat { $$ = mkas($1,$3); } + | literal { $$ = $1; setstartlineno(); } + | WILDCARD { $$ = mkwildp(); setstartlineno(); } + | oparenkey CPAREN { $$ = mktuple(Lnil); } + | oparenkey var PLUS INTEGER CPAREN { $$ = mkplusp(mkident($2),mkinteger($4)); } + | oparenkey WILDCARD PLUS INTEGER CPAREN { $$ = mkplusp(mkwildp(),mkinteger($4)); } + | oparenkey opat CPAREN { $$ = mkpar($2); } + | oparenkey opat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); } + | obrackkey pats CBRACK { $$ = mkllist($2); } + | obrackkey CBRACK { $$ = mkllist(Lnil); } + | lazykey apat { $$ = mklazyp($2); } + | oprockey pats SEMI opat CPROC { $$ = mkproc($2,$4); } + ; + + +/* + The mkpars are so that infix parsing doesn't get confused. + + KH. +*/ + +tuple : OPAREN exp COMMA texps CPAREN + { if (ttree($4) == tuple) + $$ = mktuple(mklcons($2, gtuplelist($4))); + else + $$ = mktuple(ldub($2, $4)); + } + | OPAREN CPAREN + { $$ = mktuple(Lnil); } + ; + +texps : exp COMMA texps + { if (ttree($3) == tuple) + $$ = mktuple(mklcons($1, gtuplelist($3))); + else + $$ = mktuple(ldub($1, $3)); + } + | exp { $$ = mkpar($1); } + ; + + +list : OBRACK CBRACK { $$ = mkllist(Lnil); } + | OBRACK exps CBRACK { $$ = mkllist($2); } + ; + +exps : exp COMMA exps { $$ = mklcons($1,$3); } + | exp { $$ = lsing($1); } + ; + + +sequence: OBRACK exp COMMA exp DOTDOT upto CBRACK {$$ = mkeenum($2,lsing($4),$6);} + | OBRACK exp DOTDOT upto CBRACK { $$ = mkeenum($2,Lnil,$4); } + ; + +comprehension: OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); } + ; + +quals : quals COMMA qual { $$ = lapp($1,$3); } + | qual { $$ = lsing($1); } + ; + +qual : { inpat = TRUE; } exp { inpat = FALSE; } qualrest + { if ($4 == NULL) + $$ = mkguard($2); + else + { + checkpatt($2); + if(ttree($4)==def) + { + tree prevpatt_save = PREVPATT; + PREVPATT = $2; + $$ = mkdef(mkpbind(lsing(createpat(lsing(mktruecase((tree)(ggdef($4)))),mknullbind())),hsplineno)); + PREVPATT = prevpatt_save; + } + else + $$ = mkqual($2,$4); + } + } + ; + +qualrest: LARROW exp { $$ = $2; } +/* OLD: + | EQUAL exp + { if(nonstandardFlag) + $$ = mkdef($2); + else + hsperror("Definitions in comprehensions are not standard Haskell"); + } +*/ + | /* empty */ { $$ = NULL; } + ; + + +alts : alts SEMI alt { $$ = lconc($1,$3); } + | alt { $$ = $1; } + ; + +alt : pat + { PREVPATT = $1; } + altrest + { $$ = $3; + PREVPATT = NULL; + } + | /* empty */ { $$ = Lnil; } + ; + +altrest : gdpat maybe_where { $$ = lsing(createpat($1,$2)); } + | RARROW exp maybe_where { $$ = lsing(createpat(lsing(mktruecase($2)),$3)); } + ; + +gdpat : gd RARROW exp gdpat { $$ = mklcons(ldub($1,$3),$4); } + | gd RARROW exp { $$ = lsing(ldub($1,$3)); } + ; + +upto : /* empty */ { $$ = Lnil; } + | exp { $$ = lsing($1); } + ; + +pats : pat COMMA pats { $$ = mklcons($1,$3); } + | pat { $$ = lsing($1); } + ; + +pat : bpat + | pat conop bpat { $$ = mkinfixop($2,$1,$3); precparse($$); } + ; + +bpat : apatc + | conpat + | MINUS INTEGER { $$ = mkinteger(ineg($2)); } + | MINUS FLOAT { $$ = mkfloatr(ineg($2)); } + ; + +conpat : con { $$ = mkident($1); } + | conpat apat { $$ = mkap($1,$2); } + ; + +apat : con { $$ = mkident($1); } + | apatc + ; + +apatc : var { $$ = mkident($1); } + | var AT apat { $$ = mkas($1,$3); } + | literal { $$ = $1; } + | WILDCARD { $$ = mkwildp(); } + | OPAREN CPAREN { $$ = mktuple(Lnil); } + | OPAREN var PLUS INTEGER CPAREN { $$ = mkplusp(mkident($2),mkinteger($4)); } + | OPAREN WILDCARD PLUS INTEGER CPAREN { $$ = mkplusp(mkwildp(),mkinteger($4)); } + | OPAREN pat CPAREN { $$ = mkpar($2); } + | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); } + | OBRACK pats CBRACK { $$ = mkllist($2); } + | OBRACK CBRACK { $$ = mkllist(Lnil); } + | LAZY apat { $$ = mklazyp($2); } + | OPROC pats SEMI apat CPROC { $$ = mkproc($2,$4); } + ; + +/* +patk : bpatk + | patk conop bpat { $$ = mkinfixop($2,$1,$3); precparse($$); } + ; + +bpatk : apatck + | conpatk + | minuskey INTEGER { $$ = mkinteger(ineg($2)); } + | minuskey FLOAT { $$ = mkfloatr(ineg($2)); } + ; + +conpatk : conk { $$ = mkident($1); } + | conpatk apat { $$ = mkap($1,$2); } + ; + +apatck : vark { $$ = mkident($1); } + | vark AT apat { $$ = mkas($1,$3); } + | literal { $$ = $1; setstartlineno(); } + | WILDCARD { $$ = mkwildp(); setstartlineno(); } + | oparenkey CPAREN { $$ = mktuple(Lnil); } + | oparenkey var PLUS INTEGER CPAREN { $$ = mkplusp(mkident($2),mkinteger($4)); } + | oparenkey WILDCARD PLUS INTEGER CPAREN { $$ = mkplusp(mkwildp(),mkinteger($4)); } + | oparenkey pat CPAREN { $$ = mkpar($2); } + | oparenkey pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); } + | obrackkey pats CBRACK { $$ = mkllist($2); } + | obrackkey CBRACK { $$ = mkllist(Lnil); } + | lazykey apat { $$ = mklazyp($2); } + | oprockey pats SEMI opat CPROC { $$ = mkproc($2,$4); } + ; +*/ + +literal : INTEGER { $$ = mkinteger($1); } + | FLOAT { $$ = mkfloatr($1); } + | CHAR { $$ = mkcharr($1); } + | STRING { $$ = mkstring($1); } + | CHARPRIM { $$ = mkcharprim($1); } + | INTPRIM { $$ = mkintprim($1); } + | FLOATPRIM { $$ = mkfloatprim($1); } + | DOUBLEPRIM { $$ = mkdoubleprim($1); } + | CLITLIT { $$ = mkclitlit($1); } + | VOIDPRIM { $$ = mkvoidprim(); } + ; + + +/* Keywords which record the line start */ + +importkey: IMPORT { setstartlineno(); } + ; + +datakey : DATA { setstartlineno(); + if(etags) + printf("%u\n",startlineno); + } + ; + +typekey : TYPE { setstartlineno(); + if(etags) + printf("%u\n",startlineno); + } + ; + +instkey : INSTANCE { setstartlineno(); + if(etags) + printf("%u\n",startlineno); + } + ; + +defaultkey: DEFAULT { setstartlineno(); } + ; + +classkey: CLASS { setstartlineno(); + if(etags) + printf("%u\n",startlineno); + } + ; + +minuskey: MINUS { setstartlineno(); } + ; + +oparenkey: OPAREN { setstartlineno(); } + ; + +obrackkey: OBRACK { setstartlineno(); } + ; + +lazykey : LAZY { setstartlineno(); } + ; + +oprockey: OPROC { setstartlineno(); } + ; + + +/* Non "-" op, used in right sections -- KH */ +op1 : conop + | varop1 + ; + +op : conop + | varop + ; + +varop : varsym + | BQUOTE varid BQUOTE { $$ = $2; } + ; + +/* Non-minus varop, used in right sections */ +varop1 : VARSYM + | plus + | BQUOTE varid BQUOTE { $$ = $2; } + ; + +conop : consym + | BQUOTE conid BQUOTE { $$ = $2; } + ; + +consym : CONSYM + ; + +varsym : VARSYM + | plus + | minus + ; + +minus : MINUS { $$ = install_literal("-"); } + ; + +plus : PLUS { $$ = install_literal("+"); } + ; + +var : VARID + | OPAREN varsym CPAREN { $$ = $2; } + ; + +vark : VARID { setstartlineno(); $$ = $1; } + | oparenkey varsym CPAREN { $$ = $2; } + ; + +/* tycon used here to eliminate 11 spurious R/R errors -- KH */ +con : tycon + | OPAREN consym CPAREN { $$ = $2; } + ; + +conk : tycon { setstartlineno(); $$ = $1; } + | oparenkey consym CPAREN { $$ = $2; } + ; + +varid : VARID + ; + +conid : CONID + ; + +ccallid : varid + | conid + ; + +/* partain: "tyvar_list" must be at least 2 elements long (defn of "inst") */ +tyvar_list: tyvar COMMA tyvar_list { $$ = mklcons($1,$3); } + | tyvar COMMA tyvar { $$ = mklcons($1,lsing($3)); } + ; + +tyvars : tyvar tyvars { $$ = mklcons($1,$2); } + | tyvar { $$ = lsing($1); } + ; + +tyvar : VARID { $$ = mknamedtvar($1); } + ; + +tycls : tycon + /* partain: "aconid"->"tycon" got rid of a r/r conflict + (and introduced >= 2 s/r's ...) + */ + ; + +tycon : conid + ; + +modid : CONID + ; + + +ocurly : layout OCURLY { hsincindent(); } + +vocurly : layout { hssetindent(); } + ; + +layout : { hsindentoff(); } + ; + +ccurly : + CCURLY + { + FN = NULL; SAMEFN = 0; PREVPATT = NULL; + hsendindent(); + } + ; + +vccurly : { expect_ccurly = 1; } vccurly1 { expect_ccurly = 0; } + ; + +vccurly1: + VCCURLY + { + FN = NULL; SAMEFN = 0; PREVPATT = NULL; + hsendindent(); + } + | error + { + yyerrok; + FN = NULL; SAMEFN = 0; PREVPATT = NULL; + hsendindent(); + } + ; + +%% |