X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FyaccParser%2Fhsparser-DPH.y;fp=ghc%2Fcompiler%2FyaccParser%2Fhsparser-DPH.y;h=0000000000000000000000000000000000000000;hb=f6ca98ca45e8cdbae153a23077cccb5dd71e4e7b;hp=55749cd24c0dbb4c448193c9c551f4a3a5f6892e;hpb=b52838bcf54a3d5d07cf29f17f3af6f584fc0f4e;p=ghc-hetmet.git diff --git a/ghc/compiler/yaccParser/hsparser-DPH.y b/ghc/compiler/yaccParser/hsparser-DPH.y deleted file mode 100644 index 55749cd..0000000 --- a/ghc/compiler/yaccParser/hsparser-DPH.y +++ /dev/null @@ -1,1555 +0,0 @@ -/************************************************************************** -* 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 -#include -#include -#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 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 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 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 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 simple simple_long type atype btype ttype ntatype inst class - tyvar - -%type constr - -%type STRING FLOAT INTEGER CHARPRIM INTPRIM FLOATPRIM DOUBLEPRIM CLITLIT VOIDPRIM -%type CHAR -%type export import -%type 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 */ - $$ = hsplineno; /* remember current line number */ - } - lampats - { hsendindent(); /* added by partain */ - /* exitiscope(); /? Also not understood */ - } - RARROW exp /* lambda abstraction */ - { - $$ = mklambda($3, $6, $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(); - } - ; - -%%