1 /**************************************************************************
4 * Author: Maria M. Gutierrez *
5 * Modified by: Kevin Hammond *
6 * Last date revised: December 13 1991. KH. *
7 * Modification: Haskell 1.1 Syntax. *
10 * Description: This file contains the LALR(1) grammar for Haskell. *
12 * Entry Point: module *
14 * Problems: None known. *
17 * LALR(1) Syntax for Haskell 1.2 *
19 **************************************************************************/
31 #include "constants.h"
34 /**********************************************************************
37 * Imported Variables and Functions *
40 **********************************************************************/
42 static BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */
45 extern char *input_filename;
46 static char *the_module_name;
47 static maybe module_exports;
52 /* For FN, PREVPATT and SAMEFN macros */
54 extern BOOLEAN samefn[];
55 extern tree prevpatt[];
56 extern short icontexts;
59 extern int hsplineno, hspcolno;
60 extern int modulelineno;
61 extern int startlineno;
64 /**********************************************************************
67 * Fixity and Precedence Declarations *
70 **********************************************************************/
72 static int Fixity = 0, Precedence = 0;
74 char *ineg PROTO((char *));
76 long source_version = 0;
101 /**********************************************************************
104 * These are lexemes. *
107 **********************************************************************/
110 %token VARID CONID QVARID QCONID
111 VARSYM CONSYM QVARSYM QCONSYM
113 %token INTEGER FLOAT CHAR STRING
114 CHARPRIM STRINGPRIM INTPRIM FLOATPRIM
119 /**********************************************************************
125 **********************************************************************/
127 %token OCURLY CCURLY VCCURLY
128 %token COMMA SEMI OBRACK CBRACK
129 %token WILDCARD BQUOTE OPAREN CPAREN
132 /**********************************************************************
135 * Reserved Operators *
138 **********************************************************************/
140 %token DOTDOT DCOLON EQUAL LAMBDA
141 %token VBAR RARROW LARROW
142 %token AT LAZY DARROW
145 /**********************************************************************
148 * Reserved Identifiers *
151 **********************************************************************/
153 %token CASE CLASS DATA
154 %token DEFAULT DERIVING DO
155 %token ELSE IF IMPORT
156 %token IN INFIX INFIXL
157 %token INFIXR INSTANCE LET
158 %token MODULE NEWTYPE OF
159 %token THEN TYPE WHERE
162 %token CCALL CCALL_GC CASM CASM_GC
165 /**********************************************************************
168 * Special symbols/identifiers which need to be recognised *
171 **********************************************************************/
174 %token AS HIDING QUALIFIED
177 /**********************************************************************
180 * Special Symbols for the Lexer *
183 **********************************************************************/
185 %token INTERFACE_UPRAGMA SPECIALISE_UPRAGMA
186 %token INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
187 %token DEFOREST_UPRAGMA END_UPRAGMA
189 /**********************************************************************
192 * Precedences of the various tokens *
195 **********************************************************************/
200 SCC CASM CCALL CASM_GC CCALL_GC
202 %left VARSYM CONSYM QVARSYM QCONSYM
203 MINUS BQUOTE BANG DARROW
209 %left OCURLY OBRACK OPAREN
215 /**********************************************************************
218 * Type Declarations *
221 **********************************************************************/
224 %type <ulist> caserest alts alt quals
226 rbinds rpats list_exps
228 constrs constr1 fields
231 pats context context_list /* tyvar_list */
234 impdecls maybeimpdecls impdecl
235 maybefixes fixes fix ops
240 %type <umaybe> maybeexports impspec deriving
242 %type <uliteral> lit_constant
244 %type <utree> exp oexp dexp kexp fexp aexp rbind texps
245 expL oexpL kexpL expLno oexpLno dexpLno kexpLno
246 vallhs funlhs qual gd leftexp
247 pat bpat apat apatc conpat rpat
248 patk bpatk apatck conpatk
251 %type <uid> MINUS DARROW AS LAZY
252 VARID CONID VARSYM CONSYM
253 var con varop conop op
254 vark varid varsym varsym_nominus
257 %type <uqid> QVARID QCONID QVARSYM QCONSYM
258 qvarid qconid qvarsym qconsym
259 qvar qcon qvarop qconop qop
260 qvark qconk qtycon qtycls
261 gcon gconk gtycon itycon qop1 qvarop1
264 %type <ubinding> topdecl topdecls letdecls
265 typed datad newtd classd instd defaultd
266 decl decls valdef instdef instdefs
267 maybe_where cbody rinst type_and_maybe_id
269 %type <upbinding> valrhs1 altrest
271 %type <uttype> simple ctype type atype btype
275 /* gtyconapp0 gtyconapp1 ntyconapp0 ntyconapp1 btyconapp */
276 /* restrict_inst general_inst */
278 %type <uconstr> constr field
280 %type <ustring> FLOAT INTEGER INTPRIM
281 FLOATPRIM DOUBLEPRIM CLITLIT
283 %type <uhstring> STRING STRINGPRIM CHAR CHARPRIM
285 %type <uentid> export import
289 /**********************************************************************
292 * Start Symbol for the Parser *
295 **********************************************************************/
300 module : modulekey modid maybeexports
302 modulelineno = startlineno;
303 the_module_name = $2;
309 the_module_name = install_literal("Main");
310 module_exports = mknothing();
315 body : ocurly { setstartlineno(); } interface_pragma orestm
316 | vocurly interface_pragma vrestm
319 interface_pragma : /* empty */
320 | INTERFACE_UPRAGMA INTEGER END_UPRAGMA SEMI
322 source_version = atoi($2);
326 orestm : maybeimpdecls maybefixes topdecls ccurly
328 root = mkhmodule(the_module_name,$1,module_exports,
329 $2,$3,source_version,modulelineno);
333 root = mkhmodule(the_module_name,$1,module_exports,
334 Lnil,mknullbind(),source_version,modulelineno);
337 vrestm : maybeimpdecls maybefixes topdecls vccurly
339 root = mkhmodule(the_module_name,$1,module_exports,
340 $2,$3,source_version,modulelineno);
344 root = mkhmodule(the_module_name,$1,module_exports,
345 Lnil,mknullbind(),source_version,modulelineno);
348 maybeexports : /* empty */ { $$ = mknothing(); }
349 | OPAREN export_list CPAREN { $$ = mkjust($2); }
350 | OPAREN export_list COMMA CPAREN { $$ = mkjust($2); }
354 export { $$ = lsing($1); }
355 | export_list COMMA export { $$ = lapp($1, $3); }
358 export : qvar { $$ = mkentid($1); }
359 | gtycon { $$ = mkenttype($1); }
360 | gtycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
361 | gtycon OPAREN CPAREN { $$ = mkenttypenamed($1,Lnil); }
362 | gtycon OPAREN enames CPAREN { $$ = mkenttypenamed($1,$3); }
363 | MODULE modid { $$ = mkentmod($2); }
366 enames : ename { $$ = lsing($1); }
367 | enames COMMA ename { $$ = lapp($1,$3); }
374 maybeimpdecls : /* empty */ { $$ = Lnil; }
375 | impdecls SEMI { $$ = $1; }
378 impdecls: impdecl { $$ = $1; }
379 | impdecls SEMI impdecl { $$ = lconc($1,$3); }
383 impdecl : importkey modid impspec
384 { $$ = lsing(mkimport($2,0,mknothing(),$3,startlineno)); }
385 | importkey QUALIFIED modid impspec
386 { $$ = lsing(mkimport($3,1,mknothing(),$4,startlineno)); }
387 | importkey QUALIFIED modid AS modid impspec
388 { $$ = lsing(mkimport($3,1,mkjust($5),$6,startlineno)); }
391 impspec : /* empty */ { $$ = mknothing(); }
392 | OPAREN CPAREN { $$ = mkjust(mkleft(Lnil)); }
393 | OPAREN import_list CPAREN { $$ = mkjust(mkleft($2)); }
394 | OPAREN import_list COMMA CPAREN { $$ = mkjust(mkleft($2)); }
395 | HIDING OPAREN import_list CPAREN { $$ = mkjust(mkright($3)); }
396 | HIDING OPAREN import_list COMMA CPAREN { $$ = mkjust(mkright($3)); }
400 import { $$ = lsing($1); }
401 | import_list COMMA import { $$ = lapp($1, $3); }
404 import : var { $$ = mkentid(mknoqual($1)); }
405 | itycon { $$ = mkenttype($1); }
406 | itycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
407 | itycon OPAREN CPAREN { $$ = mkenttypenamed($1,Lnil);}
408 | itycon OPAREN inames CPAREN { $$ = mkenttypenamed($1,$3); }
411 itycon : tycon { $$ = mknoqual($1); }
412 | OBRACK CBRACK { $$ = creategid(-1); }
413 | OPAREN CPAREN { $$ = creategid(0); }
414 | OPAREN commas CPAREN { $$ = creategid($2); }
417 inames : iname { $$ = lsing($1); }
418 | inames COMMA iname { $$ = lapp($1,$3); }
420 iname : var { $$ = mknoqual($1); }
421 | con { $$ = mknoqual($1); }
424 /**********************************************************************
427 * Fixes and Decls etc *
430 **********************************************************************/
432 maybefixes: /* empty */ { $$ = Lnil; }
433 | fixes SEMI { $$ = $1; }
436 fixes : fix { $$ = $1; }
437 | fixes SEMI fix { $$ = lconc($1,$3); }
440 fix : INFIXL INTEGER { Precedence = checkfixity($2); Fixity = INFIXL; }
442 | INFIXR INTEGER { Precedence = checkfixity($2); Fixity = INFIXR; }
444 | INFIX INTEGER { Precedence = checkfixity($2); Fixity = INFIX; }
446 | INFIXL { Fixity = INFIXL; Precedence = 9; }
448 | INFIXR { Fixity = INFIXR; Precedence = 9; }
450 | INFIX { Fixity = INFIX; Precedence = 9; }
454 ops : op { $$ = lsing(mkfixop(mknoqual($1),infixint(Fixity),Precedence)); }
455 | ops COMMA op { $$ = lapp($1,mkfixop(mknoqual($3),infixint(Fixity),Precedence)); }
459 | topdecls SEMI topdecl
478 topdecl : typed { $$ = $1; }
481 | classd { $$ = $1; }
483 | defaultd { $$ = $1; }
487 typed : typekey simple EQUAL type { $$ = mknbind($2,$4,startlineno); }
491 datad : datakey simple EQUAL constrs deriving
492 { $$ = mktbind(Lnil,$2,$4,$5,startlineno); }
493 | datakey context DARROW simple EQUAL constrs deriving
494 { $$ = mktbind($2,$4,$6,$7,startlineno); }
497 newtd : newtypekey simple EQUAL constr1 deriving
498 { $$ = mkntbind(Lnil,$2,$4,$5,startlineno); }
499 | newtypekey context DARROW simple EQUAL constr1 deriving
500 { $$ = mkntbind($2,$4,$6,$7,startlineno); }
503 deriving: /* empty */ { $$ = mknothing(); }
504 | DERIVING dtyclses { $$ = mkjust($2); }
507 classd : classkey context DARROW class cbody
508 { $$ = mkcbind($2,$4,$5,startlineno); }
509 | classkey class cbody
510 { $$ = mkcbind(Lnil,$2,$3,startlineno); }
513 cbody : /* empty */ { $$ = mknullbind(); }
514 | WHERE ocurly decls ccurly { checkorder($3); $$ = $3; }
515 | WHERE vocurly decls vccurly { checkorder($3); $$ = $3; }
518 instd : instkey context DARROW gtycon atype rinst
519 { $$ = mkibind($2,$4,$5,$6,startlineno); }
520 | instkey gtycon atype rinst
521 { $$ = mkibind(Lnil,$2,$3,$4,startlineno); }
524 rinst : /* empty */ { $$ = mknullbind(); }
525 | WHERE ocurly instdefs ccurly { $$ = $3; }
526 | WHERE vocurly instdefs vccurly { $$ = $3; }
529 /* I now allow a general type in instance declarations, relying
530 on the type checker to reject instance decls which are ill-formed.
531 Some (non-standard) extensions of Haskell may allow more general
532 types than the Report syntax permits, and in any case not all things
533 can be checked in the syntax (eg repeated type variables).
536 restrict_inst : gtycon { $$ = mktname($1); }
537 | OPAREN gtyconvars CPAREN { $$ = $2; }
538 | OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); }
539 | OBRACK tyvar CBRACK { $$ = mktllist($2); }
540 | OPAREN tyvar RARROW tyvar CPAREN { $$ = mktfun($2,$4); }
543 general_inst : gtycon { $$ = mktname($1); }
544 | OPAREN gtyconapp1 CPAREN { $$ = $2; }
545 | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
546 | OBRACK type CBRACK { $$ = mktllist($2); }
547 | OPAREN btype RARROW type CPAREN { $$ = mktfun($2,$4); }
551 defaultd: defaultkey OPAREN types CPAREN { $$ = mkdbind($3,startlineno); }
552 | defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); }
569 Note: if there is an iclasop_pragma here, then we must be
570 doing a class-op in an interface -- unless the user is up
571 to real mischief (ugly, but likely to work).
574 decl : qvarsk DCOLON ctype
575 { $$ = mksbind($1,$3,startlineno);
576 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
579 /* User-specified pragmas come in as "signatures"...
580 They are similar in that they can appear anywhere in the module,
581 and have to be "joined up" with their related entity.
583 Have left out the case specialising to an overloaded type.
584 Let's get real, OK? (WDP)
586 | SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
588 $$ = mkvspec_uprag($2, $4, startlineno);
589 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
592 | SPECIALISE_UPRAGMA INSTANCE gtycon atype END_UPRAGMA
594 $$ = mkispec_uprag($3, $4, startlineno);
595 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
598 | SPECIALISE_UPRAGMA DATA gtycon atypes END_UPRAGMA
600 $$ = mkdspec_uprag($3, $4, startlineno);
601 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
604 | INLINE_UPRAGMA qvark END_UPRAGMA
606 $$ = mkinline_uprag($2, startlineno);
607 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
610 | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
612 $$ = mkmagicuf_uprag($2, $3, startlineno);
613 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
616 | DEFOREST_UPRAGMA qvark END_UPRAGMA
618 $$ = mkdeforest_uprag($2, startlineno);
619 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
622 /* end of user-specified pragmas */
625 | /* empty */ { $$ = mknullbind(); PREVPATT = NULL; FN = NULL; SAMEFN = 0; }
628 qvarsk : qvark COMMA qvars_list { $$ = mklcons($1,$3); }
629 | qvark { $$ = lsing($1); }
632 qvars_list: qvar { $$ = lsing($1); }
633 | qvars_list COMMA qvar { $$ = lapp($1,$3); }
636 types_and_maybe_ids :
637 type_and_maybe_id { $$ = lsing($1); }
638 | types_and_maybe_ids COMMA type_and_maybe_id { $$ = lapp($1,$3); }
642 type { $$ = mkvspec_ty_and_id($1,mknothing()); }
643 | type EQUAL qvark { $$ = mkvspec_ty_and_id($1,mkjust($3)); }
646 /**********************************************************************
652 **********************************************************************/
654 /* "DCOLON context => type" vs "DCOLON type" is a problem,
655 because you can't distinguish between
657 foo :: (Baz a, Baz a)
658 bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
660 with one token of lookahead. The HACK is to have "DCOLON ttype"
661 [tuple type] in the first case, then check that it has the right
662 form C a, or (C1 a, C2 b, ... Cn z) and convert it into a
666 /* 1 S/R conflict at DARROW -> shift */
667 ctype : type DARROW type { $$ = mkcontext(type2context($1),$3); }
671 /* 1 S/R conflict at RARROW -> shift */
672 type : btype { $$ = $1; }
673 | btype RARROW type { $$ = mktfun($1,$3); }
676 btype : atype { $$ = $1; }
677 | btype atype { $$ = mktapp($1,$2); }
680 atype : gtycon { $$ = mktname($1); }
682 | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
683 | OBRACK type CBRACK { $$ = mktllist($2); }
684 | OPAREN type CPAREN { $$ = $2; }
688 | OPAREN RARROW CPAREN { $$ = creategid(-2); }
689 | OBRACK CBRACK { $$ = creategid(-1); }
690 | OPAREN CPAREN { $$ = creategid(0); }
691 | OPAREN commas CPAREN { $$ = creategid($2); }
694 atypes : atype { $$ = lsing($1); }
695 | atypes atype { $$ = lapp($1,$2); }
698 types : type { $$ = lsing($1); }
699 | types COMMA type { $$ = lapp($1,$3); }
702 commas : COMMA { $$ = 1; }
703 | commas COMMA { $$ = $1 + 1; }
706 /**********************************************************************
709 * Declaration stuff *
712 **********************************************************************/
714 simple : gtycon { $$ = mktname($1); }
715 | gtyconvars { $$ = $1; }
718 gtyconvars: gtycon tyvar { $$ = mktapp(mktname($1),$2); }
719 | gtyconvars tyvar { $$ = mktapp($1,$2); }
722 context : OPAREN context_list CPAREN { $$ = $2; }
723 | class { $$ = lsing($1); }
726 context_list: class { $$ = lsing($1); }
727 | context_list COMMA class { $$ = lapp($1,$3); }
730 class : gtycon tyvar { $$ = mktapp(mktname($1),$2); }
733 constrs : constr { $$ = lsing($1); }
734 | constrs VBAR constr { $$ = lapp($1,$3); }
738 /* This stuff looks really baroque. I've replaced it with simpler stuff.
741 btyconapp { qid tyc; list tys;
742 splittyconapp($1, &tyc, &tys);
743 $$ = mkconstrpre(tyc,tys,hsplineno); }
744 | btyconapp qconop bbtype { checknobangs($1);
745 $$ = mkconstrinf($1,$2,$3,hsplineno); }
746 | ntyconapp0 qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
748 | BANG atype qconop bbtype { $$ = mkconstrinf(mktbang($2),$3,$4,hsplineno); }
749 | OPAREN qconsym CPAREN { $$ = mkconstrpre($2,Lnil,hsplineno); }
752 btype { qid tyc; list tys;
753 splittyconapp($1, &tyc, &tys);
754 $$ = mkconstrpre(tyc,tys,hsplineno); }
755 /* We have to parse the constructor application as a *type*, else we get
756 into terrible ambiguity problems. Consider the difference between
758 data T = S Int Int Int `R` Int
760 data T = S Int Int Int
762 It isn't till we get to the operator that we discover that the "S" is
763 part of a type in the first, but part of a constructor application in the
767 | OPAREN qconsym CPAREN batypes { $$ = mkconstrpre($2,$4,hsplineno); }
768 | bbtype qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
769 | gtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
770 /* 1 S/R conflict on OCURLY -> shift */
774 btyconapp: gtycon { $$ = mktname($1); }
775 | btyconapp batype { $$ = mktapp($1,$2); }
779 bbtype : btype { $$ = $1; }
780 | BANG atype { $$ = mktbang($2); }
783 batype : atype { $$ = $1; }
784 | BANG atype { $$ = mktbang($2); }
787 batypes : { $$ = Lnil; }
788 | batypes batype { $$ = lapp($1,$2); }
792 fields : field { $$ = lsing($1); }
793 | fields COMMA field { $$ = lapp($1,$3); }
796 field : qvars_list DCOLON type { $$ = mkfield($1,$3); }
797 | qvars_list DCOLON BANG atype { $$ = mkfield($1,mktbang($4)); }
800 constr1 : gtycon atype { $$ = lsing(mkconstrnew($1,$2,hsplineno)); }
804 dtyclses: OPAREN dtycls_list CPAREN { $$ = $2; }
805 | OPAREN CPAREN { $$ = Lnil; }
806 | qtycls { $$ = lsing($1); }
809 dtycls_list: qtycls { $$ = lsing($1); }
810 | dtycls_list COMMA qtycls { $$ = lapp($1,$3); }
813 instdefs : /* empty */ { $$ = mknullbind(); }
814 | instdef { $$ = $1; }
815 | instdefs SEMI instdef
827 /* instdef: same as valdef, except certain user-pragmas may appear */
829 SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
831 $$ = mkvspec_uprag($2, $4, startlineno);
832 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
835 | INLINE_UPRAGMA qvark END_UPRAGMA
837 $$ = mkinline_uprag($2, startlineno);
838 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
841 | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
843 $$ = mkmagicuf_uprag($2, $3, startlineno);
844 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
853 tree fn = function($1);
856 if(ttree(fn) == ident)
858 qid fun_id = gident((struct Sident *) fn);
863 else if (ttree(fn) == infixap)
865 qid fun_id = ginffun((struct Sinfixap *) fn);
872 printf("%u\n",startlineno);
874 fprintf(stderr,"%u\tvaldef\n",startlineno);
879 if ( lhs_is_patt($1) )
881 $$ = mkpbind($3, startlineno);
886 $$ = mkfbind($3,startlineno);
892 vallhs : patk { $$ = $1; }
893 | patk qvarop pat { $$ = mkinfixap($2,$1,$3); }
894 | funlhs { $$ = $1; }
897 funlhs : qvark apat { $$ = mkap(mkident($1),$2); }
898 | funlhs apat { $$ = mkap($1,$2); }
902 valrhs : valrhs1 maybe_where { $$ = lsing(createpat($1, $2)); }
905 valrhs1 : gdrhs { $$ = mkpguards($1); }
906 | EQUAL exp { $$ = mkpnoguards($2); }
909 gdrhs : gd EQUAL exp { $$ = lsing(mkpgdexp($1,$3)); }
910 | gd EQUAL exp gdrhs { $$ = mklcons(mkpgdexp($1,$3),$4); }
914 WHERE ocurly decls ccurly { $$ = $3; }
915 | WHERE vocurly decls vccurly { $$ = $3; }
916 | /* empty */ { $$ = mknullbind(); }
919 gd : VBAR oexp { $$ = $2; }
923 /**********************************************************************
929 **********************************************************************/
931 exp : oexp DCOLON ctype { $$ = mkrestr($1,$3); }
936 Operators must be left-associative at the same precedence for
937 precedence parsing to work.
939 /* 8 S/R conflicts on qop -> shift */
940 oexp : oexp qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
945 This comes here because of the funny precedence rules concerning
948 dexp : MINUS kexp { $$ = mknegate($2); }
953 We need to factor out a leading let expression so we can set
954 inpat=TRUE when parsing (non let) expressions inside stmts and quals
956 expLno : oexpLno DCOLON ctype { $$ = mkrestr($1,$3); }
959 oexpLno : oexpLno qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
962 dexpLno : MINUS kexp { $$ = mknegate($2); }
966 expL : oexpL DCOLON ctype { $$ = mkrestr($1,$3); }
969 oexpL : oexpL qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
974 let/if/lambda/case have higher precedence than infix operators.
981 kexpL : letdecls IN exp { $$ = mklet($1,$3); }
985 { hsincindent(); /* push new context for FN = NULL; */
986 FN = NULL; /* not actually concerned about indenting */
987 $<ulong>$ = hsplineno; /* remember current line number */
992 RARROW exp /* lambda abstraction */
994 $$ = mklambda($3, $6, $<ulong>2);
998 | IF {$<ulong>$ = hsplineno;}
999 exp THEN exp ELSE exp { $$ = mkife($3,$5,$7,$<ulong>2); }
1001 /* Case Expression */
1002 | CASE {$<ulong>$ = hsplineno;}
1003 exp OF caserest { $$ = mkcasee($3,$5,$<ulong>2); }
1006 | DO {$<ulong>$ = hsplineno;}
1007 dorest { $$ = mkdoe($3,$<ulong>2); }
1009 /* CCALL/CASM Expression */
1010 | CCALL ccallid cexps { $$ = mkccall($2,install_literal("n"),$3); }
1011 | CCALL ccallid { $$ = mkccall($2,install_literal("n"),Lnil); }
1012 | CCALL_GC ccallid cexps { $$ = mkccall($2,install_literal("p"),$3); }
1013 | CCALL_GC ccallid { $$ = mkccall($2,install_literal("p"),Lnil); }
1014 | CASM CLITLIT cexps { $$ = mkccall($2,install_literal("N"),$3); }
1015 | CASM CLITLIT { $$ = mkccall($2,install_literal("N"),Lnil); }
1016 | CASM_GC CLITLIT cexps { $$ = mkccall($2,install_literal("P"),$3); }
1017 | CASM_GC CLITLIT { $$ = mkccall($2,install_literal("P"),Lnil); }
1019 /* SCC Expression */
1030 fexp : fexp aexp { $$ = mkap($1,$2); }
1034 /* simple expressions */
1035 aexp : qvar { $$ = mkident($1); }
1036 | gcon { $$ = mkident($1); }
1037 | lit_constant { $$ = mklit($1); }
1038 | OPAREN exp CPAREN { $$ = mkpar($2); } /* mkpar: stop infix parsing at ()'s */
1039 | qcon OCURLY CCURLY { $$ = mkrecord($1,Lnil); }
1040 | qcon OCURLY rbinds CCURLY { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */
1041 | OBRACK list_exps CBRACK { $$ = mkllist($2); }
1042 | OPAREN exp COMMA texps CPAREN { if (ttree($4) == tuple)
1043 $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
1045 $$ = mktuple(ldub($2, $4)); }
1047 /* only in expressions ... */
1048 | aexp OCURLY rbinds CCURLY { $$ = mkrupdate($1,$3); }
1049 | OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); }
1050 | OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); }
1051 | OBRACK exp COMMA exp DOTDOT CBRACK { $$ = mkeenum($2,mkjust($4),mknothing()); }
1052 | OBRACK exp DOTDOT exp CBRACK { $$ = mkeenum($2,mknothing(),mkjust($4)); }
1053 | OBRACK exp DOTDOT CBRACK { $$ = mkeenum($2,mknothing(),mknothing()); }
1054 | OPAREN oexp qop CPAREN { $$ = mklsection($2,$3); }
1055 | OPAREN qop1 oexp CPAREN { $$ = mkrsection($2,$3); }
1057 /* only in patterns ... */
1058 /* these add 2 S/R conflict with with aexp . OCURLY rbinds CCURLY */
1059 | qvar AT aexp { checkinpat(); $$ = mkas($1,$3); }
1060 | LAZY aexp { checkinpat(); $$ = mklazyp($2); }
1061 | WILDCARD { checkinpat(); $$ = mkwildp(); }
1064 /* ccall arguments */
1065 cexps : cexps aexp { $$ = lapp($1,$2); }
1066 | aexp { $$ = lsing($1); }
1069 caserest: ocurly alts ccurly { $$ = $2; }
1070 | vocurly alts vccurly { $$ = $2; }
1072 dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; }
1073 | vocurly stmts vccurly { checkdostmts($2); $$ = $2; }
1076 rbinds : rbind { $$ = lsing($1); }
1077 | rbinds COMMA rbind { $$ = lapp($1,$3); }
1080 rbind : qvar { $$ = mkrbind($1,mknothing()); }
1081 | qvar EQUAL exp { $$ = mkrbind($1,mkjust($3)); }
1084 texps : exp { $$ = mkpar($1); } /* mkpar: so we don't flatten last element in tuple */
1086 { if (ttree($3) == tuple)
1087 $$ = mktuple(mklcons($1, gtuplelist((struct Stuple *) $3)));
1088 else if (ttree($3) == par)
1089 $$ = mktuple(ldub($1, gpare((struct Spar *) $3)));
1091 hsperror("hsparser:texps: panic");
1093 /* right recursion? WDP */
1098 exp { $$ = lsing($1); }
1099 | exp COMMA list_exps { $$ = mklcons($1, $3); }
1100 /* right recursion? (WDP)
1102 It has to be this way, though, otherwise you
1103 may do the wrong thing to distinguish between...
1105 [ e1 , e2 .. ] -- an enumeration ...
1106 [ e1 , e2 , e3 ] -- a list
1108 (In fact, if you change the grammar and throw yacc/bison
1109 at it, it *will* do the wrong thing [WDP 94/06])
1113 letdecls: LET ocurly decls ccurly { $$ = $3 }
1114 | LET vocurly decls vccurly { $$ = $3 }
1117 quals : qual { $$ = lsing($1); }
1118 | quals COMMA qual { $$ = lapp($1,$3); }
1121 qual : letdecls { $$ = mkseqlet($1); }
1123 | {inpat=TRUE;} expLno {inpat=FALSE;}leftexp
1125 expORpat(LEGIT_EXPR,$2);
1128 expORpat(LEGIT_PATT,$2);
1134 alts : alt { $$ = $1; }
1135 | alts SEMI alt { $$ = lconc($1,$3); }
1138 alt : pat { PREVPATT = $1; } altrest { $$ = lsing($3); PREVPATT = NULL; }
1139 | /* empty */ { $$ = Lnil; }
1142 altrest : gdpat maybe_where { $$ = createpat(mkpguards($1), $2); }
1143 | RARROW exp maybe_where { $$ = createpat(mkpnoguards($2),$3); }
1146 gdpat : gd RARROW exp { $$ = lsing(mkpgdexp($1,$3)); }
1147 | gd RARROW exp gdpat { $$ = mklcons(mkpgdexp($1,$3),$4); }
1150 stmts : stmt { $$ = $1; }
1151 | stmts SEMI stmt { $$ = lconc($1,$3); }
1154 stmt : /* empty */ { $$ = Lnil; }
1155 | letdecls { $$ = lsing(mkseqlet($1)); }
1156 | expL { $$ = lsing($1); }
1157 | {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
1159 expORpat(LEGIT_EXPR,$2);
1160 $$ = lsing(mkdoexp($2,endlineno));
1162 expORpat(LEGIT_PATT,$2);
1163 $$ = lsing(mkdobind($2,$4,endlineno));
1168 leftexp : LARROW exp { $$ = $2; }
1169 | /* empty */ { $$ = NULL; }
1172 /**********************************************************************
1178 **********************************************************************/
1180 pat : pat qconop bpat { $$ = mkinfixap($2,$1,$3); }
1186 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1187 | MINUS INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
1188 | MINUS FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
1191 conpat : gcon { $$ = mkident($1); }
1192 | conpat apat { $$ = mkap($1,$2); }
1195 apat : gcon { $$ = mkident($1); }
1196 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1200 apatc : qvar { $$ = mkident($1); }
1201 | qvar AT apat { $$ = mkas($1,$3); }
1202 | lit_constant { $$ = mklit($1); }
1203 | WILDCARD { $$ = mkwildp(); }
1204 | OPAREN pat CPAREN { $$ = mkpar($2); }
1205 | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1206 | OBRACK pats CBRACK { $$ = mkllist($2); }
1207 | LAZY apat { $$ = mklazyp($2); }
1211 INTEGER { $$ = mkinteger($1); }
1212 | FLOAT { $$ = mkfloatr($1); }
1213 | CHAR { $$ = mkcharr($1); }
1214 | STRING { $$ = mkstring($1); }
1215 | CHARPRIM { $$ = mkcharprim($1); }
1216 | STRINGPRIM { $$ = mkstringprim($1); }
1217 | INTPRIM { $$ = mkintprim($1); }
1218 | FLOATPRIM { $$ = mkfloatprim($1); }
1219 | DOUBLEPRIM { $$ = mkdoubleprim($1); }
1220 | CLITLIT /* yurble yurble */ { $$ = mkclitlit($1); }
1223 lampats : apat lampats { $$ = mklcons($1,$2); }
1224 | apat { $$ = lsing($1); }
1225 /* right recursion? (WDP) */
1228 pats : pat COMMA pats { $$ = mklcons($1, $3); }
1229 | pat { $$ = lsing($1); }
1230 /* right recursion? (WDP) */
1233 rpats : rpat { $$ = lsing($1); }
1234 | rpats COMMA rpat { $$ = lapp($1,$3); }
1237 rpat : qvar { $$ = mkrbind($1,mknothing()); }
1238 | qvar EQUAL pat { $$ = mkrbind($1,mkjust($3)); }
1242 patk : patk qconop bpat { $$ = mkinfixap($2,$1,$3); }
1248 | qconk OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1249 | minuskey INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
1250 | minuskey FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
1253 conpatk : gconk { $$ = mkident($1); }
1254 | conpatk apat { $$ = mkap($1,$2); }
1257 apatck : qvark { $$ = mkident($1); }
1258 | qvark AT apat { $$ = mkas($1,$3); }
1259 | lit_constant { $$ = mklit($1); setstartlineno(); }
1260 | WILDCARD { $$ = mkwildp(); setstartlineno(); }
1261 | oparenkey pat CPAREN { $$ = mkpar($2); }
1262 | oparenkey pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1263 | obrackkey pats CBRACK { $$ = mkllist($2); }
1264 | lazykey apat { $$ = mklazyp($2); }
1269 | OBRACK CBRACK { $$ = creategid(-1); }
1270 | OPAREN CPAREN { $$ = creategid(0); }
1271 | OPAREN commas CPAREN { $$ = creategid($2); }
1275 | obrackkey CBRACK { $$ = creategid(-1); }
1276 | oparenkey CPAREN { $$ = creategid(0); }
1277 | oparenkey commas CPAREN { $$ = creategid($2); }
1280 /**********************************************************************
1283 * Keywords which record the line start *
1286 **********************************************************************/
1288 importkey: IMPORT { setstartlineno(); }
1291 datakey : DATA { setstartlineno();
1294 printf("%u\n",startlineno);
1296 fprintf(stderr,"%u\tdata\n",startlineno);
1301 typekey : TYPE { setstartlineno();
1304 printf("%u\n",startlineno);
1306 fprintf(stderr,"%u\ttype\n",startlineno);
1311 newtypekey : NEWTYPE { setstartlineno();
1314 printf("%u\n",startlineno);
1316 fprintf(stderr,"%u\tnewtype\n",startlineno);
1321 instkey : INSTANCE { setstartlineno();
1324 printf("%u\n",startlineno);
1327 fprintf(stderr,"%u\tinstance\n",startlineno);
1332 defaultkey: DEFAULT { setstartlineno(); }
1335 classkey: CLASS { setstartlineno();
1338 printf("%u\n",startlineno);
1340 fprintf(stderr,"%u\tclass\n",startlineno);
1345 modulekey: MODULE { setstartlineno();
1348 printf("%u\n",startlineno);
1350 fprintf(stderr,"%u\tmodule\n",startlineno);
1355 oparenkey: OPAREN { setstartlineno(); }
1358 obrackkey: OBRACK { setstartlineno(); }
1361 lazykey : LAZY { setstartlineno(); }
1364 minuskey: MINUS { setstartlineno(); }
1368 /**********************************************************************
1371 * Basic qualified/unqualified ids/ops *
1374 **********************************************************************/
1377 | OPAREN qvarsym CPAREN { $$ = $2; }
1380 | OPAREN qconsym CPAREN { $$ = $2; }
1383 | BQUOTE qvarid BQUOTE { $$ = $2; }
1386 | BQUOTE qconid BQUOTE { $$ = $2; }
1392 /* Non "-" op, used in right sections */
1397 /* Non "-" varop, used in right sections */
1399 | varsym_nominus { $$ = mknoqual($1); }
1400 | BQUOTE qvarid BQUOTE { $$ = $2; }
1405 | OPAREN varsym CPAREN { $$ = $2; }
1407 con : tycon /* using tycon removes conflicts */
1408 | OPAREN CONSYM CPAREN { $$ = $2; }
1411 | BQUOTE varid BQUOTE { $$ = $2; }
1414 | BQUOTE CONID BQUOTE { $$ = $2; }
1420 qvark : qvarid { setstartlineno(); $$ = $1; }
1421 | oparenkey qvarsym CPAREN { $$ = $2; }
1423 qconk : qconid { setstartlineno(); $$ = $1; }
1424 | oparenkey qconsym CPAREN { $$ = $2; }
1426 vark : varid { setstartlineno(); $$ = $1; }
1427 | oparenkey varsym CPAREN { $$ = $2; }
1431 | varid { $$ = mknoqual($1); }
1434 | varsym { $$ = mknoqual($1); }
1437 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1440 | CONSYM { $$ = mknoqual($1); }
1443 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1446 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1449 varsym : varsym_nominus
1450 | MINUS { $$ = install_literal("-"); }
1453 /* AS HIDING QUALIFIED are valid varids */
1455 | AS { $$ = install_literal("as"); }
1456 | HIDING { $$ = install_literal("hiding"); }
1457 | QUALIFIED { $$ = install_literal("qualified"); }
1460 /* BANG are valid varsyms */
1461 varsym_nominus : VARSYM
1462 | BANG { $$ = install_literal("!"); }
1469 tyvar : varid { $$ = mknamedtvar(mknoqual($1)); }
1477 tyvar_list: tyvar { $$ = lsing($1); }
1478 | tyvar_list COMMA tyvar { $$ = lapp($1,$3); }
1482 /**********************************************************************
1485 * Stuff to do with layout *
1488 **********************************************************************/
1490 ocurly : layout OCURLY { hsincindent(); }
1492 vocurly : layout { hssetindent(); }
1495 layout : { hsindentoff(); }
1501 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1506 vccurly : { expect_ccurly = 1; } vccurly1 { expect_ccurly = 0; }
1512 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1518 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1525 /**********************************************************************
1527 * Error Processing and Reporting *
1529 * (This stuff is here in case we want to use Yacc macros and such.) *
1531 **********************************************************************/
1537 hsperror("pattern syntax used in expression");
1541 /* The parser calls "hsperror" when it sees a
1542 `report this and die' error. It sets the stage
1543 and calls "yyerror".
1545 There should be no direct calls in the parser to
1546 "yyerror", except for the one from "hsperror". Thus,
1547 the only other calls will be from the error productions
1548 introduced by yacc/bison/whatever.
1550 We need to be able to recognise the from-error-production
1551 case, because we sometimes want to say, "Oh, never mind",
1552 because the layout rule kicks into action and may save
1556 static BOOLEAN error_and_I_mean_it = FALSE;
1562 error_and_I_mean_it = TRUE;
1566 extern char *yytext;
1573 /* We want to be able to distinguish 'error'-raised yyerrors
1574 from yyerrors explicitly coded by the parser hacker.
1576 if (expect_ccurly && ! error_and_I_mean_it ) {
1580 fprintf(stderr, "\"%s\", line %d, column %d: %s on input: ",
1581 input_filename, hsplineno, hspcolno + 1, s);
1583 if (yyleng == 1 && *yytext == '\0')
1584 fprintf(stderr, "<EOF>");
1588 format_string(stderr, (unsigned char *) yytext, yyleng);
1591 fputc('\n', stderr);
1593 /* a common problem */
1594 if (strcmp(yytext, "#") == 0)
1595 fprintf(stderr, "\t(Perhaps you forgot a `-cpp' or `-fglasgow-exts' flag?)\n");
1602 format_string(fp, s, len)
1609 case '\0': fputs("\\NUL", fp); break;
1610 case '\007': fputs("\\a", fp); break;
1611 case '\010': fputs("\\b", fp); break;
1612 case '\011': fputs("\\t", fp); break;
1613 case '\012': fputs("\\n", fp); break;
1614 case '\013': fputs("\\v", fp); break;
1615 case '\014': fputs("\\f", fp); break;
1616 case '\015': fputs("\\r", fp); break;
1617 case '\033': fputs("\\ESC", fp); break;
1618 case '\034': fputs("\\FS", fp); break;
1619 case '\035': fputs("\\GS", fp); break;
1620 case '\036': fputs("\\RS", fp); break;
1621 case '\037': fputs("\\US", fp); break;
1622 case '\177': fputs("\\DEL", fp); break;
1627 fprintf(fp, "\\^%c", *s + '@');