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 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
272 gtyconapp ntyconapp ntycon gtyconvars
273 bbtype batype btyconapp
274 class restrict_inst general_inst tyvar
276 %type <uconstr> constr field
278 %type <ustring> FLOAT INTEGER INTPRIM
279 FLOATPRIM DOUBLEPRIM CLITLIT
281 %type <uhstring> STRING STRINGPRIM CHAR CHARPRIM
283 %type <uentid> export import
287 /**********************************************************************
290 * Start Symbol for the Parser *
293 **********************************************************************/
298 module : modulekey modid maybeexports
300 modulelineno = startlineno;
301 the_module_name = $2;
307 the_module_name = install_literal("Main");
308 module_exports = mknothing();
313 body : ocurly { setstartlineno(); } interface_pragma orestm
314 | vocurly interface_pragma vrestm
317 interface_pragma : /* empty */
318 | INTERFACE_UPRAGMA INTEGER END_UPRAGMA SEMI
320 source_version = atoi($2);
324 orestm : maybeimpdecls maybefixes topdecls ccurly
326 root = mkhmodule(the_module_name,$1,module_exports,
327 $2,$3,source_version,modulelineno);
331 root = mkhmodule(the_module_name,$1,module_exports,
332 Lnil,mknullbind(),source_version,modulelineno);
335 vrestm : maybeimpdecls maybefixes topdecls vccurly
337 root = mkhmodule(the_module_name,$1,module_exports,
338 $2,$3,source_version,modulelineno);
342 root = mkhmodule(the_module_name,$1,module_exports,
343 Lnil,mknullbind(),source_version,modulelineno);
346 maybeexports : /* empty */ { $$ = mknothing(); }
347 | OPAREN export_list CPAREN { $$ = mkjust($2); }
348 | OPAREN export_list COMMA CPAREN { $$ = mkjust($2); }
352 export { $$ = lsing($1); }
353 | export_list COMMA export { $$ = lapp($1, $3); }
356 export : qvar { $$ = mkentid($1); }
357 | gtycon { $$ = mkenttype($1); }
358 | gtycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
359 | gtycon OPAREN CPAREN { $$ = mkenttypenamed($1,Lnil); }
360 | gtycon OPAREN enames CPAREN { $$ = mkenttypenamed($1,$3); }
361 | MODULE modid { $$ = mkentmod($2); }
364 enames : ename { $$ = lsing($1); }
365 | enames COMMA ename { $$ = lapp($1,$3); }
372 maybeimpdecls : /* empty */ { $$ = Lnil; }
373 | impdecls SEMI { $$ = $1; }
376 impdecls: impdecl { $$ = $1; }
377 | impdecls SEMI impdecl { $$ = lconc($1,$3); }
381 impdecl : importkey modid impspec
382 { $$ = lsing(mkimport($2,0,mknothing(),$3,startlineno)); }
383 | importkey QUALIFIED modid impspec
384 { $$ = lsing(mkimport($3,1,mknothing(),$4,startlineno)); }
385 | importkey QUALIFIED modid AS modid impspec
386 { $$ = lsing(mkimport($3,1,mkjust($5),$6,startlineno)); }
389 impspec : /* empty */ { $$ = mknothing(); }
390 | OPAREN CPAREN { $$ = mkjust(mkleft(Lnil)); }
391 | OPAREN import_list CPAREN { $$ = mkjust(mkleft($2)); }
392 | OPAREN import_list COMMA CPAREN { $$ = mkjust(mkleft($2)); }
393 | HIDING OPAREN import_list CPAREN { $$ = mkjust(mkright($3)); }
394 | HIDING OPAREN import_list COMMA CPAREN { $$ = mkjust(mkright($3)); }
398 import { $$ = lsing($1); }
399 | import_list COMMA import { $$ = lapp($1, $3); }
402 import : var { $$ = mkentid(mknoqual($1)); }
403 | tycon { $$ = mkenttype(mknoqual($1)); }
404 | tycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall(mknoqual($1)); }
405 | tycon OPAREN CPAREN { $$ = mkenttypenamed(mknoqual($1),Lnil); }
406 | tycon OPAREN inames CPAREN { $$ = mkenttypenamed(mknoqual($1),$3); }
409 inames : iname { $$ = lsing($1); }
410 | inames COMMA iname { $$ = lapp($1,$3); }
412 iname : var { $$ = mknoqual($1); }
413 | con { $$ = mknoqual($1); }
416 /**********************************************************************
419 * Fixes and Decls etc *
422 **********************************************************************/
424 maybefixes: /* empty */ { $$ = Lnil; }
425 | fixes SEMI { $$ = $1; }
428 fixes : fix { $$ = $1; }
429 | fixes SEMI fix { $$ = lconc($1,$3); }
432 fix : INFIXL INTEGER { Precedence = checkfixity($2); Fixity = INFIXL; }
434 | INFIXR INTEGER { Precedence = checkfixity($2); Fixity = INFIXR; }
436 | INFIX INTEGER { Precedence = checkfixity($2); Fixity = INFIX; }
438 | INFIXL { Fixity = INFIXL; Precedence = 9; }
440 | INFIXR { Fixity = INFIXR; Precedence = 9; }
442 | INFIX { Fixity = INFIX; Precedence = 9; }
446 ops : op { $$ = lsing(mkfixop(mknoqual($1),infixint(Fixity),Precedence)); }
447 | ops COMMA op { $$ = lapp($1,mkfixop(mknoqual($3),infixint(Fixity),Precedence)); }
451 | topdecls SEMI topdecl
470 topdecl : typed { $$ = $1; }
473 | classd { $$ = $1; }
475 | defaultd { $$ = $1; }
479 typed : typekey simple EQUAL type { $$ = mknbind($2,$4,startlineno); }
483 datad : datakey simple EQUAL constrs deriving
484 { $$ = mktbind(Lnil,$2,$4,$5,startlineno); }
485 | datakey context DARROW simple EQUAL constrs deriving
486 { $$ = mktbind($2,$4,$6,$7,startlineno); }
489 newtd : newtypekey simple EQUAL constr1 deriving
490 { $$ = mkntbind(Lnil,$2,$4,$5,startlineno); }
491 | newtypekey context DARROW simple EQUAL constr1 deriving
492 { $$ = mkntbind($2,$4,$6,$7,startlineno); }
495 deriving: /* empty */ { $$ = mknothing(); }
496 | DERIVING dtyclses { $$ = mkjust($2); }
499 classd : classkey context DARROW class cbody
500 { $$ = mkcbind($2,$4,$5,startlineno); }
501 | classkey class cbody
502 { $$ = mkcbind(Lnil,$2,$3,startlineno); }
505 cbody : /* empty */ { $$ = mknullbind(); }
506 | WHERE ocurly decls ccurly { checkorder($3); $$ = $3; }
507 | WHERE vocurly decls vccurly { checkorder($3); $$ = $3; }
510 instd : instkey context DARROW gtycon restrict_inst rinst
511 { $$ = mkibind($2,$4,$5,$6,startlineno); }
512 | instkey gtycon general_inst rinst
513 { $$ = mkibind(Lnil,$2,$3,$4,startlineno); }
516 rinst : /* empty */ { $$ = mknullbind(); }
517 | WHERE ocurly instdefs ccurly { $$ = $3; }
518 | WHERE vocurly instdefs vccurly { $$ = $3; }
521 restrict_inst : gtycon { $$ = mktname($1); }
522 | OPAREN gtyconvars CPAREN { $$ = $2; }
523 | OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); }
524 | OBRACK tyvar CBRACK { $$ = mktllist($2); }
525 | OPAREN tyvar RARROW tyvar CPAREN { $$ = mktfun($2,$4); }
528 general_inst : gtycon { $$ = mktname($1); }
529 | OPAREN gtyconapp CPAREN { $$ = $2; }
530 | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
531 | OBRACK type CBRACK { $$ = mktllist($2); }
532 | OPAREN btype RARROW type CPAREN { $$ = mktfun($2,$4); }
535 defaultd: defaultkey OPAREN types CPAREN { $$ = mkdbind($3,startlineno); }
536 | defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); }
553 Note: if there is an iclasop_pragma here, then we must be
554 doing a class-op in an interface -- unless the user is up
555 to real mischief (ugly, but likely to work).
558 decl : qvarsk DCOLON ctype
559 { $$ = mksbind($1,$3,startlineno);
560 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
563 /* User-specified pragmas come in as "signatures"...
564 They are similar in that they can appear anywhere in the module,
565 and have to be "joined up" with their related entity.
567 Have left out the case specialising to an overloaded type.
568 Let's get real, OK? (WDP)
570 | SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
572 $$ = mkvspec_uprag($2, $4, startlineno);
573 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
576 | SPECIALISE_UPRAGMA INSTANCE gtycon general_inst END_UPRAGMA
578 $$ = mkispec_uprag($3, $4, startlineno);
579 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
582 | SPECIALISE_UPRAGMA DATA gtycon atypes END_UPRAGMA
584 $$ = mkdspec_uprag($3, $4, startlineno);
585 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
588 | INLINE_UPRAGMA qvark END_UPRAGMA
590 $$ = mkinline_uprag($2, startlineno);
591 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
594 | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
596 $$ = mkmagicuf_uprag($2, $3, startlineno);
597 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
600 | DEFOREST_UPRAGMA qvark END_UPRAGMA
602 $$ = mkdeforest_uprag($2, startlineno);
603 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
606 /* end of user-specified pragmas */
609 | /* empty */ { $$ = mknullbind(); PREVPATT = NULL; FN = NULL; SAMEFN = 0; }
612 qvarsk : qvark COMMA qvars_list { $$ = mklcons($1,$3); }
613 | qvark { $$ = lsing($1); }
616 qvars_list: qvar { $$ = lsing($1); }
617 | qvars_list COMMA qvar { $$ = lapp($1,$3); }
620 types_and_maybe_ids :
621 type_and_maybe_id { $$ = lsing($1); }
622 | types_and_maybe_ids COMMA type_and_maybe_id { $$ = lapp($1,$3); }
626 type { $$ = mkvspec_ty_and_id($1,mknothing()); }
627 | type EQUAL qvark { $$ = mkvspec_ty_and_id($1,mkjust($3)); }
630 /**********************************************************************
636 **********************************************************************/
638 /* "DCOLON context => type" vs "DCOLON type" is a problem,
639 because you can't distinguish between
641 foo :: (Baz a, Baz a)
642 bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
644 with one token of lookahead. The HACK is to have "DCOLON ttype"
645 [tuple type] in the first case, then check that it has the right
646 form C a, or (C1 a, C2 b, ... Cn z) and convert it into a
650 /* 1 S/R conflict at DARROW -> shift */
651 ctype : type DARROW type { $$ = mkcontext(type2context($1),$3); }
655 /* 1 S/R conflict at RARROW -> shift */
656 type : btype { $$ = $1; }
657 | btype RARROW type { $$ = mktfun($1,$3); }
660 /* btype is split so we can parse gtyconapp without S/R conflicts */
661 btype : gtyconapp { $$ = $1; }
662 | ntyconapp { $$ = $1; }
665 ntyconapp: ntycon { $$ = $1; }
666 | ntyconapp atype { $$ = mktapp($1,$2); }
669 gtyconapp: gtycon { $$ = mktname($1); }
670 | gtyconapp atype { $$ = mktapp($1,$2); }
674 atype : gtycon { $$ = mktname($1); }
675 | ntycon { $$ = $1; }
678 ntycon : tyvar { $$ = $1; }
679 | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
680 | OBRACK type CBRACK { $$ = mktllist($2); }
681 | OPAREN type CPAREN { $$ = $2; }
685 | OPAREN RARROW CPAREN { $$ = creategid(-2); }
686 | OBRACK CBRACK { $$ = creategid(-1); }
687 | OPAREN CPAREN { $$ = creategid(0); }
688 | OPAREN commas CPAREN { $$ = creategid($2); }
691 atypes : atype { $$ = lsing($1); }
692 | atypes atype { $$ = lapp($1,$2); }
695 types : type { $$ = lsing($1); }
696 | types COMMA type { $$ = lapp($1,$3); }
699 commas : COMMA { $$ = 1; }
700 | commas COMMA { $$ = $1 + 1; }
703 /**********************************************************************
706 * Declaration stuff *
709 **********************************************************************/
711 simple : gtycon { $$ = mktname($1); }
712 | gtyconvars { $$ = $1; }
715 gtyconvars: gtycon tyvar { $$ = mktapp(mktname($1),$2); }
716 | gtyconvars tyvar { $$ = mktapp($1,$2); }
719 context : OPAREN context_list CPAREN { $$ = $2; }
720 | class { $$ = lsing($1); }
723 context_list: class { $$ = lsing($1); }
724 | context_list COMMA class { $$ = lapp($1,$3); }
727 class : gtycon tyvar { $$ = mktapp(mktname($1),$2); }
730 constrs : constr { $$ = lsing($1); }
731 | constrs VBAR constr { $$ = lapp($1,$3); }
734 constr : btyconapp { qid tyc; list tys;
735 splittyconapp($1, &tyc, &tys);
736 $$ = mkconstrpre(tyc,tys,hsplineno); }
737 | OPAREN qconsym CPAREN { $$ = mkconstrpre($2,Lnil,hsplineno); }
738 | OPAREN qconsym CPAREN batypes { $$ = mkconstrpre($2,$4,hsplineno); }
739 | btyconapp qconop bbtype { checknobangs($1);
740 $$ = mkconstrinf($1,$2,$3,hsplineno); }
741 | ntyconapp qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
742 | BANG atype qconop bbtype { $$ = mkconstrinf(mktbang($2),$3,$4,hsplineno); }
744 /* 1 S/R conflict on OCURLY -> shift */
745 | gtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
748 btyconapp: gtycon { $$ = mktname($1); }
749 | btyconapp batype { $$ = mktapp($1,$2); }
752 bbtype : btype { $$ = $1; }
753 | BANG atype { $$ = mktbang($2); }
756 batype : atype { $$ = $1; }
757 | BANG atype { $$ = mktbang($2); }
760 batypes : batype { $$ = lsing($1); }
761 | batypes batype { $$ = lapp($1,$2); }
765 fields : field { $$ = lsing($1); }
766 | fields COMMA field { $$ = lapp($1,$3); }
769 field : qvars_list DCOLON type { $$ = mkfield($1,$3); }
770 | qvars_list DCOLON BANG atype { $$ = mkfield($1,mktbang($4)); }
773 constr1 : gtycon atype { $$ = lsing(mkconstrnew($1,$2,hsplineno)); }
777 dtyclses: OPAREN dtycls_list CPAREN { $$ = $2; }
778 | OPAREN CPAREN { $$ = Lnil; }
779 | qtycls { $$ = lsing($1); }
782 dtycls_list: qtycls { $$ = lsing($1); }
783 | dtycls_list COMMA qtycls { $$ = lapp($1,$3); }
786 instdefs : /* empty */ { $$ = mknullbind(); }
787 | instdef { $$ = $1; }
788 | instdefs SEMI instdef
800 /* instdef: same as valdef, except certain user-pragmas may appear */
802 SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
804 $$ = mkvspec_uprag($2, $4, startlineno);
805 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
808 | INLINE_UPRAGMA qvark END_UPRAGMA
810 $$ = mkinline_uprag($2, startlineno);
811 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
814 | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
816 $$ = mkmagicuf_uprag($2, $3, startlineno);
817 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
826 tree fn = function($1);
829 if(ttree(fn) == ident)
831 qid fun_id = gident((struct Sident *) fn);
836 else if (ttree(fn) == infixap)
838 qid fun_id = ginffun((struct Sinfixap *) fn);
845 printf("%u\n",startlineno);
847 fprintf(stderr,"%u\tvaldef\n",startlineno);
852 if ( lhs_is_patt($1) )
854 $$ = mkpbind($3, startlineno);
859 $$ = mkfbind($3,startlineno);
865 vallhs : patk { $$ = $1; }
866 | patk qvarop pat { $$ = mkinfixap($2,$1,$3); }
867 | funlhs { $$ = $1; }
870 funlhs : qvark apat { $$ = mkap(mkident($1),$2); }
871 | funlhs apat { $$ = mkap($1,$2); }
875 valrhs : valrhs1 maybe_where { $$ = lsing(createpat($1, $2)); }
878 valrhs1 : gdrhs { $$ = mkpguards($1); }
879 | EQUAL exp { $$ = mkpnoguards($2); }
882 gdrhs : gd EQUAL exp { $$ = lsing(mkpgdexp($1,$3)); }
883 | gd EQUAL exp gdrhs { $$ = mklcons(mkpgdexp($1,$3),$4); }
887 WHERE ocurly decls ccurly { $$ = $3; }
888 | WHERE vocurly decls vccurly { $$ = $3; }
889 | /* empty */ { $$ = mknullbind(); }
892 gd : VBAR oexp { $$ = $2; }
896 /**********************************************************************
902 **********************************************************************/
904 exp : oexp DCOLON ctype { $$ = mkrestr($1,$3); }
909 Operators must be left-associative at the same precedence for
910 precedence parsing to work.
912 /* 8 S/R conflicts on qop -> shift */
913 oexp : oexp qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
918 This comes here because of the funny precedence rules concerning
921 dexp : MINUS kexp { $$ = mknegate($2); }
926 We need to factor out a leading let expression so we can set
927 inpat=TRUE when parsing (non let) expressions inside stmts and quals
929 expLno : oexpLno DCOLON ctype { $$ = mkrestr($1,$3); }
932 oexpLno : oexpLno qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
935 dexpLno : MINUS kexp { $$ = mknegate($2); }
939 expL : oexpL DCOLON ctype { $$ = mkrestr($1,$3); }
942 oexpL : oexpL qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
947 let/if/lambda/case have higher precedence than infix operators.
954 kexpL : letdecls IN exp { $$ = mklet($1,$3); }
958 { hsincindent(); /* push new context for FN = NULL; */
959 FN = NULL; /* not actually concerned about indenting */
960 $<ulong>$ = hsplineno; /* remember current line number */
965 RARROW exp /* lambda abstraction */
967 $$ = mklambda($3, $6, $<ulong>2);
971 | IF {$<ulong>$ = hsplineno;}
972 exp THEN exp ELSE exp { $$ = mkife($3,$5,$7,$<ulong>2); }
974 /* Case Expression */
975 | CASE {$<ulong>$ = hsplineno;}
976 exp OF caserest { $$ = mkcasee($3,$5,$<ulong>2); }
979 | DO {$<ulong>$ = hsplineno;}
980 dorest { $$ = mkdoe($3,$<ulong>2); }
982 /* CCALL/CASM Expression */
983 | CCALL ccallid cexps { $$ = mkccall($2,install_literal("n"),$3); }
984 | CCALL ccallid { $$ = mkccall($2,install_literal("n"),Lnil); }
985 | CCALL_GC ccallid cexps { $$ = mkccall($2,install_literal("p"),$3); }
986 | CCALL_GC ccallid { $$ = mkccall($2,install_literal("p"),Lnil); }
987 | CASM CLITLIT cexps { $$ = mkccall($2,install_literal("N"),$3); }
988 | CASM CLITLIT { $$ = mkccall($2,install_literal("N"),Lnil); }
989 | CASM_GC CLITLIT cexps { $$ = mkccall($2,install_literal("P"),$3); }
990 | CASM_GC CLITLIT { $$ = mkccall($2,install_literal("P"),Lnil); }
1003 fexp : fexp aexp { $$ = mkap($1,$2); }
1007 /* simple expressions */
1008 aexp : qvar { $$ = mkident($1); }
1009 | gcon { $$ = mkident($1); }
1010 | lit_constant { $$ = mklit($1); }
1011 | OPAREN exp CPAREN { $$ = mkpar($2); } /* mkpar: stop infix parsing at ()'s */
1012 | qcon OCURLY CCURLY { $$ = mkrecord($1,Lnil); }
1013 | qcon OCURLY rbinds CCURLY { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */
1014 | OBRACK list_exps CBRACK { $$ = mkllist($2); }
1015 | OPAREN exp COMMA texps CPAREN { if (ttree($4) == tuple)
1016 $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
1018 $$ = mktuple(ldub($2, $4)); }
1020 /* only in expressions ... */
1021 | aexp OCURLY rbinds CCURLY { $$ = mkrupdate($1,$3); }
1022 | OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); }
1023 | OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); }
1024 | OBRACK exp COMMA exp DOTDOT CBRACK { $$ = mkeenum($2,mkjust($4),mknothing()); }
1025 | OBRACK exp DOTDOT exp CBRACK { $$ = mkeenum($2,mknothing(),mkjust($4)); }
1026 | OBRACK exp DOTDOT CBRACK { $$ = mkeenum($2,mknothing(),mknothing()); }
1027 | OPAREN oexp qop CPAREN { $$ = mklsection($2,$3); }
1028 | OPAREN qop1 oexp CPAREN { $$ = mkrsection($2,$3); }
1030 /* only in patterns ... */
1031 /* these add 2 S/R conflict with with aexp . OCURLY rbinds CCURLY */
1032 | qvar AT aexp { checkinpat(); $$ = mkas($1,$3); }
1033 | LAZY aexp { checkinpat(); $$ = mklazyp($2); }
1034 | WILDCARD { checkinpat(); $$ = mkwildp(); }
1037 /* ccall arguments */
1038 cexps : cexps aexp { $$ = lapp($1,$2); }
1039 | aexp { $$ = lsing($1); }
1042 caserest: ocurly alts ccurly { $$ = $2; }
1043 | vocurly alts vccurly { $$ = $2; }
1045 dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; }
1046 | vocurly stmts vccurly { checkdostmts($2); $$ = $2; }
1049 rbinds : rbind { $$ = lsing($1); }
1050 | rbinds COMMA rbind { $$ = lapp($1,$3); }
1053 rbind : qvar { $$ = mkrbind($1,mknothing()); }
1054 | qvar EQUAL exp { $$ = mkrbind($1,mkjust($3)); }
1057 texps : exp { $$ = mkpar($1); } /* mkpar: so we don't flatten last element in tuple */
1059 { if (ttree($3) == tuple)
1060 $$ = mktuple(mklcons($1, gtuplelist((struct Stuple *) $3)));
1061 else if (ttree($3) == par)
1062 $$ = mktuple(ldub($1, gpare((struct Spar *) $3)));
1064 hsperror("hsparser:texps: panic");
1066 /* right recursion? WDP */
1071 exp { $$ = lsing($1); }
1072 | exp COMMA list_exps { $$ = mklcons($1, $3); }
1073 /* right recursion? (WDP)
1075 It has to be this way, though, otherwise you
1076 may do the wrong thing to distinguish between...
1078 [ e1 , e2 .. ] -- an enumeration ...
1079 [ e1 , e2 , e3 ] -- a list
1081 (In fact, if you change the grammar and throw yacc/bison
1082 at it, it *will* do the wrong thing [WDP 94/06])
1086 letdecls: LET ocurly decls ccurly { $$ = $3 }
1087 | LET vocurly decls vccurly { $$ = $3 }
1090 quals : qual { $$ = lsing($1); }
1091 | quals COMMA qual { $$ = lapp($1,$3); }
1094 qual : letdecls { $$ = mkseqlet($1); }
1096 | {inpat=TRUE;} expLno {inpat=FALSE;}leftexp
1098 expORpat(LEGIT_EXPR,$2);
1101 expORpat(LEGIT_PATT,$2);
1107 alts : alt { $$ = $1; }
1108 | alts SEMI alt { $$ = lconc($1,$3); }
1111 alt : pat { PREVPATT = $1; } altrest { $$ = lsing($3); PREVPATT = NULL; }
1112 | /* empty */ { $$ = Lnil; }
1115 altrest : gdpat maybe_where { $$ = createpat(mkpguards($1), $2); }
1116 | RARROW exp maybe_where { $$ = createpat(mkpnoguards($2),$3); }
1119 gdpat : gd RARROW exp { $$ = lsing(mkpgdexp($1,$3)); }
1120 | gd RARROW exp gdpat { $$ = mklcons(mkpgdexp($1,$3),$4); }
1123 stmts : stmt { $$ = $1; }
1124 | stmts SEMI stmt { $$ = lconc($1,$3); }
1127 stmt : /* empty */ { $$ = Lnil; }
1128 | letdecls { $$ = lsing(mkseqlet($1)); }
1129 | expL { $$ = lsing($1); }
1130 | {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
1132 expORpat(LEGIT_EXPR,$2);
1133 $$ = lsing(mkdoexp($2,endlineno));
1135 expORpat(LEGIT_PATT,$2);
1136 $$ = lsing(mkdobind($2,$4,endlineno));
1141 leftexp : LARROW exp { $$ = $2; }
1142 | /* empty */ { $$ = NULL; }
1145 /**********************************************************************
1151 **********************************************************************/
1153 pat : pat qconop bpat { $$ = mkinfixap($2,$1,$3); }
1159 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1160 | MINUS INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
1161 | MINUS FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
1164 conpat : gcon { $$ = mkident($1); }
1165 | conpat apat { $$ = mkap($1,$2); }
1168 apat : gcon { $$ = mkident($1); }
1169 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1173 apatc : qvar { $$ = mkident($1); }
1174 | qvar AT apat { $$ = mkas($1,$3); }
1175 | lit_constant { $$ = mklit($1); }
1176 | WILDCARD { $$ = mkwildp(); }
1177 | OPAREN pat CPAREN { $$ = mkpar($2); }
1178 | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1179 | OBRACK pats CBRACK { $$ = mkllist($2); }
1180 | LAZY apat { $$ = mklazyp($2); }
1184 INTEGER { $$ = mkinteger($1); }
1185 | FLOAT { $$ = mkfloatr($1); }
1186 | CHAR { $$ = mkcharr($1); }
1187 | STRING { $$ = mkstring($1); }
1188 | CHARPRIM { $$ = mkcharprim($1); }
1189 | STRINGPRIM { $$ = mkstringprim($1); }
1190 | INTPRIM { $$ = mkintprim($1); }
1191 | FLOATPRIM { $$ = mkfloatprim($1); }
1192 | DOUBLEPRIM { $$ = mkdoubleprim($1); }
1193 | CLITLIT /* yurble yurble */ { $$ = mkclitlit($1); }
1196 lampats : apat lampats { $$ = mklcons($1,$2); }
1197 | apat { $$ = lsing($1); }
1198 /* right recursion? (WDP) */
1201 pats : pat COMMA pats { $$ = mklcons($1, $3); }
1202 | pat { $$ = lsing($1); }
1203 /* right recursion? (WDP) */
1206 rpats : rpat { $$ = lsing($1); }
1207 | rpats COMMA rpat { $$ = lapp($1,$3); }
1210 rpat : qvar { $$ = mkrbind($1,mknothing()); }
1211 | qvar EQUAL pat { $$ = mkrbind($1,mkjust($3)); }
1215 patk : patk qconop bpat { $$ = mkinfixap($2,$1,$3); }
1221 | qconk OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1222 | minuskey INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
1223 | minuskey FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
1226 conpatk : gconk { $$ = mkident($1); }
1227 | conpatk apat { $$ = mkap($1,$2); }
1230 apatck : qvark { $$ = mkident($1); }
1231 | qvark AT apat { $$ = mkas($1,$3); }
1232 | lit_constant { $$ = mklit($1); setstartlineno(); }
1233 | WILDCARD { $$ = mkwildp(); setstartlineno(); }
1234 | oparenkey pat CPAREN { $$ = mkpar($2); }
1235 | oparenkey pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1236 | obrackkey pats CBRACK { $$ = mkllist($2); }
1237 | lazykey apat { $$ = mklazyp($2); }
1242 | OBRACK CBRACK { $$ = creategid(-1); }
1243 | OPAREN CPAREN { $$ = creategid(0); }
1244 | OPAREN commas CPAREN { $$ = creategid($2); }
1248 | obrackkey CBRACK { $$ = creategid(-1); }
1249 | oparenkey CPAREN { $$ = creategid(0); }
1250 | oparenkey commas CPAREN { $$ = creategid($2); }
1253 /**********************************************************************
1256 * Keywords which record the line start *
1259 **********************************************************************/
1261 importkey: IMPORT { setstartlineno(); }
1264 datakey : DATA { setstartlineno();
1267 printf("%u\n",startlineno);
1269 fprintf(stderr,"%u\tdata\n",startlineno);
1274 typekey : TYPE { setstartlineno();
1277 printf("%u\n",startlineno);
1279 fprintf(stderr,"%u\ttype\n",startlineno);
1284 newtypekey : NEWTYPE { setstartlineno();
1287 printf("%u\n",startlineno);
1289 fprintf(stderr,"%u\tnewtype\n",startlineno);
1294 instkey : INSTANCE { setstartlineno();
1297 printf("%u\n",startlineno);
1300 fprintf(stderr,"%u\tinstance\n",startlineno);
1305 defaultkey: DEFAULT { setstartlineno(); }
1308 classkey: CLASS { setstartlineno();
1311 printf("%u\n",startlineno);
1313 fprintf(stderr,"%u\tclass\n",startlineno);
1318 modulekey: MODULE { setstartlineno();
1321 printf("%u\n",startlineno);
1323 fprintf(stderr,"%u\tmodule\n",startlineno);
1328 oparenkey: OPAREN { setstartlineno(); }
1331 obrackkey: OBRACK { setstartlineno(); }
1334 lazykey : LAZY { setstartlineno(); }
1337 minuskey: MINUS { setstartlineno(); }
1341 /**********************************************************************
1344 * Basic qualified/unqualified ids/ops *
1347 **********************************************************************/
1350 | OPAREN qvarsym CPAREN { $$ = $2; }
1353 | OPAREN qconsym CPAREN { $$ = $2; }
1356 | BQUOTE qvarid BQUOTE { $$ = $2; }
1359 | BQUOTE qconid BQUOTE { $$ = $2; }
1365 /* Non "-" op, used in right sections */
1370 /* Non "-" varop, used in right sections */
1372 | varsym_nominus { $$ = mknoqual($1); }
1373 | BQUOTE qvarid BQUOTE { $$ = $2; }
1378 | OPAREN varsym CPAREN { $$ = $2; }
1380 con : tycon /* using tycon removes conflicts */
1381 | OPAREN CONSYM CPAREN { $$ = $2; }
1384 | BQUOTE varid BQUOTE { $$ = $2; }
1387 | BQUOTE CONID BQUOTE { $$ = $2; }
1393 qvark : qvarid { setstartlineno(); $$ = $1; }
1394 | oparenkey qvarsym CPAREN { $$ = $2; }
1396 qconk : qconid { setstartlineno(); $$ = $1; }
1397 | oparenkey qconsym CPAREN { $$ = $2; }
1399 vark : varid { setstartlineno(); $$ = $1; }
1400 | oparenkey varsym CPAREN { $$ = $2; }
1404 | varid { $$ = mknoqual($1); }
1407 | varsym { $$ = mknoqual($1); }
1410 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1413 | CONSYM { $$ = mknoqual($1); }
1416 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1419 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1422 varsym : varsym_nominus
1423 | MINUS { $$ = install_literal("-"); }
1426 /* AS HIDING QUALIFIED are valid varids */
1428 | AS { $$ = install_literal("as"); }
1429 | HIDING { $$ = install_literal("hiding"); }
1430 | QUALIFIED { $$ = install_literal("qualified"); }
1433 /* BANG are valid varsyms */
1434 varsym_nominus : VARSYM
1435 | BANG { $$ = install_literal("!"); }
1442 tyvar : varid { $$ = mknamedtvar(mknoqual($1)); }
1449 tyvar_list: tyvar { $$ = lsing($1); }
1450 | tyvar_list COMMA tyvar { $$ = lapp($1,$3); }
1453 /**********************************************************************
1456 * Stuff to do with layout *
1459 **********************************************************************/
1461 ocurly : layout OCURLY { hsincindent(); }
1463 vocurly : layout { hssetindent(); }
1466 layout : { hsindentoff(); }
1472 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1477 vccurly : { expect_ccurly = 1; } vccurly1 { expect_ccurly = 0; }
1483 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1489 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1496 /**********************************************************************
1498 * Error Processing and Reporting *
1500 * (This stuff is here in case we want to use Yacc macros and such.) *
1502 **********************************************************************/
1508 hsperror("pattern syntax used in expression");
1512 /* The parser calls "hsperror" when it sees a
1513 `report this and die' error. It sets the stage
1514 and calls "yyerror".
1516 There should be no direct calls in the parser to
1517 "yyerror", except for the one from "hsperror". Thus,
1518 the only other calls will be from the error productions
1519 introduced by yacc/bison/whatever.
1521 We need to be able to recognise the from-error-production
1522 case, because we sometimes want to say, "Oh, never mind",
1523 because the layout rule kicks into action and may save
1527 static BOOLEAN error_and_I_mean_it = FALSE;
1533 error_and_I_mean_it = TRUE;
1537 extern char *yytext;
1544 /* We want to be able to distinguish 'error'-raised yyerrors
1545 from yyerrors explicitly coded by the parser hacker.
1547 if (expect_ccurly && ! error_and_I_mean_it ) {
1551 fprintf(stderr, "\"%s\", line %d, column %d: %s on input: ",
1552 input_filename, hsplineno, hspcolno + 1, s);
1554 if (yyleng == 1 && *yytext == '\0')
1555 fprintf(stderr, "<EOF>");
1559 format_string(stderr, (unsigned char *) yytext, yyleng);
1562 fputc('\n', stderr);
1564 /* a common problem */
1565 if (strcmp(yytext, "#") == 0)
1566 fprintf(stderr, "\t(Perhaps you forgot a `-cpp' or `-fglasgow-exts' flag?)\n");
1573 format_string(fp, s, len)
1580 case '\0': fputs("\\NUL", fp); break;
1581 case '\007': fputs("\\a", fp); break;
1582 case '\010': fputs("\\b", fp); break;
1583 case '\011': fputs("\\t", fp); break;
1584 case '\012': fputs("\\n", fp); break;
1585 case '\013': fputs("\\v", fp); break;
1586 case '\014': fputs("\\f", fp); break;
1587 case '\015': fputs("\\r", fp); break;
1588 case '\033': fputs("\\ESC", fp); break;
1589 case '\034': fputs("\\FS", fp); break;
1590 case '\035': fputs("\\GS", fp); break;
1591 case '\036': fputs("\\RS", fp); break;
1592 case '\037': fputs("\\US", fp); break;
1593 case '\177': fputs("\\DEL", fp); break;
1598 fprintf(fp, "\\^%c", *s + '@');