1 /**************************************************************************
4 * Author: Maria M. Gutierrez *
5 * Modified by: Kevin Hammond *
6 * Last date revised: December 13 1991. KH. *
7 * Modification: o Haskell 1.1 Syntax. *
8 * o Data Parallel Syntax. *
11 * Description: This file contains the LALR(1) grammar for Haskell. *
13 * Entry Point: module *
15 * Problems: None known. *
18 * LALR(1) Syntax for Haskell 1.2 + Data Parallelism *
20 **************************************************************************/
32 #include "constants.h"
37 /**********************************************************************
40 * Imported Variables and Functions *
43 **********************************************************************/
45 extern BOOLEAN nonstandardFlag;
46 extern BOOLEAN expect_ccurly;
49 extern BOOLEAN ispatt PROTO((tree, BOOLEAN));
50 extern tree function PROTO((tree));
52 static char modname[MODNAME_SIZE];
53 static char *the_module_name;
54 static char iface_name[MODNAME_SIZE];
55 static char interface_filename[FILENAME_SIZE];
57 static list module_exports; /* Exported entities */
58 static list prelude_imports; /* Entities imported from the Prelude */
60 extern list all; /* All valid deriving classes */
67 /* For FN, PREVPATT and SAMEFN macros */
69 extern short samefn[];
70 extern tree prevpatt[];
71 extern short icontexts;
76 extern int startlineno;
78 /**********************************************************************
81 * Fixity and Precedence Declarations *
84 **********************************************************************/
87 static int Fixity = 0, Precedence = 0;
92 static BOOLEAN hidden = FALSE; /* Set when HIDING used */
94 extern BOOLEAN inpat; /* True when parsing a pattern */
95 extern BOOLEAN implicitPrelude; /* True when we should read the Prelude if not given */
117 /**********************************************************************
120 * These are lexemes. *
123 **********************************************************************/
129 %token INTEGER FLOAT CHAR STRING
130 CHARPRIM INTPRIM FLOATPRIM DOUBLEPRIM
135 /**********************************************************************
141 **********************************************************************/
143 %token OCURLY CCURLY VCCURLY SEMI
144 %token OBRACK CBRACK OPAREN CPAREN
146 %token OPOD CPOD OPROC CPROC
149 /**********************************************************************
152 * Reserved Operators *
155 **********************************************************************/
158 %token VBAR EQUAL DARROW DOTDOT
160 %token WILDCARD AT LAZY LAMBDA
161 %token DRAWNFROM INDEXFROM
164 /**********************************************************************
167 * Reserved Identifiers *
170 **********************************************************************/
174 %token TYPE DATA CLASS INSTANCE DEFAULT
175 %token INFIX INFIXL INFIXR
176 %token MODULE IMPORT INTERFACE HIDING
177 %token CCALL CCALL_DANGEROUS CASM CASM_DANGEROUS SCC
180 %token RENAMING DERIVING TO
182 /**********************************************************************
185 * Special Symbols for the Lexer *
188 **********************************************************************/
191 %token ARITY_PRAGMA SPECIALIZE_PRAGMA STRICTNESS_PRAGMA UPDATE_PRAGMA
194 /**********************************************************************
197 * Precedences of the various tokens *
200 **********************************************************************/
203 %left CASE LET IN LAMBDA
204 IF ELSE CCALL CCALL_DANGEROUS
205 CASM CASM_DANGEROUS SCC AT
207 %left VARSYM CONSYM PLUS MINUS BQUOTE
213 %left OCURLY OBRACK OPAREN
224 /**********************************************************************
227 * Type Declarations *
230 **********************************************************************/
233 %type <ulist> alt alts altrest quals vars varsrest cons
234 tyvars constrs dtypes types atypes
235 exps pats context context_list tyvar_list
236 maybeexports export_list
237 impspec maybeimpspec import_list
238 impdecls maybeimpdecls impdecl
239 renaming renamings renaming_list
241 gdrhs gdpat valrhs valrhs1
250 %type <utree> exp dexp fexp kexp oexp aexp literal
251 tuple list sequence comprehension qual qualrest
253 apat bpat pat apatc conpat dpat fpat opat aapat
254 dpatk fpatk opatk aapatk
258 %type <uid> MINUS VARID CONID VARSYM CONSYM
259 var vark con conk varop varop1 conop op op1
260 varid conid varsym consym minus plus
261 tycls tycon modid ccallid
263 %type <ubinding> topdecl topdecls
264 typed datad classd instd defaultd
265 decl decls valdef valdefs sign
266 iimport iimports maybeiimports
267 ityped idatad iclassd iinstd ivarsd
270 interface readinterface ibody
274 %type <uttype> simple simple_long type atype btype ttype ntatype inst class
277 %type <uatype> constr
279 %type <ustring> STRING FLOAT INTEGER CHARPRIM INTPRIM FLOATPRIM DOUBLEPRIM CLITLIT VOIDPRIM
281 %type <uentid> export import
282 %type <uhpragma> pragma
285 /**********************************************************************
288 * Start Symbol for the Parser *
291 **********************************************************************/
298 pmodule : readprelude module
301 module : MODULE modid maybeexports
302 { the_module_name = $2; module_exports = $3; }
304 | { the_module_name = install_literal("Main"); module_exports = Lnil; }
308 body : ocurly maybeimpdecls maybefixes topdecls ccurly
310 root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,$4);
312 | vocurly maybeimpdecls maybefixes topdecls vccurly
314 root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,$4);
317 | vocurly impdecls vccurly
319 root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,mknullbind());
321 | ocurly impdecls ccurly
323 root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,mknullbind());
326 /* Adds 1 S/R, 2 R/R conflicts, alternatives add 3 R/R conflicts */
327 | vocurly maybeimpdecls vccurly
329 root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,mknullbind());
331 | ocurly maybeimpdecls ccurly
333 root = mkhmodule(the_module_name,lconc(prelude_imports,$2),module_exports,mknullbind());
338 maybeexports : /* empty */ { $$ = Lnil; }
339 | OPAREN export_list CPAREN { $$ = $2; }
343 export { $$ = lsing($1); }
344 | export_list COMMA export { $$ = lapp($1,$3); }
348 var { $$ = mkentid($1); }
349 | tycon { $$ = mkenttype($1); }
350 | tycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
351 | tycon OPAREN cons CPAREN
352 { $$ = mkenttypecons($1,$3);
353 /* should be a datatype with cons representing all constructors */
355 | tycon OPAREN vars CPAREN
356 { $$ = mkentclass($1,$3);
357 /* should be a class with vars representing all Class operations */
359 | tycon OPAREN CPAREN
360 { $$ = mkentclass($1,Lnil);
361 /* "tycon" should be a class with no operations */
365 /* "tycon" is a module id (but "modid" is bad for your identifier's health [KH]) */
370 impspec : OPAREN import_list CPAREN { $$ = $2; hidden = FALSE; }
371 | HIDING OPAREN import_list CPAREN { $$ = $3; hidden = TRUE; }
372 | OPAREN CPAREN { $$ = Lnil; hidden = FALSE; }
375 maybeimpspec : /* empty */ { $$ = Lnil; }
376 | impspec { $$ = $1; }
380 import { $$ = lsing($1); }
381 | import_list COMMA import { $$ = lapp($1,$3); }
385 var { $$ = mkentid($1); }
386 | tycon { $$ = mkenttype($1); }
387 | tycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
388 | tycon OPAREN cons CPAREN
389 { $$ = mkenttypecons($1,$3);
390 /* should be a datatype with cons representing all constructors */
392 | tycon OPAREN vars CPAREN
393 { $$ = mkentclass($1,$3);
394 /* should be a class with vars representing all Class operations */
396 | tycon OPAREN CPAREN
397 { $$ = mkentclass($1,Lnil);
398 /* "tycon" should be a class with no operations */
404 pragma { $$ = lsing($1); }
405 | pragmas pragma { $$ = lapp($1,$2); }
406 | /* empty */ { $$ = Lnil; }
410 ARITY_PRAGMA var EQUAL INTEGER END_PRAGMA
411 { $$ = mkarity_pragma($2,$4); }
413 | SPECIALIZE_PRAGMA var EQUAL ivarsd END_PRAGMA
414 { $$ = mkspecialize_pragma($2, $4); }
416 | STRICTNESS_PRAGMA var EQUAL STRING pragmas END_PRAGMA
417 { $$ = mkstrictness_pragma($2, $4, $5); }
419 | UPDATE_PRAGMA var EQUAL INTEGER END_PRAGMA
420 { $$ = mkupdate_pragma($2, $4); }
426 if ( implicitPrelude ) {
427 find_module_on_imports_dirlist("Prelude",TRUE,interface_filename);
429 find_module_on_imports_dirlist("PreludeNull_",TRUE,interface_filename);
431 setyyin(interface_filename);
436 binding prelude = mkimport(installid(iface_name),Lnil,Lnil,$2,xstrdup(interface_filename),hsplineno);
437 prelude_imports = implicitPrelude? lsing(prelude): Lnil;
441 maybeimpdecls : /* empty */ { $$ = Lnil; }
442 | impdecls SEMI { $$ = $1; }
445 impdecls: impdecl { $$ = $1; }
446 | impdecls SEMI impdecl { $$ = lconc($1,$3); }
449 impdecl : IMPORT modid
450 { /* filename returned in "interface_filename" */
451 char *module_name = id_to_string($2);
452 find_module_on_imports_dirlist(module_name,FALSE,interface_filename);
453 setyyin(interface_filename);
455 if(strcmp(module_name,"Prelude")==0)
456 prelude_imports = Lnil;
466 readinterface maybeimpspec
467 { $$ = mkimport(installid(iface_name),$2,Lnil,$1,xstrdup(interface_filename),hsplineno); }
468 /* WDP: uncertain about those hsplinenos */
469 | readinterface maybeimpspec RENAMING renamings
470 { $$ = mkimport(installid(iface_name),$2,$4,$1,xstrdup(interface_filename),hsplineno); }
476 exposeis(); /* partain: expose infix ops at level i+1 to level i */
481 renamings: OPAREN renaming_list CPAREN { $$ = $2; }
484 renaming_list: renaming { $$ = lsing($1); }
485 | renaming_list COMMA renaming { $$ = lapp($1,$3); }
488 renaming: var TO var { $$ = ldub($1,$3); }
489 | con TO con { $$ = ldub($1,$3); }
492 maybeiimports : /* empty */ { $$ = mknullbind(); }
493 | iimports SEMI { $$ = $1; }
496 iimports : iimports SEMI iimport { $$ = mkabind($1,$3); }
497 | iimport { $$ = $1; }
500 iimport : importkey modid OPAREN import_list CPAREN
501 { $$ = mkmbind($2,$4,Lnil,startlineno); }
502 | importkey modid OPAREN import_list CPAREN RENAMING renamings
503 { $$ = mkmbind($2,$4,$7,startlineno); }
510 strcpy(iface_name, id_to_string($2));
514 /* WDP: not only do we not check the module name
515 but we take the one in the interface to be what we really want
516 -- we need this for Prelude jiggery-pokery. (Blech. KH)
517 ToDo: possibly revert....
518 checkmodname(modname,id_to_string($2));
525 ibody : ocurly maybeiimports maybefixes itopdecls ccurly
529 | ocurly iimports ccurly
533 | vocurly maybeiimports maybefixes itopdecls vccurly
537 | vocurly iimports vccurly
543 maybefixes: /* empty */
548 fixes : fixes SEMI fix
553 { Precedence = checkfixity($2); Fixity = INFIXL; }
556 { Precedence = checkfixity($2); Fixity = INFIXR; }
559 { Precedence = checkfixity($2); Fixity = INFIX; }
562 { Fixity = INFIXL; Precedence = 9; }
565 { Fixity = INFIXR; Precedence = 9; }
568 { Fixity = INFIX; Precedence = 9; }
572 ops : op { makeinfix(id_to_string($1),Fixity,Precedence); }
573 | ops COMMA op { makeinfix(id_to_string($3),Fixity,Precedence); }
576 topdecls: topdecls SEMI topdecl
596 topdecl : typed { $$ = $1; }
598 | classd { $$ = $1; }
600 | defaultd { $$ = $1; }
604 typed : typekey simple EQUAL type { $$ = mknbind($2,$4,startlineno,mkno_pramga()); }
608 datad : datakey context DARROW simple EQUAL constrs
609 { $$ = mktbind($2,$4,$6,all,startlineno,mkno_pragma()); }
610 | datakey simple EQUAL constrs
611 { $$ = mktbind(Lnil,$2,$4,all,startlineno,mkno_pragma()); }
612 | datakey context DARROW simple EQUAL constrs DERIVING tyclses
613 { $$ = mktbind($2,$4,$6,$8,startlineno,mkno_pragma()); }
614 | datakey simple EQUAL constrs DERIVING tyclses
615 { $$ = mktbind(Lnil,$2,$4,$6,startlineno,mkno_pragma()); }
618 classd : classkey context DARROW class cbody { $$ = mkcbind($2,$4,$5,startlineno,Lnil); }
619 | classkey class cbody { $$ = mkcbind(Lnil,$2,$3,startlineno,Lnil); }
622 cbody : /* empty */ { $$ = mknullbind(); }
623 | WHERE ocurly decls ccurly { checkorder($3); $$ = $3; }
624 | WHERE vocurly decls vccurly { checkorder($3); $$ =$3; }
628 instd : instkey context DARROW tycls inst rinst { $$ = mkibind($2,$4,$5,$6,startlineno,Lnil); }
629 | instkey tycls inst rinst { $$ = mkibind(Lnil,$2,$3,$4,startlineno,Lnil); }
632 rinst : /* empty */ { $$ = mknullbind(); }
633 | WHERE ocurly valdefs ccurly { $$ = $3; }
634 | WHERE vocurly valdefs vccurly { $$ = $3; }
637 inst : tycon { $$ = mktname($1,Lnil); }
638 | OPAREN simple_long CPAREN { $$ = $2; }
639 /* partain?: "simple" requires k >= 0, not k > 0 (hence "simple_long" hack) */
640 | OPAREN tyvar_list CPAREN { $$ = mkttuple($2); }
641 | OPAREN CPAREN { $$ = mkttuple(Lnil); }
642 | OBRACK tyvar CBRACK { $$ = mktllist($2); }
643 | OPAREN tyvar RARROW tyvar CPAREN { $$ = mktfun($2,$4); }
644 | OPOD tyvar CPOD { $$ = mktpod($2); }
645 | OPROC tyvar_pids SEMI tyvar CPROC { $$ = mktproc($2,$4); }
646 | OPOD tyvar_pids SEMI tyvar CPOD { $$ = mktpod(mktproc($2,$4));}
647 | OPOD OPROC tyvar_pids SEMI tyvar CPROC CPOD
648 { $$ = mktpod(mktproc($3,$5)); }
651 /* Note (hilly) : Similar to tyvar_list except k>=1 not k>=2 */
653 tyvar_pids : tyvar COMMA tyvar_pids { $$ = mklcons($1,$3); }
654 | tyvar { $$ = lsing($1); }
657 defaultd: defaultkey dtypes
659 $$ = mkdbind($2,startlineno);
663 dtypes : OPAREN type COMMA types CPAREN { $$ = mklcons($2,$4); }
664 | ttype { $$ = lsing($1); }
665 /* Omitting this forces () to be the *type* (), which never defaults. This is a KLUDGE */
666 /* | OPAREN CPAREN { $$ = Lnil; }*/
669 decls : decls SEMI decl
682 /* partain: this "DCOLON context" vs "DCOLON type" is a problem,
683 because you can't distinguish between
685 foo :: (Baz a, Baz a)
686 bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
688 with one token of lookahead. The HACK is to have "DCOLON ttype"
689 [tuple type] in the first case, then check that it has the right
690 form C a, or (C1 a, C2 b, ... Cn z) and convert it into a
695 decl : vars DCOLON type DARROW type iclasop_pragma
696 { /* type2context.c for code */
697 $$ = mksbind($1,mkcontext(type2context($3),$5),startlineno,$6);
704 | /* empty */ { $$ = mknullbind(); PREVPATT = NULL; FN = NULL; SAMEFN = 0; }
707 sign : vars DCOLON type iclasop_pragma
709 $$ = mksbind($1,$3,startlineno,$4);
718 itopdecls : itopdecls SEMI itopdecl { $$ = mkabind($1,$3); }
719 | itopdecl { $$ = $1; }
722 itopdecl: ityped { $$ = $1; }
723 | idatad { $$ = $1; }
724 | iclassd { $$ = $1; }
725 | iinstd { $$ = $1; }
726 | ivarsd { $$ = $1; }
727 | /* empty */ { $$ = mknullbind(); }
730 /* partain: see comment elsewhere about why "type", not "context" */
731 ivarsd : vars DCOLON type DARROW type ival_pragma
732 { $$ = mksbind($1,mkcontext(type2context($3),$5),startlineno,$6); }
733 | vars DCOLON type ival_pragma
734 { $$ = mksbind($1,$3,startlineno,$4); }
737 ityped : typekey simple EQUAL type itype_pragma { $$ = mknbind($2,$4,startlineno,$5); }
740 idatad : datakey context DARROW simple idata_pragma { $$ = mktbind($2,$4,Lnil,Lnil,startlineno,$5); }
741 | datakey simple idata_pragma { $$ = mktbind(Lnil,$2,Lnil,Lnil,startlineno,$3); }
742 | datakey context DARROW simple EQUAL constrs { $$ = mktbind($2,$4,$6,Lnil,startlineno,mk_nopragma()); }
743 | datakey simple EQUAL constrs { $$ = mktbind(Lnil,$2,$4,Lnil,startlineno,mk_nopragma()); }
744 | datakey context DARROW simple EQUAL constrs DERIVING tyclses { $$ = mktbind($2,$4,$6,$8,startlineno,mk_nopragma()); }
745 | datakey simple EQUAL constrs DERIVING tyclses { $$ = mktbind(Lnil,$2,$4,$6,startlineno,mk_nopragma()); }
749 iclassd : classkey context DARROW class cbody pragmas
750 { $$ = mkcbind($2,$4,$5,startlineno,$6); }
751 | classkey class cbody pragmas
752 { $$ = mkcbind(Lnil,$2,$3,startlineno,$4); }
755 iinstd : instkey context DARROW tycls inst pragmas
756 { $$ = mkibind($2,$4,$5,mknullbind(),startlineno,$6); }
757 | instkey tycls inst pragmas
758 { $$ = mkibind(Lnil,$2,$3,mknullbind(),startlineno,$4); }
762 /* obsolete: "(C a, ...)" cause r/r conflict, resolved in favour of context rather than type */
764 class : tycon tyvar { $$ = mktname($1,lsing($2)); }
765 /* partain: changed "tycls" to "tycon" */
768 types : types COMMA type { $$ = lapp($1,$3); }
769 | type { $$ = lsing($1); }
772 type : btype { $$ = $1; }
773 | btype RARROW type { $$ = mktfun($1,$3); }
775 btype : atype { $$ = $1; }
776 | tycon atypes { $$ = mktname($1,$2); }
779 atypes : atypes atype { $$ = lapp($1,$2); }
780 | atype { $$ = lsing($1); }
783 /* The split with ntatype allows us to use the same syntax for defaults as for types */
784 ttype : ntatype { $$ = $1; }
785 | btype RARROW type { $$ = mktfun($1,$3); }
786 | tycon atypes { $$ = mktname($1,$2); }
790 | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
793 ntatype : tyvar { $$ = $1; }
794 | tycon { $$ = mktname($1,Lnil); }
795 | OPAREN CPAREN { $$ = mkttuple(Lnil); }
796 | OPAREN type CPAREN { $$ = $2; }
797 | OBRACK type CBRACK { $$ = mktllist($2); }
798 | OPOD type CPOD { $$ = mktpod($2); }
799 | OPROC types SEMI type CPROC { $$ = mktproc($2,$4); }
800 | OPOD types SEMI type CPOD { $$ = mktpod(mktproc($2,$4));}
804 simple : tycon { $$ = mktname($1,Lnil); }
805 | tycon tyvars { $$ = mktname($1,$2); }
809 simple_long : tycon tyvars { $$ = mktname($1,$2); }
810 ; /* partain: see comment in "inst" */
813 constrs : constrs VBAR constr { $$ = lapp($1,$3); }
814 | constr { $$ = lsing($1); }
817 /* Using tycon rather than con avoids 5 S/R errors */
818 constr : tycon atypes { $$ = mkatc($1,$2,hsplineno); }
819 | OPAREN consym CPAREN atypes { $$ = mkatc($2,$4,hsplineno); }
820 | tycon { $$ = mkatc($1,Lnil,hsplineno); }
821 | OPAREN consym CPAREN { $$ = mkatc($2,Lnil,hsplineno); }
822 | btype conop btype { $$ = mkatc($2, ldub($1,$3), hsplineno); }
825 tyclses : OPAREN tycls_list CPAREN { $$ = $2; }
826 | OPAREN CPAREN { $$ = Lnil; }
827 | tycls { $$ = lsing($1); }
830 tycls_list: tycls COMMA tycls_list { $$ = mklcons($1,$3); }
831 | tycls { $$ = lsing($1); }
834 context : OPAREN context_list CPAREN { $$ = $2; }
835 | class { $$ = lsing($1); }
838 context_list: class COMMA context_list { $$ = mklcons($1,$3); }
839 | class { $$ = lsing($1); }
842 valdefs : valdefs SEMI valdef
852 | valdef { $$ = $1; }
853 | /* empty */ { $$ = mknullbind(); }
857 vars : vark COMMA varsrest { $$ = mklcons($1,$3); }
858 | vark { $$ = lsing($1); }
861 varsrest: varsrest COMMA var { $$ = lapp($1,$3); }
862 | var { $$ = lsing($1); }
865 cons : cons COMMA con { $$ = lapp($1,$3); }
866 | con { $$ = lsing($1); }
872 tree fn = function($1);
876 if(ttree(fn) == ident)
878 checksamefn(gident(fn));
882 else if (ttree(fn) == tinfixop && ttree(ginfun((struct Sap *) fn)) == ident)
884 checksamefn(gident(ginfun((struct Sap *) fn)));
885 FN = ginfun((struct Sap *) fn);
889 printf("%u\n",startlineno);
895 $$ = mkpbind($3, startlineno);
900 $$ = mkfbind($3,startlineno);
906 valrhs : valrhs1 maybe_where { $$ = lsing(createpat($1, $2)); }
910 | EQUAL exp { $$ = lsing(mktruecase($2)); }
913 gdrhs : gd EQUAL exp { $$ = lsing(ldub($1,$3)); }
914 | gd EQUAL exp gdrhs { $$ = mklcons(ldub($1,$3),$4); }
918 WHERE ocurly decls ccurly { $$ = $3; }
919 | WHERE vocurly decls vccurly { $$ = $3; }
920 | /* empty */ { $$ = mknullbind(); }
923 gd : VBAR oexp { $$ = $2; }
927 lampats : apat lampats { $$ = mklcons($1,$2); }
928 | apat { $$ = lsing($1); }
933 Changed as above to allow for contexts!
938 exp : oexp DCOLON type DARROW type { $$ = mkrestr($1,mkcontext(type2context($3),$5)); }
939 | oexp DCOLON type { $$ = mkrestr($1,$3); }
944 Operators must be left-associative at the same precedence
945 for prec. parsing to work.
948 /* Infix operator application */
950 | oexp op oexp %prec PLUS
951 { $$ = mkinfixop($2,$1,$3); precparse($$); }
955 This comes here because of the funny precedence rules concerning
960 dexp : MINUS kexp { $$ = mknegate($2); }
965 let/if/lambda/case have higher precedence than infix operators.
969 { /* enteriscope(); /? I don't understand this -- KH */
970 hsincindent(); /* added by partain; push new context for */
971 /* FN = NULL; not actually concerned about */
972 FN = NULL; /* indenting */
973 $<uint>$ = hsplineno; /* remember current line number */
976 { hsendindent(); /* added by partain */
977 /* exitiscope(); /? Also not understood */
979 RARROW exp /* lambda abstraction */
981 $$ = mklambda($3, $6, $<uint>2);
985 | LET ocurly decls ccurly IN exp { $$ = mklet($3,$6); }
986 | LET vocurly decls vccurly IN exp { $$ = mklet($3,$6); }
989 | IF exp THEN exp ELSE exp { $$ = mkife($2,$4,$6); }
991 /* Case Expression */
992 | CASE exp OF ocurly alts ccurly { $$ = mkcasee($2,$5); }
993 | CASE exp OF vocurly alts vccurly { $$ = mkcasee($2,$5); }
995 /* CCALL/CASM Expression */
996 | CCALL ccallid cexp { $$ = mkccall($2,installid("n"),$3); }
997 | CCALL ccallid { $$ = mkccall($2,installid("n"),Lnil); }
998 | CCALL_DANGEROUS ccallid cexp { $$ = mkccall($2,installid("p"),$3); }
999 | CCALL_DANGEROUS ccallid { $$ = mkccall($2,installid("p"),Lnil); }
1000 | CASM CLITLIT cexp { $$ = mkccall($2,installid("N"),$3); }
1001 | CASM CLITLIT { $$ = mkccall($2,installid("N"),Lnil); }
1002 | CASM_DANGEROUS CLITLIT cexp { $$ = mkccall($2,installid("P"),$3); }
1003 | CASM_DANGEROUS CLITLIT { $$ = mkccall($2,installid("P"),Lnil); }
1005 /* SCC Expression */
1007 { extern BOOLEAN ignoreSCC;
1008 extern BOOLEAN warnSCC;
1009 extern char * input_filename;
1014 "\"%s\", line %d: scc (`set [profiling] cost centre') ignored\n",
1015 input_filename, hsplineno);
1026 /* Function application */
1027 fexp : fexp aexp { $$ = mkap($1,$2); }
1031 cexp : cexp aexp { $$ = lapp($1,$2); }
1032 | aexp { $$ = lsing($1); }
1037 The mkpars are so that infix parsing doesn't get confused.
1042 /* Simple Expressions */
1043 aexp : var { $$ = mkident($1); }
1044 | con { $$ = mkident($1); }
1046 | OPAREN exp CPAREN { $$ = mkpar($2); }
1047 | OPAREN oexp op CPAREN { checkprec($2,$3,FALSE); $$ = mklsection($2,$3); }
1048 | OPAREN op1 oexp CPAREN { checkprec($3,$2,TRUE); $$ = mkrsection($2,$3); }
1052 | list { $$ = mkpar($1); }
1053 | sequence { $$ = mkpar($1); }
1054 | comprehension { $$ = mkpar($1); }
1055 | OPOD exp VBAR parquals CPOD { $$ = mkparzf($2,$4); }
1056 | OPOD exps CPOD { $$ = mkpod($2); }
1057 | processor { $$ = mkpar($1); }
1059 /* These only occur in patterns */
1060 | var AT aexp { checkinpat(); $$ = mkas($1,$3); }
1061 | WILDCARD { checkinpat(); $$ = mkwildp(); }
1062 | LAZY aexp { checkinpat(); $$ = mklazyp($2); }
1066 processor : OPROC exps SEMI exp CPROC { $$ = mkproc($2,$4); }
1069 parquals : parquals COMMA parqual { $$ = lapp($1,$3); }
1070 | parqual { $$ = lsing($1); }
1073 parqual : exp { $$ = mkparfilt($1); }
1074 | processor DRAWNFROM exp
1075 { $$ = mkpardgen($1,$3);
1078 | processor INDEXFROM exp
1079 { $$ = mkparigen($1,$3);
1080 checkpatt(gprocdata($1));
1086 LHS patterns are parsed in a similar way to
1087 expressions. This avoids the horrible non-LRness
1088 which occurs with the 1.1 syntax.
1090 The xpatk business is to do with accurately recording
1091 the starting line for definitions.
1097 { $$ = mkap($1,$2); }
1098 | opatk varop opat %prec PLUS
1100 $$ = mkinfixop($2,$1,$3);
1105 | opatk conop opat %prec PLUS
1107 $$ = mkinfixop($2,$1,$3);
1115 | opatk op opat %prec PLUS
1117 $$ = mkinfixop($2,$1,$3);
1119 if(isconstr(id_to_string($2)))
1123 checkprec($1,$2,FALSE); /* Check the precedence of the left pattern */
1124 checkprec($3,$2,TRUE); /* then check the right pattern */
1130 | opat op opat %prec PLUS
1132 $$ = mkinfixop($2,$1,$3);
1134 if(isconstr(id_to_string($2)))
1138 checkprec($1,$2,FALSE); /* Check the precedence of the left pattern */
1139 checkprec($3,$2,TRUE); /* then check the right pattern */
1145 This comes here because of the funny precedence rules concerning
1150 dpat : MINUS fpat { $$ = mknegate($2); }
1154 /* Function application */
1155 fpat : fpat aapat { $$ = mkap($1,$2); }
1159 dpatk : minuskey fpat { $$ = mknegate($2); }
1163 /* Function application */
1164 fpatk : fpatk aapat { $$ = mkap($1,$2); }
1168 aapat : con { $$ = mkident($1); }
1169 | var { $$ = mkident($1); }
1170 | var AT apat { $$ = mkas($1,$3); }
1171 | literal { $$ = $1; }
1172 | WILDCARD { $$ = mkwildp(); }
1173 | OPAREN CPAREN { $$ = mktuple(Lnil); }
1174 | OPAREN var PLUS INTEGER CPAREN { $$ = mkplusp(mkident($2),mkinteger($4)); }
1175 | OPAREN WILDCARD PLUS INTEGER CPAREN { $$ = mkplusp(mkwildp(),mkinteger($4)); }
1176 | OPAREN opat CPAREN { $$ = mkpar($2); }
1177 | OPAREN opat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1178 | OBRACK pats CBRACK { $$ = mkllist($2); }
1179 | OBRACK CBRACK { $$ = mkllist(Lnil); }
1180 | LAZY apat { $$ = mklazyp($2); }
1181 | OPROC pats SEMI apat CPROC { $$ = mkproc($2,$4); }
1184 aapatk : conk { $$ = mkident($1); }
1185 | vark { $$ = mkident($1); }
1186 | vark AT apat { $$ = mkas($1,$3); }
1187 | literal { $$ = $1; setstartlineno(); }
1188 | WILDCARD { $$ = mkwildp(); setstartlineno(); }
1189 | oparenkey CPAREN { $$ = mktuple(Lnil); }
1190 | oparenkey var PLUS INTEGER CPAREN { $$ = mkplusp(mkident($2),mkinteger($4)); }
1191 | oparenkey WILDCARD PLUS INTEGER CPAREN { $$ = mkplusp(mkwildp(),mkinteger($4)); }
1192 | oparenkey opat CPAREN { $$ = mkpar($2); }
1193 | oparenkey opat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1194 | obrackkey pats CBRACK { $$ = mkllist($2); }
1195 | obrackkey CBRACK { $$ = mkllist(Lnil); }
1196 | lazykey apat { $$ = mklazyp($2); }
1197 | oprockey pats SEMI opat CPROC { $$ = mkproc($2,$4); }
1202 The mkpars are so that infix parsing doesn't get confused.
1207 tuple : OPAREN exp COMMA texps CPAREN
1208 { if (ttree($4) == tuple)
1209 $$ = mktuple(mklcons($2, gtuplelist($4)));
1211 $$ = mktuple(ldub($2, $4));
1214 { $$ = mktuple(Lnil); }
1217 texps : exp COMMA texps
1218 { if (ttree($3) == tuple)
1219 $$ = mktuple(mklcons($1, gtuplelist($3)));
1221 $$ = mktuple(ldub($1, $3));
1223 | exp { $$ = mkpar($1); }
1227 list : OBRACK CBRACK { $$ = mkllist(Lnil); }
1228 | OBRACK exps CBRACK { $$ = mkllist($2); }
1231 exps : exp COMMA exps { $$ = mklcons($1,$3); }
1232 | exp { $$ = lsing($1); }
1236 sequence: OBRACK exp COMMA exp DOTDOT upto CBRACK {$$ = mkeenum($2,lsing($4),$6);}
1237 | OBRACK exp DOTDOT upto CBRACK { $$ = mkeenum($2,Lnil,$4); }
1240 comprehension: OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); }
1243 quals : quals COMMA qual { $$ = lapp($1,$3); }
1244 | qual { $$ = lsing($1); }
1247 qual : { inpat = TRUE; } exp { inpat = FALSE; } qualrest
1255 tree prevpatt_save = PREVPATT;
1257 $$ = mkdef(mkpbind(lsing(createpat(lsing(mktruecase((tree)(ggdef($4)))),mknullbind())),hsplineno));
1258 PREVPATT = prevpatt_save;
1266 qualrest: LARROW exp { $$ = $2; }
1269 { if(nonstandardFlag)
1272 hsperror("Definitions in comprehensions are not standard Haskell");
1275 | /* empty */ { $$ = NULL; }
1279 alts : alts SEMI alt { $$ = lconc($1,$3); }
1289 | /* empty */ { $$ = Lnil; }
1292 altrest : gdpat maybe_where { $$ = lsing(createpat($1,$2)); }
1293 | RARROW exp maybe_where { $$ = lsing(createpat(lsing(mktruecase($2)),$3)); }
1296 gdpat : gd RARROW exp gdpat { $$ = mklcons(ldub($1,$3),$4); }
1297 | gd RARROW exp { $$ = lsing(ldub($1,$3)); }
1300 upto : /* empty */ { $$ = Lnil; }
1301 | exp { $$ = lsing($1); }
1304 pats : pat COMMA pats { $$ = mklcons($1,$3); }
1305 | pat { $$ = lsing($1); }
1309 | pat conop bpat { $$ = mkinfixop($2,$1,$3); precparse($$); }
1314 | MINUS INTEGER { $$ = mkinteger(ineg($2)); }
1315 | MINUS FLOAT { $$ = mkfloatr(ineg($2)); }
1318 conpat : con { $$ = mkident($1); }
1319 | conpat apat { $$ = mkap($1,$2); }
1322 apat : con { $$ = mkident($1); }
1326 apatc : var { $$ = mkident($1); }
1327 | var AT apat { $$ = mkas($1,$3); }
1328 | literal { $$ = $1; }
1329 | WILDCARD { $$ = mkwildp(); }
1330 | OPAREN CPAREN { $$ = mktuple(Lnil); }
1331 | OPAREN var PLUS INTEGER CPAREN { $$ = mkplusp(mkident($2),mkinteger($4)); }
1332 | OPAREN WILDCARD PLUS INTEGER CPAREN { $$ = mkplusp(mkwildp(),mkinteger($4)); }
1333 | OPAREN pat CPAREN { $$ = mkpar($2); }
1334 | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1335 | OBRACK pats CBRACK { $$ = mkllist($2); }
1336 | OBRACK CBRACK { $$ = mkllist(Lnil); }
1337 | LAZY apat { $$ = mklazyp($2); }
1338 | OPROC pats SEMI apat CPROC { $$ = mkproc($2,$4); }
1343 | patk conop bpat { $$ = mkinfixop($2,$1,$3); precparse($$); }
1348 | minuskey INTEGER { $$ = mkinteger(ineg($2)); }
1349 | minuskey FLOAT { $$ = mkfloatr(ineg($2)); }
1352 conpatk : conk { $$ = mkident($1); }
1353 | conpatk apat { $$ = mkap($1,$2); }
1356 apatck : vark { $$ = mkident($1); }
1357 | vark AT apat { $$ = mkas($1,$3); }
1358 | literal { $$ = $1; setstartlineno(); }
1359 | WILDCARD { $$ = mkwildp(); setstartlineno(); }
1360 | oparenkey CPAREN { $$ = mktuple(Lnil); }
1361 | oparenkey var PLUS INTEGER CPAREN { $$ = mkplusp(mkident($2),mkinteger($4)); }
1362 | oparenkey WILDCARD PLUS INTEGER CPAREN { $$ = mkplusp(mkwildp(),mkinteger($4)); }
1363 | oparenkey pat CPAREN { $$ = mkpar($2); }
1364 | oparenkey pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1365 | obrackkey pats CBRACK { $$ = mkllist($2); }
1366 | obrackkey CBRACK { $$ = mkllist(Lnil); }
1367 | lazykey apat { $$ = mklazyp($2); }
1368 | oprockey pats SEMI opat CPROC { $$ = mkproc($2,$4); }
1372 literal : INTEGER { $$ = mkinteger($1); }
1373 | FLOAT { $$ = mkfloatr($1); }
1374 | CHAR { $$ = mkcharr($1); }
1375 | STRING { $$ = mkstring($1); }
1376 | CHARPRIM { $$ = mkcharprim($1); }
1377 | INTPRIM { $$ = mkintprim($1); }
1378 | FLOATPRIM { $$ = mkfloatprim($1); }
1379 | DOUBLEPRIM { $$ = mkdoubleprim($1); }
1380 | CLITLIT { $$ = mkclitlit($1); }
1381 | VOIDPRIM { $$ = mkvoidprim(); }
1385 /* Keywords which record the line start */
1387 importkey: IMPORT { setstartlineno(); }
1390 datakey : DATA { setstartlineno();
1392 printf("%u\n",startlineno);
1396 typekey : TYPE { setstartlineno();
1398 printf("%u\n",startlineno);
1402 instkey : INSTANCE { setstartlineno();
1404 printf("%u\n",startlineno);
1408 defaultkey: DEFAULT { setstartlineno(); }
1411 classkey: CLASS { setstartlineno();
1413 printf("%u\n",startlineno);
1417 minuskey: MINUS { setstartlineno(); }
1420 oparenkey: OPAREN { setstartlineno(); }
1423 obrackkey: OBRACK { setstartlineno(); }
1426 lazykey : LAZY { setstartlineno(); }
1429 oprockey: OPROC { setstartlineno(); }
1433 /* Non "-" op, used in right sections -- KH */
1443 | BQUOTE varid BQUOTE { $$ = $2; }
1446 /* Non-minus varop, used in right sections */
1449 | BQUOTE varid BQUOTE { $$ = $2; }
1453 | BQUOTE conid BQUOTE { $$ = $2; }
1464 minus : MINUS { $$ = install_literal("-"); }
1467 plus : PLUS { $$ = install_literal("+"); }
1471 | OPAREN varsym CPAREN { $$ = $2; }
1474 vark : VARID { setstartlineno(); $$ = $1; }
1475 | oparenkey varsym CPAREN { $$ = $2; }
1478 /* tycon used here to eliminate 11 spurious R/R errors -- KH */
1480 | OPAREN consym CPAREN { $$ = $2; }
1483 conk : tycon { setstartlineno(); $$ = $1; }
1484 | oparenkey consym CPAREN { $$ = $2; }
1497 /* partain: "tyvar_list" must be at least 2 elements long (defn of "inst") */
1498 tyvar_list: tyvar COMMA tyvar_list { $$ = mklcons($1,$3); }
1499 | tyvar COMMA tyvar { $$ = mklcons($1,lsing($3)); }
1502 tyvars : tyvar tyvars { $$ = mklcons($1,$2); }
1503 | tyvar { $$ = lsing($1); }
1506 tyvar : VARID { $$ = mknamedtvar($1); }
1510 /* partain: "aconid"->"tycon" got rid of a r/r conflict
1511 (and introduced >= 2 s/r's ...)
1522 ocurly : layout OCURLY { hsincindent(); }
1524 vocurly : layout { hssetindent(); }
1527 layout : { hsindentoff(); }
1533 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1538 vccurly : { expect_ccurly = 1; } vccurly1 { expect_ccurly = 0; }
1544 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1550 FN = NULL; SAMEFN = 0; PREVPATT = NULL;