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 */
44 extern BOOLEAN nonstandardFlag;
47 extern VOID find_module_on_imports_dirlist PROTO((char *, BOOLEAN, char *));
49 extern char *input_filename;
50 static char *the_module_name;
51 static char *iface_name;
52 static char iface_filename[FILENAME_SIZE];
54 static maybe module_exports; /* Exported entities */
55 static list prelude_core_import, prelude_imports;
56 /* Entities imported from the Prelude */
63 /* For FN, PREVPATT and SAMEFN macros */
65 extern BOOLEAN samefn[];
66 extern tree prevpatt[];
67 extern short icontexts;
70 extern int hsplineno, hspcolno;
71 extern int modulelineno;
72 extern int startlineno;
75 /**********************************************************************
78 * Fixity and Precedence Declarations *
81 **********************************************************************/
83 /* OLD 95/08: list fixlist; */
84 static int Fixity = 0, Precedence = 0;
87 char *ineg PROTO((char *));
89 int importlineno = 0; /* The line number where an import starts */
91 long inimport; /* Info about current import */
100 extern BOOLEAN inpat; /* True when parsing a pattern */
101 extern BOOLEAN implicitPrelude; /* True when we should read the Prelude if not given */
102 extern BOOLEAN haskell1_2Flag; /* True if we are attempting (proto)Haskell 1.3 */
104 extern int thisIfacePragmaVersion;
129 /**********************************************************************
132 * These are lexemes. *
135 **********************************************************************/
138 %token VARID CONID QVARID QCONID
139 VARSYM CONSYM QVARSYM QCONSYM
141 %token INTEGER FLOAT CHAR STRING
142 CHARPRIM STRINGPRIM INTPRIM FLOATPRIM
147 /**********************************************************************
153 **********************************************************************/
155 %token OCURLY CCURLY VCCURLY SEMI
156 %token OBRACK CBRACK OPAREN CPAREN
160 /**********************************************************************
163 * Reserved Operators *
166 **********************************************************************/
168 %token DOTDOT DCOLON EQUAL
169 %token LAMBDA VBAR RARROW
173 /**********************************************************************
176 * Reserved Identifiers *
179 **********************************************************************/
181 %token CASE CLASS DATA
182 %token DEFAULT DERIVING DO
183 %token ELSE IF IMPORT
184 %token IN INFIX INFIXL
185 %token INFIXR INSTANCE LET
186 %token MODULE NEWTYPE OF
187 %token THEN TYPE WHERE
190 %token CCALL CCALL_GC CASM CASM_GC
193 /**********************************************************************
196 * Valid symbols/identifiers which need to be recognised *
199 **********************************************************************/
201 %token WILDCARD AT LAZY BANG
202 %token AS HIDING QUALIFIED
205 /**********************************************************************
208 * Special Symbols for the Lexer *
211 **********************************************************************/
214 %token GHC_PRAGMA END_PRAGMA NO_PRAGMA NOINFO_PRAGMA SPECIALISE_PRAGMA
215 %token ARITY_PRAGMA UPDATE_PRAGMA STRICTNESS_PRAGMA KIND_PRAGMA
216 %token UNFOLDING_PRAGMA MAGIC_UNFOLDING_PRAGMA DEFOREST_PRAGMA
217 %token SPECIALISE_UPRAGMA INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
218 %token DEFOREST_UPRAGMA END_UPRAGMA
219 %token TYLAMBDA COCON COPRIM COAPP COTYAPP FORALL TYVAR_TEMPLATE_ID
220 %token CO_ALG_ALTS CO_PRIM_ALTS CO_NO_DEFAULT CO_LETREC
221 %token CO_SDSEL_ID CO_METH_ID CO_DEFM_ID CO_DFUN_ID CO_CONSTM_ID
222 %token CO_SPEC_ID CO_WRKR_ID CO_ORIG_NM
223 %token UNFOLD_ALWAYS UNFOLD_IF_ARGS
224 %token NOREP_INTEGER NOREP_RATIONAL NOREP_STRING
225 %token CO_PRELUDE_DICTS_CC CO_ALL_DICTS_CC CO_USER_CC CO_AUTO_CC CO_DICT_CC
226 %token CO_CAF_CC CO_DUPD_CC
228 /**********************************************************************
231 * Precedences of the various tokens *
234 **********************************************************************/
239 SCC CASM CCALL CASM_GC CCALL_GC
241 %left VARSYM CONSYM QVARSYM QCONSYM
242 MINUS BQUOTE BANG DARROW
248 %left OCURLY OBRACK OPAREN
254 /**********************************************************************
257 * Type Declarations *
260 **********************************************************************/
263 %type <ulist> caserest alts alt quals
265 rbinds rpats list_exps
267 constrs constr1 fields
270 pats context context_list tyvar_list
273 impdecls maybeimpdecls impdecl
274 maybefixes fixes fix ops
278 idata_pragma_specs idata_pragma_specslist
279 gen_pragma_list type_pragma_pairs
280 type_pragma_pairs_maybe name_pragma_pairs
282 core_binders core_tyvars core_tv_templates
283 core_types core_type_list
284 core_atoms core_atom_list
285 core_alg_alts core_prim_alts corec_binds
288 %type <umaybe> maybeexports impas maybeimpspec
289 type_maybe core_type_maybe
292 %type <ueither> impspec
294 %type <uliteral> lit_constant
296 %type <utree> exp oexp dexp kexp fexp aexp rbind texps
297 expL oexpL kexpL expLno oexpLno dexpLno kexpLno
299 apat bpat pat apatc conpat dpat fpat opat aapat
300 dpatk fpatk opatk aapatk rpat
303 %type <uid> MINUS DARROW AS LAZY
304 VARID CONID VARSYM CONSYM
306 var con varop conop op
307 vark varid varsym varsym_nominus
308 tycon modid impmod ccallid
310 %type <uqid> QVARID QCONID QVARSYM QCONSYM
311 qvarid qconid qvarsym qconsym
312 qvar qcon qvarop qconop qop
313 qvark qconk qtycon qtycls
314 gcon gconk gtycon qop1 qvarop1
317 %type <ubinding> topdecl topdecls letdecls
318 typed datad newtd classd instd defaultd
319 decl decls valdef instdef instdefs
320 maybeifixes iimport iimports maybeiimports
321 ityped idatad inewtd iclassd iinstd ivarsd
324 interface dointerface readinterface ibody
328 %type <upbinding> valrhs1 altrest
330 %type <uttype> simple ctype type atype btype
331 gtyconapp ntyconapp ntycon gtyconvars
332 bbtype batype btyconapp
333 class restrict_inst general_inst tyvar
336 %type <uconstr> constr field
338 %type <ustring> FLOAT INTEGER INTPRIM
339 FLOATPRIM DOUBLEPRIM CLITLIT
341 %type <uhstring> STRING STRINGPRIM CHAR CHARPRIM
343 %type <uentid> export import
345 %type <uhpragma> idata_pragma inewt_pragma idata_pragma_spectypes
346 iclas_pragma iclasop_pragma
347 iinst_pragma gen_pragma ival_pragma arity_pragma
348 update_pragma strictness_pragma worker_info
350 unfolding_pragma unfolding_guidance type_pragma_pair
353 %type <ucoresyn> core_expr core_case_alts core_id core_binder core_atom
354 core_alg_alt core_prim_alt core_default corec_bind
355 co_primop co_scc co_caf co_dupd
357 %type <ulong> commas impqual
359 /**********************************************************************
362 * Start Symbol for the Parser *
365 **********************************************************************/
374 importmod = install_literal("Prelude");
382 readpreludecore readprelude
392 module : modulekey modid maybeexports
394 the_module_name = $2;
399 the_module_name = install_literal("Main");
400 module_exports = mknothing();
405 body : ocurly { setstartlineno(); } orestm
409 orestm : maybeimpdecls maybefixes topdecls ccurly
411 root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,$2,$3,modulelineno);
415 root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,Lnil,mknullbind(),modulelineno);
418 vrestm : maybeimpdecls maybefixes topdecls vccurly
420 root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,$2,$3,modulelineno);
424 root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,Lnil,mknullbind(),modulelineno);
428 maybeexports : /* empty */ { $$ = mknothing(); }
429 | OPAREN export_list CPAREN { $$ = mkjust($2); }
430 | OPAREN export_list COMMA CPAREN { $$ = mkjust($2); }
434 export { $$ = lsing($1); }
435 | export_list COMMA export { $$ = lapp($1, $3); }
438 export : qvar { $$ = mkentid($1); }
439 | gtycon { $$ = mkenttype($1); }
440 | gtycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
441 | gtycon OPAREN CPAREN { $$ = mkenttypenamed($1,Lnil); }
442 | gtycon OPAREN enames CPAREN { $$ = mkenttypenamed($1,$3); }
443 | MODULE modid { $$ = mkentmod($2); }
446 enames : ename { $$ = lsing($1); }
447 | enames COMMA ename { $$ = lapp($1,$3); }
454 maybeimpdecls : /* empty */ { $$ = Lnil; }
455 | impdecls SEMI { $$ = $1; }
458 impdecls: impdecl { $$ = $1; }
459 | impdecls SEMI impdecl { $$ = lconc($1,$3); }
466 importlineno = startlineno;
468 impqual impmod dointerface impas maybeimpspec
470 $$ = lsing(mkimport(iface_name,xstrdup(iface_filename),$5,
471 $4,$3,$6,$7,importlineno));
483 impmod : modid { $$ = importmod = $1; }
486 impqual : /* noqual */ { $$ = importqual = 0; }
487 | QUALIFIED { $$ = importqual = 1; }
490 impas : /* noas */ { $$ = mknothing(); importas = 0; asmod = NULL; }
491 | AS modid { $$ = mkjust($2); importas = 1; asmod = $2; }
494 maybeimpspec : /* empty */ { $$ = mknothing(); importspec = 0; }
495 | impspec { $$ = mkjust($1); importspec = 1; }
498 impspec : OPAREN CPAREN { $$ = mkleft(Lnil); importhide = 0; importlist = Lnil; }
499 | OPAREN import_list CPAREN { $$ = mkleft($2); importhide = 0; importlist = $2; }
500 | OPAREN import_list COMMA CPAREN { $$ = mkleft($2); importhide = 0; importlist = $2; }
501 | HIDING OPAREN import_list CPAREN { $$ = mkright($3); importhide = 1; importlist = $3; }
502 | HIDING OPAREN import_list COMMA CPAREN { $$ = mkright($3); importhide = 1; importlist = $3; }
506 import { $$ = lsing($1); }
507 | import_list COMMA import { $$ = lapp($1, $3); }
510 import : var { $$ = mkentid(mknoqual($1)); }
511 | tycon { $$ = mkenttype(mknoqual($1)); }
512 | tycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall(mknoqual($1)); }
513 | tycon OPAREN CPAREN { $$ = mkenttypenamed(mknoqual($1),Lnil); }
514 | tycon OPAREN inames CPAREN { $$ = mkenttypenamed(mknoqual($1),$3); }
517 inames : iname { $$ = lsing($1); }
518 | inames COMMA iname { $$ = lapp($1,$3); }
520 iname : var { $$ = mknoqual($1); }
521 | con { $$ = mknoqual($1); }
525 /**********************************************************************
528 * Reading interface files *
531 **********************************************************************/
533 dointerface : { /* filename returned in "iface_filename" */
534 char *module_name = id_to_string(importmod);
536 find_module_on_imports_dirlist(
537 (haskell1_2Flag && strcmp(module_name, "Prelude") == 0)
538 ? "Prel12" : module_name,
539 FALSE, iface_filename);
541 find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
543 if (strcmp(module_name,"PreludeCore")==0) {
544 hsperror("Cannot explicitly import `PreludeCore'");
546 } else if (strcmp(module_name,"Prelude")==0) {
547 prelude_imports = prelude_core_import; /* unavoidable */
549 thisIfacePragmaVersion = 0;
550 setyyin(iface_filename);
557 if ( implicitPrelude && !etags ) {
558 /* we try to avoid reading interfaces when etagging */
559 find_module_on_imports_dirlist(
560 (haskell1_2Flag) ? "PrelCore12" : "PreludeCore",
561 TRUE,iface_filename);
563 find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
565 thisIfacePragmaVersion = 0;
566 setyyin(iface_filename);
570 binding prelude_core = mkimport(iface_name,xstrdup(iface_filename),$2,
571 install_literal("PreludeCore"),
572 0,mknothing(),mknothing(),0);
573 prelude_core_import = (! implicitPrelude) ? Lnil : lsing(prelude_core);
578 if ( implicitPrelude && !etags ) {
579 find_module_on_imports_dirlist(
580 ( haskell1_2Flag ) ? "Prel12" : "Prelude",
581 TRUE,iface_filename);
583 find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
585 thisIfacePragmaVersion = 0;
586 setyyin(iface_filename);
590 binding prelude = mkimport(iface_name,xstrdup(iface_filename),$2,
591 install_literal("Prelude"),
592 0,mknothing(),mknothing(),0);
593 prelude_imports = (! implicitPrelude) ? Lnil
594 : lconc(prelude_core_import,lsing(prelude));
616 ibody : ocurly maybeiimports maybeifixes itopdecls ccurly
618 $$ = mkabind($2,mkabind($3,$4));
620 | ocurly iimports ccurly
624 | vocurly maybeiimports maybeifixes itopdecls vccurly
626 $$ = mkabind($2,mkabind($3,$4));
628 | vocurly iimports vccurly
634 maybeifixes: /* empty */ { $$ = mknullbind(); }
635 | fixes SEMI { $$ = mkmfbind($1); }
638 maybeiimports : /* empty */ { $$ = mknullbind(); }
639 | iimports SEMI { $$ = $1; }
642 iimports : iimport { $$ = $1; }
643 | iimports SEMI iimport { $$ = mkabind($1,$3); }
646 iimport : importkey modid OPAREN import_list CPAREN
647 { $$ = mkmbind($2,$4,startlineno); }
651 itopdecls : itopdecl { $$ = $1; }
652 | itopdecls SEMI itopdecl { $$ = mkabind($1,$3); }
655 itopdecl: ityped { $$ = $1; }
656 | idatad { $$ = $1; }
657 | inewtd { $$ = $1; }
658 | iclassd { $$ = $1; }
659 | iinstd { $$ = $1; }
660 | ivarsd { $$ = $1; }
661 | /* empty */ { $$ = mknullbind(); }
664 ivarsd : qvarsk DCOLON ctype ival_pragma
665 { $$ = mksbind($1,$3,startlineno,$4); }
668 ityped : typekey simple EQUAL type
669 { $$ = mknbind($2,$4,startlineno); }
672 idatad : datakey simple idata_pragma
673 { $$ = mktbind(Lnil,$2,Lnil,mknothing(),startlineno,$3); }
674 | datakey simple EQUAL constrs idata_pragma
675 { $$ = mktbind(Lnil,$2,$4,mknothing(),startlineno,$5); }
676 | datakey context DARROW simple idata_pragma
677 { $$ = mktbind($2,$4,Lnil,mknothing(),startlineno,$5); }
678 | datakey context DARROW simple EQUAL constrs idata_pragma
679 { $$ = mktbind($2,$4,$6,mknothing(),startlineno,$7); }
682 inewtd : newtypekey simple inewt_pragma
683 { $$ = mkntbind(Lnil,$2,Lnil,mknothing(),startlineno,$3); }
684 | newtypekey simple EQUAL constr1 inewt_pragma
685 { $$ = mkntbind(Lnil,$2,$4,mknothing(),startlineno,$5); }
686 | newtypekey context DARROW simple inewt_pragma
687 { $$ = mkntbind($2,$4,Lnil,mknothing(),startlineno,$5); }
688 | newtypekey context DARROW simple EQUAL constr1 inewt_pragma
689 { $$ = mkntbind($2,$4,$6,mknothing(),startlineno,$7); }
692 iclassd : classkey context DARROW class iclas_pragma cbody
693 { $$ = mkcbind($2,$4,$6,startlineno,$5); }
694 | classkey class iclas_pragma cbody
695 { $$ = mkcbind(Lnil,$2,$4,startlineno,$3); }
698 iinstd : instkey modid context DARROW gtycon general_inst iinst_pragma
699 { $$ = mkibind(0/*not source*/,$2,$3,$5,$6,mknullbind(),startlineno,$7); }
700 | instkey modid gtycon general_inst iinst_pragma
701 { $$ = mkibind(0/*not source*/,$2,Lnil,$3,$4,mknullbind(),startlineno,$5); }
705 /**********************************************************************
708 * Interface pragma stuff *
711 **********************************************************************/
714 GHC_PRAGMA constrs idata_pragma_specs END_PRAGMA
715 { $$ = mkidata_pragma($2, $3); }
716 | GHC_PRAGMA idata_pragma_specs END_PRAGMA
717 { $$ = mkidata_pragma(Lnil, $2); }
718 | /* empty */ { $$ = mkno_pragma(); }
722 GHC_PRAGMA constr1 idata_pragma_specs END_PRAGMA
723 { $$ = mkidata_pragma($2, $3); }
724 | GHC_PRAGMA idata_pragma_specs END_PRAGMA
725 { $$ = mkidata_pragma(Lnil, $2); }
726 | /* empty */ { $$ = mkno_pragma(); }
730 SPECIALISE_PRAGMA idata_pragma_specslist
732 | /* empty */ { $$ = Lnil; }
735 idata_pragma_specslist:
736 idata_pragma_spectypes { $$ = lsing($1); }
737 | idata_pragma_specslist COMMA idata_pragma_spectypes
738 { $$ = lapp($1, $3); }
741 idata_pragma_spectypes:
742 OBRACK type_maybes CBRACK { $$ = mkidata_pragma_4s($2); }
746 GHC_PRAGMA gen_pragma_list END_PRAGMA { $$ = mkiclas_pragma($2); }
747 | /* empty */ { $$ = mkno_pragma(); }
751 GHC_PRAGMA gen_pragma gen_pragma END_PRAGMA
752 { $$ = mkiclasop_pragma($2, $3); }
754 { $$ = mkno_pragma(); }
758 GHC_PRAGMA gen_pragma END_PRAGMA
759 { $$ = mkiinst_simpl_pragma($2); }
761 | GHC_PRAGMA gen_pragma name_pragma_pairs END_PRAGMA
762 { $$ = mkiinst_const_pragma($2, $3); }
765 { $$ = mkno_pragma(); }
769 GHC_PRAGMA gen_pragma END_PRAGMA
772 { $$ = mkno_pragma(); }
777 { $$ = mkno_pragma(); }
778 | arity_pragma update_pragma deforest_pragma strictness_pragma unfolding_pragma type_pragma_pairs_maybe
779 { $$ = mkigen_pragma($1, $2, $3, $4, $5, $6); }
783 NO_PRAGMA { $$ = mkno_pragma(); }
784 | ARITY_PRAGMA INTEGER { $$ = mkiarity_pragma($2); }
788 NO_PRAGMA { $$ = mkno_pragma(); }
789 | UPDATE_PRAGMA INTEGER { $$ = mkiupdate_pragma($2); }
793 NO_PRAGMA { $$ = mkno_pragma(); }
794 | DEFOREST_PRAGMA { $$ = mkideforest_pragma(); }
798 NO_PRAGMA { $$ = mkno_pragma(); }
799 | STRICTNESS_PRAGMA COCON { $$ = mkistrictness_pragma(installHstring(1, "B"),
800 /* _!_ = COCON = bottom */ mkno_pragma());
802 | STRICTNESS_PRAGMA STRING worker_info
803 { $$ = mkistrictness_pragma($2, $3); }
807 OCURLY gen_pragma CCURLY { $$ = $2; }
808 | /* empty */ { $$ = mkno_pragma(); }
811 NO_PRAGMA { $$ = mkno_pragma(); }
812 | MAGIC_UNFOLDING_PRAGMA vark
813 { $$ = mkimagic_unfolding_pragma($2); }
814 | UNFOLDING_PRAGMA unfolding_guidance core_expr
815 { $$ = mkiunfolding_pragma($2, $3); }
820 { $$ = mkiunfold_always(); }
821 | UNFOLD_IF_ARGS INTEGER INTEGER CONID INTEGER
822 { $$ = mkiunfold_if_args($2, $3, $4, $5); }
826 gen_pragma { $$ = lsing($1); }
827 | gen_pragma_list COMMA gen_pragma { $$ = lapp($1, $3); }
830 type_pragma_pairs_maybe:
831 NO_PRAGMA { $$ = Lnil; }
832 | SPECIALISE_PRAGMA type_pragma_pairs { $$ = $2; }
835 /* 1 S/R conflict at COMMA -> shift */
837 type_pragma_pair { $$ = lsing($1); }
838 | type_pragma_pairs COMMA type_pragma_pair { $$ = lapp($1, $3); }
842 OBRACK type_maybes CBRACK INTEGER worker_info
843 { $$ = mkitype_pragma_pr($2, $4, $5); }
847 type_maybe { $$ = lsing($1); }
848 | type_maybes COMMA type_maybe { $$ = lapp($1, $3); }
852 NO_PRAGMA { $$ = mknothing(); }
853 | type { $$ = mkjust($1); }
857 name_pragma_pair { $$ = lsing($1); }
858 | name_pragma_pairs COMMA name_pragma_pair { $$ = lapp($1, $3); }
862 /* if the gen_pragma concludes with a *comma*-separated SPECs list,
863 we get a parse error --- we have to bracket the gen_pragma
866 var EQUAL OCURLY gen_pragma CCURLY
867 { $$ = mkiname_pragma_pr($1, $4); }
870 /**********************************************************************
873 * Core syntax stuff *
876 **********************************************************************/
879 LAMBDA core_binders RARROW core_expr
880 { $$ = mkcolam($2, $4); }
881 | TYLAMBDA core_tyvars RARROW core_expr
882 { $$ = mkcotylam($2, $4); }
883 | COCON con core_types core_atoms
884 { $$ = mkcocon(mkco_id($2), $3, $4); }
885 | COCON CO_ORIG_NM modid con core_types core_atoms
886 { $$ = mkcocon(mkco_orig_id($3,$4), $5, $6); }
887 | COPRIM co_primop core_types core_atoms
888 { $$ = mkcoprim($2, $3, $4); }
889 | COAPP core_expr core_atoms
890 { $$ = mkcoapp($2, $3); }
891 | COTYAPP core_expr OCURLY core_type CCURLY
892 { $$ = mkcotyapp($2, $4); }
893 | CASE core_expr OF OCURLY core_case_alts CCURLY
894 { $$ = mkcocase($2, $5); }
895 | LET OCURLY core_binder EQUAL core_expr CCURLY IN core_expr
896 { $$ = mkcolet(mkcononrec($3, $5), $8); }
897 | CO_LETREC OCURLY corec_binds CCURLY IN core_expr
898 { $$ = mkcolet(mkcorec($3), $6); }
899 | SCC OCURLY co_scc CCURLY core_expr
900 { $$ = mkcoscc($3, $5); }
901 | lit_constant { $$ = mkcoliteral($1); }
902 | core_id { $$ = mkcovar($1); }
906 CO_ALG_ALTS core_alg_alts core_default
907 { $$ = mkcoalg_alts($2, $3); }
908 | CO_PRIM_ALTS core_prim_alts core_default
909 { $$ = mkcoprim_alts($2, $3); }
913 /* empty */ { $$ = Lnil; }
914 | core_alg_alts core_alg_alt { $$ = lapp($1, $2); }
918 core_id core_binders RARROW core_expr SEMI { $$ = mkcoalg_alt($1, $2, $4); }
919 /* core_id is really too generous */
923 /* empty */ { $$ = Lnil; }
924 | core_prim_alts core_prim_alt { $$ = lapp($1, $2); }
928 lit_constant RARROW core_expr SEMI { $$ = mkcoprim_alt($1, $3); }
932 CO_NO_DEFAULT { $$ = mkconodeflt(); }
933 | core_binder RARROW core_expr { $$ = mkcobinddeflt($1, $3); }
937 corec_bind { $$ = lsing($1); }
938 | corec_binds SEMI corec_bind { $$ = lapp($1, $3); }
942 core_binder EQUAL core_expr { $$ = mkcorec_pair($1, $3); }
946 CO_PRELUDE_DICTS_CC co_dupd { $$ = mkco_preludedictscc($2); }
947 | CO_ALL_DICTS_CC STRING STRING co_dupd { $$ = mkco_alldictscc($2,$3,$4); }
948 | CO_USER_CC STRING STRING STRING co_dupd co_caf
949 { $$ = mkco_usercc($2,$3,$4,$5,$6); }
950 | CO_AUTO_CC core_id STRING STRING co_dupd co_caf
951 { $$ = mkco_autocc($2,$3,$4,$5,$6); }
952 | CO_DICT_CC core_id STRING STRING co_dupd co_caf
953 { $$ = mkco_dictcc($2,$3,$4,$5,$6); }
955 co_caf : NO_PRAGMA { $$ = mkco_scc_noncaf(); }
956 | CO_CAF_CC { $$ = mkco_scc_caf(); }
958 co_dupd : NO_PRAGMA { $$ = mkco_scc_nondupd(); }
959 | CO_DUPD_CC { $$ = mkco_scc_dupd(); }
961 core_id: /* more to come?? */
962 CO_SDSEL_ID tycon tycon { $$ = mkco_sdselid($2, $3); }
963 | CO_METH_ID tycon var { $$ = mkco_classopid($2, $3); }
964 | CO_DEFM_ID tycon var { $$ = mkco_defmid($2, $3); }
965 | CO_DFUN_ID tycon OPAREN core_type CPAREN
966 { $$ = mkco_dfunid($2, $4); }
967 | CO_CONSTM_ID tycon var OPAREN core_type CPAREN
968 { $$ = mkco_constmid($2, $3, $5); }
969 | CO_SPEC_ID core_id OBRACK core_type_maybes CBRACK
970 { $$ = mkco_specid($2, $4); }
971 | CO_WRKR_ID core_id { $$ = mkco_wrkrid($2); }
972 | CO_ORIG_NM modid var { $$ = mkco_orig_id($2, $3); }
973 | CO_ORIG_NM modid con { $$ = mkco_orig_id($2, $3); }
974 | var { $$ = mkco_id($1); }
975 | con { $$ = mkco_id($1); }
979 OPAREN CCALL ccallid OCURLY core_types core_type CCURLY CPAREN
980 { $$ = mkco_ccall($3,0,$5,$6); }
981 | OPAREN CCALL_GC ccallid OCURLY core_types core_type CCURLY CPAREN
982 { $$ = mkco_ccall($3,1,$5,$6); }
983 | OPAREN CASM lit_constant OCURLY core_types core_type CCURLY CPAREN
984 { $$ = mkco_casm($3,0,$5,$6); }
985 | OPAREN CASM_GC lit_constant OCURLY core_types core_type CCURLY CPAREN
986 { $$ = mkco_casm($3,1,$5,$6); }
987 | VARID { $$ = mkco_primop($1); }
991 /* empty */ { $$ = Lnil; }
992 | core_binders core_binder { $$ = lapp($1, $2); }
996 OPAREN VARID DCOLON core_type CPAREN { $$ = mkcobinder($2, $4); }
999 OBRACK CBRACK { $$ = Lnil; }
1000 | OBRACK core_atom_list CBRACK { $$ = $2; }
1004 core_atom { $$ = lsing($1); }
1005 | core_atom_list COMMA core_atom { $$ = lapp($1, $3); }
1009 lit_constant { $$ = mkcolit($1); }
1010 | core_id { $$ = mkcolocal($1); }
1014 VARID { $$ = lsing($1); }
1015 | core_tyvars VARID { $$ = lapp($1, $2); }
1019 TYVAR_TEMPLATE_ID { $$ = lsing($1); }
1020 | core_tv_templates COMMA TYVAR_TEMPLATE_ID { $$ = lapp($1, $3); }
1024 OBRACK CBRACK { $$ = Lnil; }
1025 | OBRACK core_type_list CBRACK { $$ = $2; }
1029 core_type { $$ = lsing($1); }
1030 | core_type_list COMMA core_type { $$ = lapp($1, $3); }
1039 FORALL core_tv_templates DARROW core_type
1040 { $$ = mkuniforall($2, $4); }
1041 | OCURLY OCURLY CONID core_type CCURLY CCURLY RARROW core_type
1042 { $$ = mktfun(mkunidict($3, $4), $8); }
1043 | OCURLY OCURLY CONID core_type CCURLY CCURLY
1044 { $$ = mkunidict($3, $4); }
1045 | OPAREN OCURLY OCURLY CONID core_type CCURLY CCURLY COMMA core_type_list CPAREN RARROW core_type
1046 { $$ = mktfun(mkttuple(mklcons(mkunidict($4, $5), $9)), $12); }
1047 | OPAREN OCURLY OCURLY CONID core_type CCURLY CCURLY COMMA core_type_list CPAREN
1048 { $$ = mkttuple(mklcons(mkunidict($4,$5), $9)); }
1054 core_type_maybe { $$ = lsing($1); }
1055 | core_type_maybes COMMA core_type_maybe { $$ = lapp($1, $3); }
1059 NO_PRAGMA { $$ = mknothing(); }
1060 | core_type { $$ = mkjust($1); }
1064 /**********************************************************************
1067 * Fixes and Decls etc *
1070 **********************************************************************/
1072 maybefixes: /* empty */ { $$ = Lnil; }
1073 | fixes SEMI { $$ = $1; }
1076 fixes : fix { $$ = $1; }
1077 | fixes SEMI fix { $$ = lconc($1,$3); }
1080 fix : INFIXL INTEGER { Precedence = checkfixity($2); Fixity = INFIXL; }
1082 | INFIXR INTEGER { Precedence = checkfixity($2); Fixity = INFIXR; }
1084 | INFIX INTEGER { Precedence = checkfixity($2); Fixity = INFIX; }
1086 | INFIXL { Fixity = INFIXL; Precedence = 9; }
1088 | INFIXR { Fixity = INFIXR; Precedence = 9; }
1090 | INFIX { Fixity = INFIX; Precedence = 9; }
1094 ops : op { makeinfix($1,Fixity,Precedence,the_module_name,
1095 inimport,importas,importmod,asmod,importqual,
1096 importspec,importhide,importlist);
1097 $$ = lsing(mkfixop($1,infixint(Fixity),Precedence));
1099 | ops COMMA op { makeinfix($3,Fixity,Precedence,the_module_name,
1100 inimport,importas,importmod,asmod,importqual,
1101 importspec,importhide,importlist);
1102 $$ = lapp($1,mkfixop($3,infixint(Fixity),Precedence));
1107 | topdecls SEMI topdecl
1117 $$ = mkabind($1,$3);
1126 topdecl : typed { $$ = $1; }
1127 | datad { $$ = $1; }
1128 | newtd { $$ = $1; }
1129 | classd { $$ = $1; }
1130 | instd { $$ = $1; }
1131 | defaultd { $$ = $1; }
1135 typed : typekey simple EQUAL type { $$ = mknbind($2,$4,startlineno); }
1139 datad : datakey simple EQUAL constrs
1140 { $$ = mktbind(Lnil,$2,$4,mknothing(),startlineno,mkno_pragma()); }
1141 | datakey simple EQUAL constrs DERIVING dtyclses
1142 { $$ = mktbind(Lnil,$2,$4,mkjust($6),startlineno,mkno_pragma()); }
1143 | datakey context DARROW simple EQUAL constrs
1144 { $$ = mktbind($2,$4,$6,mknothing(),startlineno,mkno_pragma()); }
1145 | datakey context DARROW simple EQUAL constrs DERIVING dtyclses
1146 { $$ = mktbind($2,$4,$6,mkjust($8),startlineno,mkno_pragma()); }
1149 newtd : newtypekey simple EQUAL constr1
1150 { $$ = mkntbind(Lnil,$2,$4,mknothing(),startlineno,mkno_pragma()); }
1151 | newtypekey simple EQUAL constr1 DERIVING dtyclses
1152 { $$ = mkntbind(Lnil,$2,$4,mkjust($6),startlineno,mkno_pragma()); }
1153 | newtypekey context DARROW simple EQUAL constr1
1154 { $$ = mkntbind($2,$4,$6,mknothing(),startlineno,mkno_pragma()); }
1155 | newtypekey context DARROW simple EQUAL constr1 DERIVING dtyclses
1156 { $$ = mkntbind($2,$4,$6,mkjust($8),startlineno,mkno_pragma()); }
1159 classd : classkey context DARROW class cbody { $$ = mkcbind($2,$4,$5,startlineno,mkno_pragma()); }
1160 | classkey class cbody { $$ = mkcbind(Lnil,$2,$3,startlineno,mkno_pragma()); }
1163 cbody : /* empty */ { $$ = mknullbind(); }
1164 | WHERE ocurly decls ccurly { checkorder($3); $$ = $3; }
1165 | WHERE vocurly decls vccurly { checkorder($3); $$ = $3; }
1168 instd : instkey context DARROW gtycon restrict_inst rinst
1169 { $$ = mkibind(1/*source*/,the_module_name,$2,$4,$5,$6,startlineno,mkno_pragma()); }
1170 | instkey gtycon general_inst rinst
1171 { $$ = mkibind(1/*source*/,the_module_name,Lnil,$2,$3,$4,startlineno,mkno_pragma()); }
1174 rinst : /* empty */ { $$ = mknullbind(); }
1175 | WHERE ocurly instdefs ccurly { $$ = $3; }
1176 | WHERE vocurly instdefs vccurly { $$ = $3; }
1179 restrict_inst : gtycon { $$ = mktname($1); }
1180 | OPAREN gtyconvars CPAREN { $$ = $2; }
1181 | OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); }
1182 | OBRACK tyvar CBRACK { $$ = mktllist($2); }
1183 | OPAREN tyvar RARROW tyvar CPAREN { $$ = mktfun($2,$4); }
1186 general_inst : gtycon { $$ = mktname($1); }
1187 | OPAREN gtyconapp CPAREN { $$ = $2; }
1188 | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
1189 | OBRACK type CBRACK { $$ = mktllist($2); }
1190 | OPAREN btype RARROW type CPAREN { $$ = mktfun($2,$4); }
1193 defaultd: defaultkey OPAREN types CPAREN { $$ = mkdbind($3,startlineno); }
1194 | defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); }
1206 $$ = mkabind($1,$3);
1212 Note: if there is an iclasop_pragma here, then we must be
1213 doing a class-op in an interface -- unless the user is up
1214 to real mischief (ugly, but likely to work).
1217 decl : qvarsk DCOLON ctype iclasop_pragma
1218 { $$ = mksbind($1,$3,startlineno,$4);
1219 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1221 /* User-specified pragmas come in as "signatures"...
1222 They are similar in that they can appear anywhere in the module,
1223 and have to be "joined up" with their related entity.
1225 Have left out the case specialising to an overloaded type.
1226 Let's get real, OK? (WDP)
1228 | SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
1230 $$ = mkvspec_uprag($2, $4, startlineno);
1231 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1234 | SPECIALISE_UPRAGMA INSTANCE gtycon general_inst END_UPRAGMA
1236 $$ = mkispec_uprag($3, $4, startlineno);
1237 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1240 | SPECIALISE_UPRAGMA DATA gtycon atypes END_UPRAGMA
1242 $$ = mkdspec_uprag($3, $4, startlineno);
1243 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1246 | INLINE_UPRAGMA qvark END_UPRAGMA
1248 $$ = mkinline_uprag($2, startlineno);
1249 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1252 | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
1254 $$ = mkmagicuf_uprag($2, $3, startlineno);
1255 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1258 | DEFOREST_UPRAGMA qvark END_UPRAGMA
1260 $$ = mkdeforest_uprag($2, startlineno);
1261 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1264 /* end of user-specified pragmas */
1267 | /* empty */ { $$ = mknullbind(); PREVPATT = NULL; FN = NULL; SAMEFN = 0; }
1270 qvarsk : qvark COMMA qvars_list { $$ = mklcons($1,$3); }
1271 | qvark { $$ = lsing($1); }
1274 qvars_list: qvar { $$ = lsing($1); }
1275 | qvars_list COMMA qvar { $$ = lapp($1,$3); }
1278 types_and_maybe_ids :
1279 type_and_maybe_id { $$ = lsing($1); }
1280 | types_and_maybe_ids COMMA type_and_maybe_id { $$ = lapp($1,$3); }
1284 type { $$ = mkvspec_ty_and_id($1,mknothing()); }
1285 | type EQUAL qvark { $$ = mkvspec_ty_and_id($1,mkjust($3)); }
1288 /**********************************************************************
1294 **********************************************************************/
1296 /* "DCOLON context => type" vs "DCOLON type" is a problem,
1297 because you can't distinguish between
1299 foo :: (Baz a, Baz a)
1300 bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
1302 with one token of lookahead. The HACK is to have "DCOLON ttype"
1303 [tuple type] in the first case, then check that it has the right
1304 form C a, or (C1 a, C2 b, ... Cn z) and convert it into a
1308 /* 1 S/R conflict at DARROW -> shift */
1309 ctype : type DARROW type { $$ = mkcontext(type2context($1),$3); }
1313 /* 1 S/R conflict at RARROW -> shift */
1314 type : btype { $$ = $1; }
1315 | btype RARROW type { $$ = mktfun($1,$3); }
1317 | FORALL core_tv_templates DARROW type { $$ = mkuniforall($2, $4); }
1320 /* btype is split so we can parse gtyconapp without S/R conflicts */
1321 btype : gtyconapp { $$ = $1; }
1322 | ntyconapp { $$ = $1; }
1325 ntyconapp: ntycon { $$ = $1; }
1326 | ntyconapp atype { $$ = mktapp($1,$2); }
1329 gtyconapp: gtycon { $$ = mktname($1); }
1330 | gtyconapp atype { $$ = mktapp($1,$2); }
1334 atype : gtycon { $$ = mktname($1); }
1335 | ntycon { $$ = $1; }
1338 ntycon : tyvar { $$ = $1; }
1339 | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
1340 | OBRACK type CBRACK { $$ = mktllist($2); }
1341 | OPAREN type CPAREN { $$ = $2; }
1343 | OCURLY OCURLY gtycon type CCURLY CCURLY { $$ = mkunidict($3, $4); }
1344 | TYVAR_TEMPLATE_ID { $$ = mkunityvartemplate($1); }
1348 | OPAREN RARROW CPAREN { $$ = creategid(-2); }
1349 | OBRACK CBRACK { $$ = creategid(-1); }
1350 | OPAREN CPAREN { $$ = creategid(0); }
1351 | OPAREN commas CPAREN { $$ = creategid($2); }
1354 atypes : atype { $$ = lsing($1); }
1355 | atypes atype { $$ = lapp($1,$2); }
1358 types : type { $$ = lsing($1); }
1359 | types COMMA type { $$ = lapp($1,$3); }
1362 commas : COMMA { $$ = 1; }
1363 | commas COMMA { $$ = $1 + 1; }
1366 /**********************************************************************
1369 * Declaration stuff *
1372 **********************************************************************/
1374 simple : gtycon { $$ = mktname($1); }
1375 | gtyconvars { $$ = $1; }
1378 gtyconvars: gtycon tyvar { $$ = mktapp(mktname($1),$2); }
1379 | gtyconvars tyvar { $$ = mktapp($1,$2); }
1382 context : OPAREN context_list CPAREN { $$ = $2; }
1383 | class { $$ = lsing($1); }
1386 context_list: class { $$ = lsing($1); }
1387 | context_list COMMA class { $$ = lapp($1,$3); }
1390 class : gtycon tyvar { $$ = mktapp(mktname($1),$2); }
1393 constrs : constr { $$ = lsing($1); }
1394 | constrs VBAR constr { $$ = lapp($1,$3); }
1397 constr : btyconapp { qid tyc; list tys;
1398 splittyconapp($1, &tyc, &tys);
1399 $$ = mkconstrpre(tyc,tys,hsplineno); }
1400 | OPAREN qconsym CPAREN { $$ = mkconstrpre($2,Lnil,hsplineno); }
1401 | OPAREN qconsym CPAREN batypes { $$ = mkconstrpre($2,$4,hsplineno); }
1402 | btyconapp qconop bbtype { checknobangs($1);
1403 $$ = mkconstrinf($1,$2,$3,hsplineno); }
1404 | ntyconapp qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
1405 | BANG atype qconop bbtype { $$ = mkconstrinf(mktbang($2),$3,$4,hsplineno); }
1407 /* 1 S/R conflict on OCURLY -> shift */
1408 | gtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
1411 btyconapp: gtycon { $$ = mktname($1); }
1412 | btyconapp batype { $$ = mktapp($1,$2); }
1415 bbtype : btype { $$ = $1; }
1416 | BANG atype { $$ = mktbang($2); }
1419 batype : atype { $$ = $1; }
1420 | BANG atype { $$ = mktbang($2); }
1423 batypes : batype { $$ = lsing($1); }
1424 | batypes batype { $$ = lapp($1,$2); }
1428 fields : field { $$ = lsing($1); }
1429 | fields COMMA field { $$ = lapp($1,$3); }
1432 field : qvars_list DCOLON type { $$ = mkfield($1,$3); }
1433 | qvars_list DCOLON BANG atype { $$ = mkfield($1,mktbang($4)); }
1436 constr1 : gtycon atype { $$ = lsing(mkconstrnew($1,$2,hsplineno)); }
1440 dtyclses: OPAREN dtycls_list CPAREN { $$ = $2; }
1441 | OPAREN CPAREN { $$ = Lnil; }
1442 | qtycls { $$ = lsing($1); }
1445 dtycls_list: qtycls { $$ = lsing($1); }
1446 | dtycls_list COMMA qtycls { $$ = lapp($1,$3); }
1449 instdefs : /* empty */ { $$ = mknullbind(); }
1450 | instdef { $$ = $1; }
1451 | instdefs SEMI instdef
1459 $$ = mkabind($1,$3);
1463 /* instdef: same as valdef, except certain user-pragmas may appear */
1465 SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
1467 $$ = mkvspec_uprag($2, $4, startlineno);
1468 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1471 | INLINE_UPRAGMA qvark END_UPRAGMA
1473 $$ = mkinline_uprag($2, startlineno);
1474 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1477 | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
1479 $$ = mkmagicuf_uprag($2, $3, startlineno);
1480 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1489 tree fn = function($1);
1492 if(ttree(fn) == ident)
1494 qid fun_id = gident((struct Sident *) fn);
1495 checksamefn(fun_id);
1499 else if (ttree(fn) == infixap)
1501 qid fun_id = ginffun((struct Sinfixap *) fn);
1502 checksamefn(fun_id);
1508 printf("%u\n",startlineno);
1510 fprintf(stderr,"%u\tvaldef\n",startlineno);
1515 if ( lhs_is_patt($1) )
1517 $$ = mkpbind($3, startlineno);
1521 else /* lhs is function */
1522 $$ = mkfbind($3,startlineno);
1528 valrhs : valrhs1 maybe_where { $$ = lsing(createpat($1, $2)); }
1531 valrhs1 : gdrhs { $$ = mkpguards($1); }
1532 | EQUAL exp { $$ = mkpnoguards($2); }
1535 gdrhs : gd EQUAL exp { $$ = lsing(mkpgdexp($1,$3)); }
1536 | gd EQUAL exp gdrhs { $$ = mklcons(mkpgdexp($1,$3),$4); }
1540 WHERE ocurly decls ccurly { $$ = $3; }
1541 | WHERE vocurly decls vccurly { $$ = $3; }
1542 | /* empty */ { $$ = mknullbind(); }
1545 gd : VBAR oexp { $$ = $2; }
1549 /**********************************************************************
1555 **********************************************************************/
1557 exp : oexp DCOLON ctype { $$ = mkrestr($1,$3); }
1562 Operators must be left-associative at the same precedence for
1563 precedence parsing to work.
1565 /* 9 S/R conflicts on qop -> shift */
1566 oexp : oexp qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); precparse($$); }
1571 This comes here because of the funny precedence rules concerning
1574 dexp : MINUS kexp { $$ = mknegate($2,NULL,NULL); }
1579 We need to factor out a leading let expression so we can set
1580 inpat=TRUE when parsing (non let) expressions inside stmts and quals
1582 expLno : oexpLno DCOLON ctype { $$ = mkrestr($1,$3); }
1585 oexpLno : oexpLno qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); precparse($$); }
1588 dexpLno : MINUS kexp { $$ = mknegate($2,NULL,NULL); }
1592 expL : oexpL DCOLON ctype { $$ = mkrestr($1,$3); }
1595 oexpL : oexpL qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); precparse($$); }
1600 let/if/lambda/case have higher precedence than infix operators.
1607 kexpL : letdecls IN exp { $$ = mklet($1,$3); }
1611 { hsincindent(); /* push new context for FN = NULL; */
1612 FN = NULL; /* not actually concerned about indenting */
1613 $<ulong>$ = hsplineno; /* remember current line number */
1618 RARROW exp /* lambda abstraction */
1620 $$ = mklambda($3, $6, $<ulong>2);
1624 | IF {$<ulong>$ = hsplineno;}
1625 exp THEN exp ELSE exp { $$ = mkife($3,$5,$7,$<ulong>2); }
1627 /* Case Expression */
1628 | CASE {$<ulong>$ = hsplineno;}
1629 exp OF caserest { $$ = mkcasee($3,$5,$<ulong>2); }
1632 | DO {$<ulong>$ = hsplineno;}
1633 dorest { $$ = mkdoe($3,$<ulong>2); }
1635 /* CCALL/CASM Expression */
1636 | CCALL ccallid cexps { $$ = mkccall($2,install_literal("n"),$3); }
1637 | CCALL ccallid { $$ = mkccall($2,install_literal("n"),Lnil); }
1638 | CCALL_GC ccallid cexps { $$ = mkccall($2,install_literal("p"),$3); }
1639 | CCALL_GC ccallid { $$ = mkccall($2,install_literal("p"),Lnil); }
1640 | CASM CLITLIT cexps { $$ = mkccall($2,install_literal("N"),$3); }
1641 | CASM CLITLIT { $$ = mkccall($2,install_literal("N"),Lnil); }
1642 | CASM_GC CLITLIT cexps { $$ = mkccall($2,install_literal("P"),$3); }
1643 | CASM_GC CLITLIT { $$ = mkccall($2,install_literal("P"),Lnil); }
1645 /* SCC Expression */
1656 fexp : fexp aexp { $$ = mkap($1,$2); }
1660 /* simple expressions */
1661 aexp : qvar { $$ = mkident($1); }
1662 | gcon { $$ = mkident($1); }
1663 | lit_constant { $$ = mklit($1); }
1664 | OPAREN exp CPAREN { $$ = mkpar($2); } /* mkpar: stop infix parsing at ()'s */
1665 | qcon OCURLY rbinds CCURLY { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */
1666 | OBRACK list_exps CBRACK { $$ = mkllist($2); }
1667 | OPAREN exp COMMA texps CPAREN { if (ttree($4) == tuple)
1668 $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
1670 $$ = mktuple(ldub($2, $4)); }
1672 /* only in expressions ... */
1673 | aexp OCURLY rbinds CCURLY { $$ = mkrupdate($1,$3); }
1674 | OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); }
1675 | OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); }
1676 | OBRACK exp COMMA exp DOTDOT CBRACK { $$ = mkeenum($2,mkjust($4),mknothing()); }
1677 | OBRACK exp DOTDOT exp CBRACK { $$ = mkeenum($2,mknothing(),mkjust($4)); }
1678 | OBRACK exp DOTDOT CBRACK { $$ = mkeenum($2,mknothing(),mknothing()); }
1679 | OPAREN oexp qop CPAREN { $$ = mklsection($2,$3); }
1680 | OPAREN qop1 oexp CPAREN { $$ = mkrsection($2,$3); }
1682 /* only in patterns ... */
1683 /* these add 2 S/R conflict with with aexp . OCURLY rbinds CCURLY */
1684 | qvar AT aexp { checkinpat(); $$ = mkas($1,$3); }
1685 | LAZY aexp { checkinpat(); $$ = mklazyp($2); }
1686 | WILDCARD { checkinpat(); $$ = mkwildp(); }
1689 /* ccall arguments */
1690 cexps : cexps aexp { $$ = lapp($1,$2); }
1691 | aexp { $$ = lsing($1); }
1694 caserest: ocurly alts ccurly { $$ = $2; }
1695 | vocurly alts vccurly { $$ = $2; }
1697 dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; }
1698 | vocurly stmts vccurly { checkdostmts($2); $$ = $2; }
1701 rbinds : rbind { $$ = lsing($1); }
1702 | rbinds COMMA rbind { $$ = lapp($1,$3); }
1705 rbind : qvar { $$ = mkrbind($1,mknothing()); }
1706 | qvar EQUAL exp { $$ = mkrbind($1,mkjust($3)); }
1709 texps : exp { $$ = mkpar($1); } /* mkpar: so we don't flatten last element in tuple */
1711 { if (ttree($3) == tuple)
1712 $$ = mktuple(mklcons($1, gtuplelist((struct Stuple *) $3)));
1714 $$ = mktuple(ldub($1, $3));
1716 /* right recursion? WDP */
1721 exp { $$ = lsing($1); }
1722 | exp COMMA list_exps { $$ = mklcons($1, $3); }
1723 /* right recursion? (WDP)
1725 It has to be this way, though, otherwise you
1726 may do the wrong thing to distinguish between...
1728 [ e1 , e2 .. ] -- an enumeration ...
1729 [ e1 , e2 , e3 ] -- a list
1731 (In fact, if you change the grammar and throw yacc/bison
1732 at it, it *will* do the wrong thing [WDP 94/06])
1736 letdecls: LET ocurly decls ccurly { $$ = $3 }
1737 | LET vocurly decls vccurly { $$ = $3 }
1740 quals : qual { $$ = lsing($1); }
1741 | quals COMMA qual { $$ = lapp($1,$3); }
1744 qual : letdecls { $$ = mkseqlet($1); }
1746 | {inpat=TRUE;} expLno {inpat=FALSE;}leftexp
1748 expORpat(LEGIT_EXPR,$2);
1751 expORpat(LEGIT_PATT,$2);
1757 alts : alt { $$ = $1; }
1758 | alts SEMI alt { $$ = lconc($1,$3); }
1761 alt : pat { PREVPATT = $1; } altrest { $$ = lsing($3); PREVPATT = NULL; }
1762 | /* empty */ { $$ = Lnil; }
1765 altrest : gdpat maybe_where { $$ = createpat(mkpguards($1), $2); }
1766 | RARROW exp maybe_where { $$ = createpat(mkpnoguards($2),$3); }
1769 gdpat : gd RARROW exp { $$ = lsing(mkpgdexp($1,$3)); }
1770 | gd RARROW exp gdpat { $$ = mklcons(mkpgdexp($1,$3),$4); }
1773 stmts : stmt { $$ = $1; }
1774 | stmts SEMI stmt { $$ = lconc($1,$3); }
1777 stmt : /* empty */ { $$ = Lnil; }
1778 | letdecls { $$ = lsing(mkseqlet($1)); }
1779 | expL { $$ = lsing($1); }
1780 | {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
1782 expORpat(LEGIT_EXPR,$2);
1783 $$ = lsing(mkdoexp($2,endlineno));
1785 expORpat(LEGIT_PATT,$2);
1786 $$ = lsing(mkdobind($2,$4,endlineno));
1791 leftexp : LARROW exp { $$ = $2; }
1792 | /* empty */ { $$ = NULL; }
1795 /**********************************************************************
1801 **********************************************************************/
1804 The xpatk business is to do with accurately recording
1805 the starting line for definitions.
1809 | opatk qop opat %prec MINUS
1811 $$ = mkinfixap($2,$1,$3);
1813 if (isconstr(qid_to_string($2)))
1817 checkprec($1,$2,FALSE); /* Check the precedence of the left pattern */
1818 checkprec($3,$2,TRUE); /* then check the right pattern */
1824 | opat qop opat %prec MINUS
1826 $$ = mkinfixap($2,$1,$3);
1828 if(isconstr(qid_to_string($2)))
1832 checkprec($1,$2,FALSE); /* Check the precedence of the left pattern */
1833 checkprec($3,$2,TRUE); /* then check the right pattern */
1839 This comes here because of the funny precedence rules concerning
1844 dpat : MINUS fpat { $$ = mknegate($2,NULL,NULL); }
1848 /* Function application */
1849 fpat : fpat aapat { $$ = mkap($1,$2); }
1853 dpatk : minuskey fpat { $$ = mknegate($2,NULL,NULL); }
1857 /* Function application */
1858 fpatk : fpatk aapat { $$ = mkap($1,$2); }
1862 aapat : qvar { $$ = mkident($1); }
1863 | qvar AT apat { $$ = mkas($1,$3); }
1864 | gcon { $$ = mkident($1); }
1865 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1866 | lit_constant { $$ = mklit($1); }
1867 | WILDCARD { $$ = mkwildp(); }
1868 | OPAREN opat CPAREN { $$ = mkpar($2); }
1869 | OPAREN opat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1870 | OBRACK pats CBRACK { $$ = mkllist($2); }
1871 | LAZY apat { $$ = mklazyp($2); }
1875 aapatk : qvark { $$ = mkident($1); }
1876 | qvark AT apat { $$ = mkas($1,$3); }
1877 | gconk { $$ = mkident($1); }
1878 | qconk OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1879 | lit_constant { $$ = mklit($1); setstartlineno(); }
1880 | WILDCARD { $$ = mkwildp(); setstartlineno(); }
1881 | oparenkey opat CPAREN { $$ = mkpar($2); }
1882 | oparenkey opat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1883 | obrackkey pats CBRACK { $$ = mkllist($2); }
1884 | lazykey apat { $$ = mklazyp($2); }
1888 | OBRACK CBRACK { $$ = creategid(-1); }
1889 | OPAREN CPAREN { $$ = creategid(0); }
1890 | OPAREN commas CPAREN { $$ = creategid($2); }
1894 | obrackkey CBRACK { $$ = creategid(-1); }
1895 | oparenkey CPAREN { $$ = creategid(0); }
1896 | oparenkey commas CPAREN { $$ = creategid($2); }
1899 lampats : apat lampats { $$ = mklcons($1,$2); }
1900 | apat { $$ = lsing($1); }
1901 /* right recursion? (WDP) */
1904 pats : pat COMMA pats { $$ = mklcons($1, $3); }
1905 | pat { $$ = lsing($1); }
1906 /* right recursion? (WDP) */
1909 pat : pat qconop bpat { $$ = mkinfixap($2,$1,$3); precparse($$); }
1915 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1916 | MINUS INTEGER { $$ = mklit(mkinteger(ineg($2))); }
1917 | MINUS FLOAT { $$ = mklit(mkfloatr(ineg($2))); }
1920 conpat : gcon { $$ = mkident($1); }
1921 | conpat apat { $$ = mkap($1,$2); }
1924 apat : gcon { $$ = mkident($1); }
1925 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1929 apatc : qvar { $$ = mkident($1); }
1930 | qvar AT apat { $$ = mkas($1,$3); }
1931 | lit_constant { $$ = mklit($1); }
1932 | WILDCARD { $$ = mkwildp(); }
1933 | OPAREN pat CPAREN { $$ = mkpar($2); }
1934 | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1935 | OBRACK pats CBRACK { $$ = mkllist($2); }
1936 | LAZY apat { $$ = mklazyp($2); }
1940 INTEGER { $$ = mkinteger($1); }
1941 | FLOAT { $$ = mkfloatr($1); }
1942 | CHAR { $$ = mkcharr($1); }
1943 | STRING { $$ = mkstring($1); }
1944 | CHARPRIM { $$ = mkcharprim($1); }
1945 | STRINGPRIM { $$ = mkstringprim($1); }
1946 | INTPRIM { $$ = mkintprim($1); }
1947 | FLOATPRIM { $$ = mkfloatprim($1); }
1948 | DOUBLEPRIM { $$ = mkdoubleprim($1); }
1949 | CLITLIT /* yurble yurble */ { $$ = mkclitlit($1, ""); }
1950 | CLITLIT KIND_PRAGMA CONID { $$ = mkclitlit($1, $3); }
1951 | NOREP_INTEGER INTEGER { $$ = mknorepi($2); }
1952 | NOREP_RATIONAL INTEGER INTEGER { $$ = mknorepr($2, $3); }
1953 | NOREP_STRING STRING { $$ = mknoreps($2); }
1956 rpats : rpat { $$ = lsing($1); }
1957 | rpats COMMA rpat { $$ = lapp($1,$3); }
1960 rpat : qvar { $$ = mkrbind($1,mknothing()); }
1961 | qvar EQUAL pat { $$ = mkrbind($1,mkjust($3)); }
1965 /**********************************************************************
1968 * Keywords which record the line start *
1971 **********************************************************************/
1973 importkey: IMPORT { setstartlineno(); }
1976 datakey : DATA { setstartlineno();
1979 printf("%u\n",startlineno);
1981 fprintf(stderr,"%u\tdata\n",startlineno);
1986 typekey : TYPE { setstartlineno();
1989 printf("%u\n",startlineno);
1991 fprintf(stderr,"%u\ttype\n",startlineno);
1996 newtypekey : NEWTYPE { setstartlineno();
1999 printf("%u\n",startlineno);
2001 fprintf(stderr,"%u\tnewtype\n",startlineno);
2006 instkey : INSTANCE { setstartlineno();
2009 printf("%u\n",startlineno);
2012 fprintf(stderr,"%u\tinstance\n",startlineno);
2017 defaultkey: DEFAULT { setstartlineno(); }
2020 classkey: CLASS { setstartlineno();
2023 printf("%u\n",startlineno);
2025 fprintf(stderr,"%u\tclass\n",startlineno);
2030 minuskey: MINUS { setstartlineno(); }
2033 modulekey: MODULE { setstartlineno();
2036 printf("%u\n",startlineno);
2038 fprintf(stderr,"%u\tmodule\n",startlineno);
2043 oparenkey: OPAREN { setstartlineno(); }
2046 obrackkey: OBRACK { setstartlineno(); }
2049 lazykey : LAZY { setstartlineno(); }
2053 /**********************************************************************
2056 * Basic qualified/unqualified ids/ops *
2059 **********************************************************************/
2062 | OPAREN qvarsym CPAREN { $$ = $2; }
2065 | OPAREN qconsym CPAREN { $$ = $2; }
2068 | BQUOTE qvarid BQUOTE { $$ = $2; }
2071 | BQUOTE qconid BQUOTE { $$ = $2; }
2077 /* Non "-" op, used in right sections */
2082 /* Non "-" varop, used in right sections */
2084 | varsym_nominus { $$ = mknoqual($1); }
2085 | BQUOTE qvarid BQUOTE { $$ = $2; }
2090 | OPAREN varsym CPAREN { $$ = $2; }
2092 con : tycon /* using tycon removes conflicts */
2093 | OPAREN CONSYM CPAREN { $$ = $2; }
2096 | BQUOTE varid BQUOTE { $$ = $2; }
2099 | BQUOTE CONID BQUOTE { $$ = $2; }
2105 qvark : qvarid { setstartlineno(); $$ = $1; }
2106 | oparenkey qvarsym CPAREN { $$ = $2; }
2108 qconk : qconid { setstartlineno(); $$ = $1; }
2109 | oparenkey qconsym CPAREN { $$ = $2; }
2111 vark : varid { setstartlineno(); $$ = $1; }
2112 | oparenkey varsym CPAREN { $$ = $2; }
2116 | varid { $$ = mknoqual($1); }
2119 | varsym { $$ = mknoqual($1); }
2122 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
2125 | CONSYM { $$ = mknoqual($1); }
2128 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
2131 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
2134 varsym : varsym_nominus
2135 | MINUS { $$ = install_literal("-"); }
2138 /* AS HIDING QUALIFIED are valid varids */
2140 | AS { $$ = install_literal("as"); }
2141 | HIDING { $$ = install_literal("hiding"); }
2142 | QUALIFIED { $$ = install_literal("qualified"); }
2143 | INTERFACE { $$ = install_literal("interface"); }
2146 /* DARROW BANG are valid varsyms */
2147 varsym_nominus : VARSYM
2148 | DARROW { $$ = install_literal("=>"); }
2149 | BANG { $$ = install_literal("!"); }
2156 tyvar : varid { $$ = mknamedtvar($1); }
2163 tyvar_list: tyvar { $$ = lsing($1); }
2164 | tyvar_list COMMA tyvar { $$ = lapp($1,$3); }
2167 /**********************************************************************
2170 * Stuff to do with layout *
2173 **********************************************************************/
2175 ocurly : layout OCURLY { hsincindent(); }
2177 vocurly : layout { hssetindent(); }
2180 layout : { hsindentoff(); }
2186 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
2191 vccurly : { expect_ccurly = 1; } vccurly1 { expect_ccurly = 0; }
2197 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
2203 FN = NULL; SAMEFN = 0; PREVPATT = NULL;
2210 /**********************************************************************
2212 * Error Processing and Reporting *
2214 * (This stuff is here in case we want to use Yacc macros and such.) *
2216 **********************************************************************/
2218 /* The parser calls "hsperror" when it sees a
2219 `report this and die' error. It sets the stage
2220 and calls "yyerror".
2222 There should be no direct calls in the parser to
2223 "yyerror", except for the one from "hsperror". Thus,
2224 the only other calls will be from the error productions
2225 introduced by yacc/bison/whatever.
2227 We need to be able to recognise the from-error-production
2228 case, because we sometimes want to say, "Oh, never mind",
2229 because the layout rule kicks into action and may save
2233 static BOOLEAN error_and_I_mean_it = FALSE;
2239 error_and_I_mean_it = TRUE;
2243 extern char *yytext;
2250 /* We want to be able to distinguish 'error'-raised yyerrors
2251 from yyerrors explicitly coded by the parser hacker.
2253 if (expect_ccurly && ! error_and_I_mean_it ) {
2257 fprintf(stderr, "\"%s\", line %d, column %d: %s on input: ",
2258 input_filename, hsplineno, hspcolno + 1, s);
2260 if (yyleng == 1 && *yytext == '\0')
2261 fprintf(stderr, "<EOF>");
2265 format_string(stderr, (unsigned char *) yytext, yyleng);
2268 fputc('\n', stderr);
2270 /* a common problem */
2271 if (strcmp(yytext, "#") == 0)
2272 fprintf(stderr, "\t(Perhaps you forgot a `-cpp' or `-fglasgow-exts' flag?)\n");
2279 format_string(fp, s, len)
2286 case '\0': fputs("\\NUL", fp); break;
2287 case '\007': fputs("\\a", fp); break;
2288 case '\010': fputs("\\b", fp); break;
2289 case '\011': fputs("\\t", fp); break;
2290 case '\012': fputs("\\n", fp); break;
2291 case '\013': fputs("\\v", fp); break;
2292 case '\014': fputs("\\f", fp); break;
2293 case '\015': fputs("\\r", fp); break;
2294 case '\033': fputs("\\ESC", fp); break;
2295 case '\034': fputs("\\FS", fp); break;
2296 case '\035': fputs("\\GS", fp); break;
2297 case '\036': fputs("\\RS", fp); break;
2298 case '\037': fputs("\\US", fp); break;
2299 case '\177': fputs("\\DEL", fp); break;
2304 fprintf(fp, "\\^%c", *s + '@');