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;
50 extern list reverse_list();
53 /* For FN, PREVPATT and SAMEFN macros */
55 extern BOOLEAN samefn[];
56 extern tree prevpatt[];
57 extern short icontexts;
60 extern int hsplineno, hspcolno;
61 extern int modulelineno;
62 extern int startlineno;
65 /**********************************************************************
68 * Fixity and Precedence Declarations *
71 **********************************************************************/
73 static int Fixity = 0, Precedence = 0;
75 char *ineg PROTO((char *));
77 long source_version = 0;
102 /**********************************************************************
105 * These are lexemes. *
108 **********************************************************************/
111 %token VARID CONID QVARID QCONID
112 VARSYM CONSYM QVARSYM QCONSYM
114 %token INTEGER FLOAT CHAR STRING
115 CHARPRIM STRINGPRIM INTPRIM FLOATPRIM
120 /**********************************************************************
126 **********************************************************************/
128 %token OCURLY CCURLY VCCURLY
129 %token COMMA SEMI OBRACK CBRACK
130 %token WILDCARD BQUOTE OPAREN CPAREN
133 /**********************************************************************
136 * Reserved Operators *
139 **********************************************************************/
141 %token DOTDOT DCOLON EQUAL LAMBDA
142 %token VBAR RARROW LARROW
143 %token AT LAZY DARROW
146 /**********************************************************************
149 * Reserved Identifiers *
152 **********************************************************************/
154 %token CASE CLASS DATA
155 %token DEFAULT DERIVING DO
156 %token ELSE IF IMPORT
157 %token IN INFIX INFIXL
158 %token INFIXR INSTANCE LET
159 %token MODULE NEWTYPE OF
160 %token THEN TYPE WHERE
163 %token CCALL CCALL_GC CASM CASM_GC
166 /**********************************************************************
169 * Special symbols/identifiers which need to be recognised *
172 **********************************************************************/
174 %token MINUS BANG PLUS
175 %token AS HIDING QUALIFIED
178 /**********************************************************************
181 * Special Symbols for the Lexer *
184 **********************************************************************/
186 %token INTERFACE_UPRAGMA SPECIALISE_UPRAGMA
187 %token INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
188 %token DEFOREST_UPRAGMA END_UPRAGMA
189 %token SOURCE_UPRAGMA
191 /**********************************************************************
194 * Precedences of the various tokens *
197 **********************************************************************/
202 SCC CASM CCALL CASM_GC CCALL_GC
204 %left VARSYM CONSYM QVARSYM QCONSYM
205 MINUS BQUOTE BANG DARROW PLUS
211 %left OCURLY OBRACK OPAREN
217 /**********************************************************************
220 * Type Declarations *
223 **********************************************************************/
226 %type <ulist> caserest alts alt quals
228 rbinds rbinds1 rpats rpats1 list_exps list_rest
230 constrs constr1 fields
233 pats context context_list /* tyvar_list */
236 impdecls maybeimpdecls impdecl
237 maybefixes fixes fix ops
242 %type <umaybe> maybeexports impspec deriving
244 %type <uliteral> lit_constant
246 %type <utree> exp oexp dexp kexp fexp aexp rbind texps
247 expL oexpL kexpL expLno oexpLno dexpLno kexpLno
248 vallhs funlhs qual leftexp
249 pat cpat bpat apat apatc conpat rpat
250 patk bpatk apatck conpatk
253 %type <uid> MINUS PLUS DARROW AS LAZY
254 VARID CONID VARSYM CONSYM
255 var con varop conop op
256 vark varid varsym varsym_nominus
259 %type <uqid> QVARID QCONID QVARSYM QCONSYM
260 qvarid qconid qvarsym qconsym
261 qvar qcon qvarop qconop qop
262 qvark qconk qtycon qtycls
263 gcon gconk gtycon itycon qop1 qvarop1
266 %type <ubinding> topdecl topdecls letdecls
267 typed datad newtd classd instd defaultd
268 decl decls valdef instdef instdefs
269 maybe_where cbody rinst type_and_maybe_id
271 %type <upbinding> valrhs1 altrest
273 %type <uttype> simple ctype sigtype sigarrowtype type atype bigatype btype
275 bbtype batype bxtype wierd_atype
278 %type <uconstr> constr constr_after_context field
280 %type <ustring> FLOAT INTEGER INTPRIM
281 FLOATPRIM DOUBLEPRIM CLITLIT
283 %type <uhstring> STRING STRINGPRIM CHAR CHARPRIM
285 %type <uentid> export import
287 %type <ulong> commas importkey
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,$1,startlineno)); }
385 | importkey QUALIFIED modid impspec
386 { $$ = lsing(mkimport($3,1,mknothing(),$4,$1,startlineno)); }
387 | importkey QUALIFIED modid AS modid impspec
388 { $$ = lsing(mkimport($3,1,mkjust($5),$6,$1,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; FN = NULL; SAMEFN = 0; }
479 | datad { $$ = $1; FN = NULL; SAMEFN = 0; }
480 | newtd { $$ = $1; FN = NULL; SAMEFN = 0; }
481 | classd { $$ = $1; FN = NULL; SAMEFN = 0; }
482 | instd { $$ = $1; FN = NULL; SAMEFN = 0; }
483 | defaultd { $$ = $1; FN = NULL; SAMEFN = 0; }
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 sigtype
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 /* A sigtype is a rank 2 type; it can have for-alls as function args:
667 f :: All a => (All b => ...) -> Int
669 sigtype : type DARROW sigarrowtype { $$ = mkcontext(type2context($1),$3); }
673 sigarrowtype : bigatype RARROW sigarrowtype { $$ = mktfun($1,$3); }
674 | btype RARROW sigarrowtype { $$ = mktfun($1,$3); }
678 /* A "big" atype can be a forall-type in brackets. */
679 bigatype: OPAREN type DARROW type CPAREN { $$ = mkcontext(type2context($2),$4); }
682 /* 1 S/R conflict at DARROW -> shift */
683 ctype : type DARROW type { $$ = mkcontext(type2context($1),$3); }
687 /* 1 S/R conflict at RARROW -> shift */
688 type : btype RARROW type { $$ = mktfun($1,$3); }
692 btype : btype atype { $$ = mktapp($1,$2); }
696 atype : gtycon { $$ = mktname($1); }
698 | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
699 | OBRACK type CBRACK { $$ = mktllist($2); }
700 | OPAREN type CPAREN { $$ = $2; }
704 | OPAREN RARROW CPAREN { $$ = creategid(-2); }
705 | OBRACK CBRACK { $$ = creategid(-1); }
706 | OPAREN CPAREN { $$ = creategid(0); }
707 | OPAREN commas CPAREN { $$ = creategid($2); }
710 atypes : atype { $$ = lsing($1); }
711 | atypes atype { $$ = lapp($1,$2); }
714 types : type { $$ = lsing($1); }
715 | types COMMA type { $$ = lapp($1,$3); }
718 commas : COMMA { $$ = 1; }
719 | commas COMMA { $$ = $1 + 1; }
722 /**********************************************************************
725 * Declaration stuff *
728 **********************************************************************/
730 simple : gtycon { $$ = mktname($1); }
731 | gtyconvars { $$ = $1; }
734 gtyconvars: gtycon tyvar { $$ = mktapp(mktname($1),$2); }
735 | gtyconvars tyvar { $$ = mktapp($1,$2); }
738 context : OPAREN context_list CPAREN { $$ = $2; }
739 | class { $$ = lsing($1); }
742 context_list: class { $$ = lsing($1); }
743 | context_list COMMA class { $$ = lapp($1,$3); }
746 class : gtycon tyvar { $$ = mktapp(mktname($1),$2); }
749 constrs : constr { $$ = lsing($1); }
750 | constrs VBAR constr { $$ = lapp($1,$3); }
753 constr : constr_after_context
754 | type DARROW constr_after_context { $$ = mkconstrcxt ( type2context($1), $3 ); }
757 constr_after_context :
759 /* We have to parse the constructor application as a *type*, else we get
760 into terrible ambiguity problems. Consider the difference between
762 data T = S Int Int Int `R` Int
764 data T = S Int Int Int
766 It isn't till we get to the operator that we discover that the "S" is
767 part of a type in the first, but part of a constructor application in the
771 /* Con !Int (Tree a) */
772 contype { qid tyc; list tys;
773 splittyconapp($1, &tyc, &tys);
774 $$ = mkconstrpre(tyc,tys,hsplineno); }
776 /* !Int `Con` Tree a */
777 | bbtype qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
779 /* (::) (Tree a) Int */
780 | OPAREN qconsym CPAREN batypes { $$ = mkconstrpre($2,$4,hsplineno); }
782 /* Con { op1 :: Int } */
783 | gtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
784 /* 1 S/R conflict on OCURLY -> shift */
788 /* contype has to reduce to a btype unless there are !'s, so that
789 we don't get reduce/reduce conflicts with the second production of constr.
790 But as soon as we see a ! we must switch to using bxtype. */
792 contype : btype { $$ = $1 }
796 /* S !Int Bool; at least one ! */
797 bxtype : btype wierd_atype { $$ = mktapp($1, $2); }
798 | bxtype batype { $$ = mktapp($1, $2); }
801 bbtype : btype { $$ = $1; }
802 | wierd_atype { $$ = $1; }
805 batype : atype { $$ = $1; }
806 | wierd_atype { $$ = $1; }
809 /* A wierd atype is one that isn't a regular atype;
810 it starts with a "!", or with a forall. */
811 wierd_atype : BANG bigatype { $$ = mktbang( $2 ) }
812 | BANG atype { $$ = mktbang( $2 ) }
816 batypes : { $$ = Lnil; }
817 | batypes batype { $$ = lapp($1,$2); }
821 fields : field { $$ = lsing($1); }
822 | fields COMMA field { $$ = lapp($1,$3); }
825 field : qvars_list DCOLON ctype { $$ = mkfield($1,$3); }
826 | qvars_list DCOLON BANG atype { $$ = mkfield($1,mktbang($4)); }
827 | qvars_list DCOLON BANG bigatype { $$ = mkfield($1,mktbang($4)); }
830 constr1 : gtycon atype { $$ = lsing(mkconstrnew($1,$2,hsplineno)); }
834 dtyclses: OPAREN dtycls_list CPAREN { $$ = $2; }
835 | OPAREN CPAREN { $$ = Lnil; }
836 | qtycls { $$ = lsing($1); }
839 dtycls_list: qtycls { $$ = lsing($1); }
840 | dtycls_list COMMA qtycls { $$ = lapp($1,$3); }
843 instdefs : /* empty */ { $$ = mknullbind(); }
844 | instdef { $$ = $1; }
845 | instdefs SEMI instdef
857 /* instdef: same as valdef, except certain user-pragmas may appear */
859 SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
861 $$ = mkvspec_uprag($2, $4, startlineno);
862 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
865 | INLINE_UPRAGMA qvark END_UPRAGMA
867 $$ = mkinline_uprag($2, startlineno);
868 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
871 | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
873 $$ = mkmagicuf_uprag($2, $3, startlineno);
874 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
883 tree fn = function($1);
886 if(ttree(fn) == ident)
888 qid fun_id = gident((struct Sident *) fn);
893 else if (ttree(fn) == infixap)
895 qid fun_id = ginffun((struct Sinfixap *) fn);
902 printf("%u\n",startlineno);
904 fprintf(stderr,"%u\tvaldef\n",startlineno);
909 if ( lhs_is_patt($1) )
911 $$ = mkpbind($3, startlineno);
916 $$ = mkfbind($3,startlineno);
922 vallhs : patk { $$ = $1; }
923 | patk qvarop pat { $$ = mkinfixap($2,$1,$3); }
924 | funlhs { $$ = $1; }
927 funlhs : qvark apat { $$ = mkap(mkident($1),$2); }
928 | funlhs apat { $$ = mkap($1,$2); }
932 valrhs : valrhs1 maybe_where { $$ = lsing(createpat($1, $2)); }
935 valrhs1 : gdrhs { $$ = mkpguards($1); }
936 | EQUAL exp { $$ = mkpnoguards($2); }
939 gdrhs : gd EQUAL exp { $$ = lsing(mkpgdexp($1,$3)); }
940 | gd EQUAL exp gdrhs { $$ = mklcons(mkpgdexp($1,$3),$4); }
944 WHERE ocurly decls ccurly { $$ = $3; }
945 | WHERE vocurly decls vccurly { $$ = $3; }
946 /* A where containing no decls is OK */
947 | WHERE SEMI { $$ = mknullbind(); }
948 | /* empty */ { $$ = mknullbind(); }
951 gd : VBAR quals { $$ = $2; }
955 /**********************************************************************
961 **********************************************************************/
963 exp : oexp DCOLON ctype { $$ = mkrestr($1,$3); }
968 Operators must be left-associative at the same precedence for
969 precedence parsing to work.
971 /* 8 S/R conflicts on qop -> shift */
972 oexp : oexp qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
977 This comes here because of the funny precedence rules concerning
980 dexp : MINUS kexp { $$ = mknegate($2); }
985 We need to factor out a leading let expression so we can set
986 inpat=TRUE when parsing (non let) expressions inside stmts and quals
988 expLno : oexpLno DCOLON ctype { $$ = mkrestr($1,$3); }
991 oexpLno : oexpLno qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
994 dexpLno : MINUS kexp { $$ = mknegate($2); }
998 expL : oexpL DCOLON ctype { $$ = mkrestr($1,$3); }
1001 oexpL : oexpL qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
1006 let/if/lambda/case have higher precedence than infix operators.
1013 /* kexpL = a let expression */
1014 kexpL : letdecls IN exp { $$ = mklet($1,$3); }
1017 /* kexpLno = any other expression more tightly binding than operator application */
1019 { hsincindent(); /* push new context for FN = NULL; */
1020 FN = NULL; /* not actually concerned about indenting */
1021 $<ulong>$ = hsplineno; /* remember current line number */
1026 RARROW exp /* lambda abstraction */
1028 $$ = mklambda($3, $6, $<ulong>2);
1032 | IF {$<ulong>$ = hsplineno;}
1033 exp THEN exp ELSE exp { $$ = mkife($3,$5,$7,$<ulong>2); }
1035 /* Case Expression */
1036 | CASE {$<ulong>$ = hsplineno;}
1037 exp OF caserest { $$ = mkcasee($3,$5,$<ulong>2); }
1040 | DO {$<ulong>$ = hsplineno;}
1041 dorest { $$ = mkdoe($3,$<ulong>2); }
1043 /* CCALL/CASM Expression */
1044 | CCALL ccallid cexps { $$ = mkccall($2,install_literal("n"),$3); }
1045 | CCALL ccallid { $$ = mkccall($2,install_literal("n"),Lnil); }
1046 | CCALL_GC ccallid cexps { $$ = mkccall($2,install_literal("p"),$3); }
1047 | CCALL_GC ccallid { $$ = mkccall($2,install_literal("p"),Lnil); }
1048 | CASM CLITLIT cexps { $$ = mkccall($2,install_literal("N"),$3); }
1049 | CASM CLITLIT { $$ = mkccall($2,install_literal("N"),Lnil); }
1050 | CASM_GC CLITLIT cexps { $$ = mkccall($2,install_literal("P"),$3); }
1051 | CASM_GC CLITLIT { $$ = mkccall($2,install_literal("P"),Lnil); }
1053 /* SCC Expression */
1064 fexp : fexp aexp { $$ = mkap($1,$2); }
1068 /* simple expressions */
1069 aexp : qvar { $$ = mkident($1); }
1070 | gcon { $$ = mkident($1); }
1071 | lit_constant { $$ = mklit($1); }
1072 | OPAREN exp CPAREN { $$ = mkpar($2); } /* mkpar: stop infix parsing at ()'s */
1073 | qcon OCURLY rbinds CCURLY { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */
1074 | OBRACK list_exps CBRACK { $$ = mkllist($2); }
1075 | OPAREN exp COMMA texps CPAREN { if (ttree($4) == tuple)
1076 $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
1078 $$ = mktuple(ldub($2, $4)); }
1080 /* only in expressions ... */
1081 | aexp OCURLY rbinds1 CCURLY { $$ = mkrupdate($1,$3); }
1082 | OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); }
1083 | OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); }
1084 | OBRACK exp COMMA exp DOTDOT CBRACK { $$ = mkeenum($2,mkjust($4),mknothing()); }
1085 | OBRACK exp DOTDOT exp CBRACK { $$ = mkeenum($2,mknothing(),mkjust($4)); }
1086 | OBRACK exp DOTDOT CBRACK { $$ = mkeenum($2,mknothing(),mknothing()); }
1087 | OPAREN oexp qop CPAREN { $$ = mklsection($2,$3); }
1088 | OPAREN qop1 oexp CPAREN { $$ = mkrsection($2,$3); }
1090 /* only in patterns ... */
1091 /* these add 2 S/R conflict with with aexp . OCURLY rbinds CCURLY */
1092 | qvar AT aexp { checkinpat(); $$ = mkas($1,$3); }
1093 | LAZY aexp { checkinpat(); $$ = mklazyp($2); }
1094 | WILDCARD { checkinpat(); $$ = mkwildp(); }
1097 /* ccall arguments */
1098 cexps : cexps aexp { $$ = lapp($1,$2); }
1099 | aexp { $$ = lsing($1); }
1102 caserest: ocurly alts ccurly { $$ = $2; }
1103 | vocurly alts vccurly { $$ = $2; }
1105 dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; }
1106 | vocurly stmts vccurly { checkdostmts($2); $$ = $2; }
1109 rbinds : /* empty */ { $$ = Lnil; }
1113 rbinds1 : rbind { $$ = lsing($1); }
1114 | rbinds1 COMMA rbind { $$ = lapp($1,$3); }
1117 rbind : qvar { $$ = mkrbind($1,mknothing()); }
1118 | qvar EQUAL exp { $$ = mkrbind($1,mkjust($3)); }
1121 texps : exp { $$ = mkpar($1); } /* mkpar: so we don't flatten last element in tuple */
1123 { if (ttree($3) == tuple)
1124 $$ = mktuple(mklcons($1, gtuplelist((struct Stuple *) $3)));
1125 else if (ttree($3) == par)
1126 $$ = mktuple(ldub($1, gpare((struct Spar *) $3)));
1128 hsperror("hsparser:texps: panic");
1130 /* right recursion? WDP */
1134 exp { $$ = lsing($1); }
1135 | exp COMMA exp { $$ = mklcons( $1, lsing($3) ); }
1136 | exp COMMA exp COMMA list_rest { $$ = mklcons( $1, mklcons( $3, reverse_list( $5 ))); }
1139 /* Use left recusion for list_rest, because we sometimes get programs with
1140 very long explicit lists. */
1141 list_rest : exp { $$ = lsing($1); }
1142 | list_rest COMMA exp { $$ = mklcons( $3, $1 ); }
1146 exp { $$ = lsing($1); }
1147 | exp COMMA list_exps { $$ = mklcons($1, $3); }
1149 /* right recursion? (WDP)
1151 It has to be this way, though, otherwise you
1152 may do the wrong thing to distinguish between...
1154 [ e1 , e2 .. ] -- an enumeration ...
1155 [ e1 , e2 , e3 ] -- a list
1157 (In fact, if you change the grammar and throw yacc/bison
1158 at it, it *will* do the wrong thing [WDP 94/06])
1161 letdecls: LET ocurly decls ccurly { $$ = $3 }
1162 | LET vocurly decls vccurly { $$ = $3 }
1165 quals : qual { $$ = lsing($1); }
1166 | quals COMMA qual { $$ = lapp($1,$3); }
1169 qual : letdecls { $$ = mkseqlet($1); }
1171 | {inpat=TRUE;} expLno
1172 {inpat=FALSE;} leftexp
1174 expORpat(LEGIT_EXPR,$2);
1177 expORpat(LEGIT_PATT,$2);
1183 alts : alt { $$ = $1; }
1184 | alts SEMI alt { $$ = lconc($1,$3); }
1187 alt : pat { PREVPATT = $1; } altrest { $$ = lsing($3); PREVPATT = NULL; }
1188 | /* empty */ { $$ = Lnil; }
1191 altrest : gdpat maybe_where { $$ = createpat(mkpguards($1), $2); }
1192 | RARROW exp maybe_where { $$ = createpat(mkpnoguards($2),$3); }
1195 gdpat : gd RARROW exp { $$ = lsing(mkpgdexp($1,$3)); }
1196 | gd RARROW exp gdpat { $$ = mklcons(mkpgdexp($1,$3),$4); }
1199 stmts : stmt { $$ = $1; }
1200 | stmts SEMI stmt { $$ = lconc($1,$3); }
1203 stmt : /* empty */ { $$ = Lnil; }
1204 | letdecls { $$ = lsing(mkseqlet($1)); }
1205 | expL { $$ = lsing(mkdoexp($1,hsplineno)); }
1206 | {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
1208 expORpat(LEGIT_EXPR,$2);
1209 $$ = lsing(mkdoexp($2,endlineno));
1211 expORpat(LEGIT_PATT,$2);
1212 $$ = lsing(mkdobind($2,$4,endlineno));
1217 leftexp : LARROW exp { $$ = $2; }
1218 | /* empty */ { $$ = NULL; }
1221 /**********************************************************************
1227 **********************************************************************/
1229 pat : qvar PLUS INTEGER { $$ = mkplusp($1, mkinteger($3)); }
1233 cpat : cpat qconop bpat { $$ = mkinfixap($2,$1,$3); }
1239 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1240 | MINUS INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
1241 | MINUS FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
1244 conpat : gcon { $$ = mkident($1); }
1245 | conpat apat { $$ = mkap($1,$2); }
1248 apat : gcon { $$ = mkident($1); }
1249 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1253 apatc : qvar { $$ = mkident($1); }
1254 | qvar AT apat { $$ = mkas($1,$3); }
1255 | lit_constant { $$ = mklit($1); }
1256 | WILDCARD { $$ = mkwildp(); }
1257 | OPAREN pat CPAREN { $$ = mkpar($2); }
1258 | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1259 | OBRACK pats CBRACK { $$ = mkllist($2); }
1260 | LAZY apat { $$ = mklazyp($2); }
1264 INTEGER { $$ = mkinteger($1); }
1265 | FLOAT { $$ = mkfloatr($1); }
1266 | CHAR { $$ = mkcharr($1); }
1267 | STRING { $$ = mkstring($1); }
1268 | CHARPRIM { $$ = mkcharprim($1); }
1269 | STRINGPRIM { $$ = mkstringprim($1); }
1270 | INTPRIM { $$ = mkintprim($1); }
1271 | FLOATPRIM { $$ = mkfloatprim($1); }
1272 | DOUBLEPRIM { $$ = mkdoubleprim($1); }
1273 | CLITLIT /* yurble yurble */ { $$ = mkclitlit($1); }
1276 lampats : apat lampats { $$ = mklcons($1,$2); }
1277 | apat { $$ = lsing($1); }
1278 /* right recursion? (WDP) */
1281 pats : pat COMMA pats { $$ = mklcons($1, $3); }
1282 | pat { $$ = lsing($1); }
1283 /* right recursion? (WDP) */
1286 rpats : /* empty */ { $$ = Lnil; }
1290 rpats1 : rpat { $$ = lsing($1); }
1291 | rpats1 COMMA rpat { $$ = lapp($1,$3); }
1294 rpat : qvar { $$ = mkrbind($1,mknothing()); }
1295 | qvar EQUAL pat { $$ = mkrbind($1,mkjust($3)); }
1299 patk : patk qconop bpat { $$ = mkinfixap($2,$1,$3); }
1305 | qconk OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1306 | minuskey INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
1307 | minuskey FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
1310 conpatk : gconk { $$ = mkident($1); }
1311 | conpatk apat { $$ = mkap($1,$2); }
1314 apatck : qvark { $$ = mkident($1); }
1315 | qvark AT apat { $$ = mkas($1,$3); }
1316 | lit_constant { $$ = mklit($1); setstartlineno(); }
1317 | WILDCARD { $$ = mkwildp(); setstartlineno(); }
1318 | oparenkey pat CPAREN { $$ = mkpar($2); }
1319 | oparenkey pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1320 | obrackkey pats CBRACK { $$ = mkllist($2); }
1321 | lazykey apat { $$ = mklazyp($2); }
1326 | OBRACK CBRACK { $$ = creategid(-1); }
1327 | OPAREN CPAREN { $$ = creategid(0); }
1328 | OPAREN commas CPAREN { $$ = creategid($2); }
1332 | obrackkey CBRACK { $$ = creategid(-1); }
1333 | oparenkey CPAREN { $$ = creategid(0); }
1334 | oparenkey commas CPAREN { $$ = creategid($2); }
1337 /**********************************************************************
1340 * Keywords which record the line start *
1343 **********************************************************************/
1345 importkey: IMPORT { setstartlineno(); $$ = 0; }
1346 | IMPORT SOURCE_UPRAGMA { setstartlineno(); $$ = 1; }
1349 datakey : DATA { setstartlineno();
1352 printf("%u\n",startlineno);
1354 fprintf(stderr,"%u\tdata\n",startlineno);
1359 typekey : TYPE { setstartlineno();
1362 printf("%u\n",startlineno);
1364 fprintf(stderr,"%u\ttype\n",startlineno);
1369 newtypekey : NEWTYPE { setstartlineno();
1372 printf("%u\n",startlineno);
1374 fprintf(stderr,"%u\tnewtype\n",startlineno);
1379 instkey : INSTANCE { setstartlineno();
1382 printf("%u\n",startlineno);
1385 fprintf(stderr,"%u\tinstance\n",startlineno);
1390 defaultkey: DEFAULT { setstartlineno(); }
1393 classkey: CLASS { setstartlineno();
1396 printf("%u\n",startlineno);
1398 fprintf(stderr,"%u\tclass\n",startlineno);
1403 modulekey: MODULE { setstartlineno();
1406 printf("%u\n",startlineno);
1408 fprintf(stderr,"%u\tmodule\n",startlineno);
1413 oparenkey: OPAREN { setstartlineno(); }
1416 obrackkey: OBRACK { setstartlineno(); }
1419 lazykey : LAZY { setstartlineno(); }
1422 minuskey: MINUS { setstartlineno(); }
1426 /**********************************************************************
1429 * Basic qualified/unqualified ids/ops *
1432 **********************************************************************/
1435 | OPAREN qvarsym CPAREN { $$ = $2; }
1438 | OPAREN qconsym CPAREN { $$ = $2; }
1441 | BQUOTE qvarid BQUOTE { $$ = $2; }
1444 | BQUOTE qconid BQUOTE { $$ = $2; }
1450 /* Non "-" op, used in right sections */
1455 /* Non "-" varop, used in right sections */
1457 | varsym_nominus { $$ = mknoqual($1); }
1458 | BQUOTE qvarid BQUOTE { $$ = $2; }
1463 | OPAREN varsym CPAREN { $$ = $2; }
1465 con : tycon /* using tycon removes conflicts */
1466 | OPAREN CONSYM CPAREN { $$ = $2; }
1469 | BQUOTE varid BQUOTE { $$ = $2; }
1472 | BQUOTE CONID BQUOTE { $$ = $2; }
1478 qvark : qvarid { setstartlineno(); $$ = $1; }
1479 | oparenkey qvarsym CPAREN { $$ = $2; }
1481 qconk : qconid { setstartlineno(); $$ = $1; }
1482 | oparenkey qconsym CPAREN { $$ = $2; }
1484 vark : varid { setstartlineno(); $$ = $1; }
1485 | oparenkey varsym CPAREN { $$ = $2; }
1489 | varid { $$ = mknoqual($1); }
1492 | varsym { $$ = mknoqual($1); }
1495 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1498 | CONSYM { $$ = mknoqual($1); }
1501 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1504 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1507 varsym : varsym_nominus
1508 | MINUS { $$ = install_literal("-"); }
1511 /* PLUS, BANG are valid varsyms */
1512 varsym_nominus : VARSYM
1513 | PLUS { $$ = install_literal("+"); }
1514 | BANG { $$ = install_literal("!"); }
1517 /* AS HIDING QUALIFIED are valid varids */
1519 | AS { $$ = install_literal("as"); }
1520 | HIDING { $$ = install_literal("hiding"); }
1521 | QUALIFIED { $$ = install_literal("qualified"); }
1529 tyvar : varid { $$ = mknamedtvar(mknoqual($1)); }
1537 tyvar_list: tyvar { $$ = lsing($1); }
1538 | tyvar_list COMMA tyvar { $$ = lapp($1,$3); }
1542 /**********************************************************************
1545 * Stuff to do with layout *
1548 **********************************************************************/
1550 ocurly : layout OCURLY { hsincindent(); }
1552 vocurly : layout { hssetindent(); }
1555 layout : { hsindentoff(); }
1561 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1566 vccurly : { expect_ccurly = 1; } vccurly1 { expect_ccurly = 0; }
1572 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1578 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1585 /**********************************************************************
1587 * Error Processing and Reporting *
1589 * (This stuff is here in case we want to use Yacc macros and such.) *
1591 **********************************************************************/
1597 hsperror("pattern syntax used in expression");
1601 /* The parser calls "hsperror" when it sees a
1602 `report this and die' error. It sets the stage
1603 and calls "yyerror".
1605 There should be no direct calls in the parser to
1606 "yyerror", except for the one from "hsperror". Thus,
1607 the only other calls will be from the error productions
1608 introduced by yacc/bison/whatever.
1610 We need to be able to recognise the from-error-production
1611 case, because we sometimes want to say, "Oh, never mind",
1612 because the layout rule kicks into action and may save
1616 static BOOLEAN error_and_I_mean_it = FALSE;
1622 error_and_I_mean_it = TRUE;
1626 extern char *yytext;
1633 /* We want to be able to distinguish 'error'-raised yyerrors
1634 from yyerrors explicitly coded by the parser hacker.
1636 if (expect_ccurly && ! error_and_I_mean_it ) {
1640 fprintf(stderr, "%s:%d:%d: %s on input: ",
1641 input_filename, hsplineno, hspcolno + 1, s);
1643 if (yyleng == 1 && *yytext == '\0')
1644 fprintf(stderr, "<EOF>");
1648 format_string(stderr, (unsigned char *) yytext, yyleng);
1651 fputc('\n', stderr);
1653 /* a common problem */
1654 if (strcmp(yytext, "#") == 0)
1655 fprintf(stderr, "\t(Perhaps you forgot a `-cpp' or `-fglasgow-exts' flag?)\n");
1662 format_string(fp, s, len)
1669 case '\0': fputs("\\NUL", fp); break;
1670 case '\007': fputs("\\a", fp); break;
1671 case '\010': fputs("\\b", fp); break;
1672 case '\011': fputs("\\t", fp); break;
1673 case '\012': fputs("\\n", fp); break;
1674 case '\013': fputs("\\v", fp); break;
1675 case '\014': fputs("\\f", fp); break;
1676 case '\015': fputs("\\r", fp); break;
1677 case '\033': fputs("\\ESC", fp); break;
1678 case '\034': fputs("\\FS", fp); break;
1679 case '\035': fputs("\\GS", fp); break;
1680 case '\036': fputs("\\RS", fp); break;
1681 case '\037': fputs("\\US", fp); break;
1682 case '\177': fputs("\\DEL", fp); break;
1687 fprintf(fp, "\\^%c", *s + '@');