**********************************************************************/
static BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */
-
-extern BOOLEAN nonstandardFlag;
extern BOOLEAN etags;
-extern VOID find_module_on_imports_dirlist PROTO((char *, BOOLEAN, char *));
-
extern char *input_filename;
static char *the_module_name;
-static char *iface_name;
-static char iface_filename[FILENAME_SIZE];
+static maybe module_exports;
-static maybe module_exports; /* Exported entities */
-static list prelude_core_import, prelude_imports;
- /* Entities imported from the Prelude */
-
-extern tree niltree;
extern list Lnil;
-
+extern list reverse_list();
extern tree root;
-/* For FN, PREVPATT and SAMEFN macros */
+/* For FN, SAMEFN macros */
extern qid fns[];
extern BOOLEAN samefn[];
-extern tree prevpatt[];
extern short icontexts;
/* Line Numbers */
* *
**********************************************************************/
-/* OLD 95/08: list fixlist; */
static int Fixity = 0, Precedence = 0;
-struct infix;
char *ineg PROTO((char *));
-int importlineno = 0; /* The line number where an import starts */
+long source_version = 0;
+BOOLEAN pat_check=TRUE;
-long inimport; /* Info about current import */
-id importmod;
-long importas;
-id asmod;
-long importqual;
-long importspec;
-long importhide;
-list importlist;
-
-extern BOOLEAN inpat; /* True when parsing a pattern */
-extern BOOLEAN implicitPrelude; /* True when we should read the Prelude if not given */
-extern BOOLEAN haskell1_2Flag; /* True if we are attempting (proto)Haskell 1.3 */
-
-extern int thisIfacePragmaVersion;
%}
%union {
ttype uttype;
constr uconstr;
binding ubinding;
- pbinding upbinding;
+ match umatch;
+ gdexp ugdexp;
+ grhsb ugrhsb;
entidt uentid;
id uid;
qid uqid;
float ufloat;
char *ustring;
hstring uhstring;
- hpragma uhpragma;
- coresyn ucoresyn;
}
* *
**********************************************************************/
-%token OCURLY CCURLY VCCURLY SEMI
-%token OBRACK CBRACK OPAREN CPAREN
-%token COMMA BQUOTE
+%token OCURLY CCURLY VCCURLY
+%token COMMA SEMI OBRACK CBRACK
+%token BQUOTE OPAREN CPAREN
+%token OUNBOXPAREN CUNBOXPAREN
/**********************************************************************
* *
**********************************************************************/
-%token DOTDOT DCOLON EQUAL
-%token LAMBDA VBAR RARROW
-%token LARROW MINUS
+%token DOTDOT DCOLON EQUAL LAMBDA
+%token VBAR RARROW LARROW
+%token AT LAZY DARROW
/**********************************************************************
%token MODULE NEWTYPE OF
%token THEN TYPE WHERE
-%token INTERFACE SCC
+%token SCC
%token CCALL CCALL_GC CASM CASM_GC
+%token DOT FORALL
+%token EXPORT UNSAFE STDCALL C_CALL LABEL
+%token PASCAL FASTCALL FOREIGN DYNAMIC
/**********************************************************************
* *
* *
-* Valid symbols/identifiers which need to be recognised *
+* Special symbols/identifiers which need to be recognised *
* *
* *
**********************************************************************/
-%token WILDCARD AT LAZY BANG
+%token MINUS BANG PLUS
%token AS HIDING QUALIFIED
* *
**********************************************************************/
-%token LEOF
-%token GHC_PRAGMA END_PRAGMA NO_PRAGMA NOINFO_PRAGMA SPECIALISE_PRAGMA
-%token ARITY_PRAGMA UPDATE_PRAGMA STRICTNESS_PRAGMA KIND_PRAGMA
-%token UNFOLDING_PRAGMA MAGIC_UNFOLDING_PRAGMA DEFOREST_PRAGMA
-%token SPECIALISE_UPRAGMA INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
-%token DEFOREST_UPRAGMA END_UPRAGMA
-%token TYLAMBDA COCON COPRIM COAPP COTYAPP FORALL TYVAR_TEMPLATE_ID
-%token CO_ALG_ALTS CO_PRIM_ALTS CO_NO_DEFAULT CO_LETREC
-%token CO_SDSEL_ID CO_METH_ID CO_DEFM_ID CO_DFUN_ID CO_CONSTM_ID
-%token CO_SPEC_ID CO_WRKR_ID CO_ORIG_NM
-%token UNFOLD_ALWAYS UNFOLD_IF_ARGS
-%token NOREP_INTEGER NOREP_RATIONAL NOREP_STRING
-%token CO_PRELUDE_DICTS_CC CO_ALL_DICTS_CC CO_USER_CC CO_AUTO_CC CO_DICT_CC
-%token CO_CAF_CC CO_DUPD_CC
+%token INTERFACE_UPRAGMA SPECIALISE_UPRAGMA
+%token INLINE_UPRAGMA NOINLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
+%token END_UPRAGMA
+%token SOURCE_UPRAGMA
/**********************************************************************
* *
SCC CASM CCALL CASM_GC CCALL_GC
%left VARSYM CONSYM QVARSYM QCONSYM
- MINUS BQUOTE BANG DARROW
+ MINUS BQUOTE BANG DARROW PLUS
%left DCOLON
**********************************************************************/
-%type <ulist> caserest alts alt quals
+%type <ulist> caserest alts quals
dorest stmts stmt
- rbinds rpats list_exps
+ rbinds rbinds1 rpats rpats1 list_exps list_rest
qvarsk qvars_list
- constrs constr1 fields
- types atypes batypes
+ constrs fields conargatypes
+ tautypes atypes
types_and_maybe_ids
- pats context context_list tyvar_list
+ pats simple_context simple_context_list
export_list enames
import_list inames
impdecls maybeimpdecls impdecl
- maybefixes fixes fix ops
dtyclses dtycls_list
- gdrhs gdpat valrhs
- lampats cexps
- idata_pragma_specs idata_pragma_specslist
- gen_pragma_list type_pragma_pairs
- type_pragma_pairs_maybe name_pragma_pairs
- type_maybes
- core_binders core_tyvars core_tv_templates
- core_types core_type_list
- core_atoms core_atom_list
- core_alg_alts core_prim_alts corec_binds
- core_type_maybes
+ gdrhs gdpat
+ lampats cexps gd texps
+ tyvars1 constr_context forall
-%type <umaybe> maybeexports impas maybeimpspec
- type_maybe core_type_maybe
+%type <umatch> alt
+%type <ugrhsb> valrhs altrhs
-%type <ueither> impspec
+%type <umaybe> maybeexports impspec deriving
+ ext_name opt_sig opt_asig
%type <uliteral> lit_constant
-%type <utree> exp oexp dexp kexp fexp aexp rbind texps
+%type <utree> exp oexp dexp kexp fexp aexp rbind
expL oexpL kexpL expLno oexpLno dexpLno kexpLno
- qual gd leftexp
- apat bpat pat apatc conpat dpat fpat opat aapat
- dpatk fpatk opatk aapatk rpat
+ funlhs funlhs1 funlhs2 funlhs3 qual leftexp
+ pat dpat cpat bpat apat apatc conpat rpat
+ patk bpatk apatck conpatk
-%type <uid> MINUS DARROW AS LAZY
+%type <uid> MINUS PLUS DARROW AS LAZY
VARID CONID VARSYM CONSYM
- TYVAR_TEMPLATE_ID
var con varop conop op
vark varid varsym varsym_nominus
- tycon modid impmod ccallid
+ tycon modid ccallid tyvar
+ varid_noforall
%type <uqid> QVARID QCONID QVARSYM QCONSYM
qvarid qconid qvarsym qconsym
qvar qcon qvarop qconop qop
qvark qconk qtycon qtycls
- gcon gconk gtycon qop1 qvarop1
- ename iname
-
-%type <ubinding> topdecl topdecls letdecls
- typed datad newtd classd instd defaultd
- decl decls valdef instdef instdefs
- maybeifixes iimport iimports maybeiimports
- ityped idatad inewtd iclassd iinstd ivarsd
- itopdecl itopdecls
- maybe_where
- interface dointerface readinterface ibody
- cbody rinst
- type_and_maybe_id
-
-%type <upbinding> valrhs1 altrest
-
-%type <uttype> simple ctype type atype btype
- gtyconapp ntyconapp ntycon gtyconvars
- bbtype batype btyconapp
- class restrict_inst general_inst tyvar
- core_type
-
-%type <uconstr> constr field
+ gcon gconk gtycon itycon qop1 qvarop1
+ ename iname
+
+%type <ubinding> topdecl topdecls topdecls1 letdecls
+ typed datad newtd classd instd defaultd foreignd
+ decl decls decls1 fixdecl fix_op fix_ops valdef
+ maybe_where type_and_maybe_id
+
+%type <uttype> polytype
+ conargatype conapptype
+ tautype
+ apptype
+ atype polyatype
+ simple_con_app simple_con_app1 inst_type
+
+%type <uconstr> constr constr_after_context field constr1
%type <ustring> FLOAT INTEGER INTPRIM
FLOATPRIM DOUBLEPRIM CLITLIT
%type <uentid> export import
-%type <uhpragma> idata_pragma inewt_pragma idata_pragma_spectypes
- iclas_pragma iclasop_pragma
- iinst_pragma gen_pragma ival_pragma arity_pragma
- update_pragma strictness_pragma worker_info
- deforest_pragma
- unfolding_pragma unfolding_guidance type_pragma_pair
- name_pragma_pair
-
-%type <ucoresyn> core_expr core_case_alts core_id core_binder core_atom
- core_alg_alt core_prim_alt core_default corec_bind
- co_primop co_scc co_caf co_dupd
-
-%type <ulong> commas impqual
+%type <ulong> commas importkey get_line_no
+ unsafe_flag callconv
/**********************************************************************
* *
* *
**********************************************************************/
-%start pmodule
-
+%start module
%%
-
-pmodule : {
- inimport = 1;
- importmod = install_literal("Prelude");
- importas = 0;
- asmod = NULL;
- importqual = 0;
- importspec = 0;
- importhide = 0;
- importlist = Lnil;
- }
- readpreludecore readprelude
- {
- inimport = 0;
- importmod = NULL;
-
- modulelineno = 0;
- }
- module
- ;
-
module : modulekey modid maybeexports
{
+ modulelineno = startlineno;
the_module_name = $2;
module_exports = $3;
}
WHERE body
| {
+ modulelineno = 0;
the_module_name = install_literal("Main");
module_exports = mknothing();
}
body
;
-body : ocurly { setstartlineno(); } orestm
- | vocurly vrestm
+body : ocurly { setstartlineno(); } main_body ccurly
+ | vocurly main_body vccurly
;
-orestm : maybeimpdecls maybefixes topdecls ccurly
+main_body : interface_pragma maybeimpdecls topdecls
{
- root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,$2,$3,modulelineno);
+ root = mkhmodule(the_module_name, $2, module_exports,
+ $3, source_version,modulelineno);
}
- | impdecls ccurly
+ | interface_pragma impdecls
{
- root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,Lnil,mknullbind(),modulelineno);
+ root = mkhmodule(the_module_name, $2, module_exports,
+ mknullbind(), source_version, modulelineno);
}
-vrestm : maybeimpdecls maybefixes topdecls vccurly
- {
- root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,$2,$3,modulelineno);
- }
- | impdecls vccurly
+interface_pragma : /* empty */
+ | INTERFACE_UPRAGMA INTEGER END_UPRAGMA SEMI
{
- root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,Lnil,mknullbind(),modulelineno);
+ source_version = atoi($2);
}
-
+ ;
maybeexports : /* empty */ { $$ = mknothing(); }
| OPAREN export_list CPAREN { $$ = mkjust($2); }
| enames COMMA ename { $$ = lapp($1,$3); }
;
ename : qvar
- | qcon
+ | gcon
;
;
-impdecl : importkey
- {
- inimport = 1;
- importlineno = startlineno;
- }
- impqual impmod dointerface impas maybeimpspec
- {
- $$ = lsing(mkimport(iface_name,xstrdup(iface_filename),$5,
- $4,$3,$6,$7,importlineno));
- inimport = 0;
- importmod = NULL;
- importas = 0;
- asmod = NULL;
- importqual = 0;
- importspec = 0;
- importhide = 0;
- importlist = Lnil;
- }
- ;
-
-impmod : modid { $$ = importmod = $1; }
- ;
-
-impqual : /* noqual */ { $$ = importqual = 0; }
- | QUALIFIED { $$ = importqual = 1; }
- ;
-
-impas : /* noas */ { $$ = mknothing(); importas = 0; asmod = NULL; }
- | AS modid { $$ = mkjust($2); importas = 1; asmod = $2; }
- ;
-
-maybeimpspec : /* empty */ { $$ = mknothing(); importspec = 0; }
- | impspec { $$ = mkjust($1); importspec = 1; }
+impdecl : importkey modid impspec
+ { $$ = lsing(mkimport($2,0,mknothing(),$3,$1,startlineno)); }
+ | importkey QUALIFIED modid impspec
+ { $$ = lsing(mkimport($3,1,mknothing(),$4,$1,startlineno)); }
+ | importkey QUALIFIED modid AS modid impspec
+ { $$ = lsing(mkimport($3,1,mkjust($5),$6,$1,startlineno)); }
+ | importkey modid AS modid impspec
+ { $$ = lsing(mkimport($3,1,mkjust($4),$5,$1,startlineno)); }
;
-impspec : OPAREN CPAREN { $$ = mkleft(Lnil); importhide = 0; importlist = Lnil; }
- | OPAREN import_list CPAREN { $$ = mkleft($2); importhide = 0; importlist = $2; }
- | OPAREN import_list COMMA CPAREN { $$ = mkleft($2); importhide = 0; importlist = $2; }
- | HIDING OPAREN import_list CPAREN { $$ = mkright($3); importhide = 1; importlist = $3; }
- | HIDING OPAREN import_list COMMA CPAREN { $$ = mkright($3); importhide = 1; importlist = $3; }
+impspec : /* empty */ { $$ = mknothing(); }
+ | OPAREN CPAREN { $$ = mkjust(mkleft(Lnil)); }
+ | OPAREN import_list CPAREN { $$ = mkjust(mkleft($2)); }
+ | OPAREN import_list COMMA CPAREN { $$ = mkjust(mkleft($2)); }
+ | HIDING OPAREN CPAREN { $$ = mkjust(mkright(Lnil)); }
+ | HIDING OPAREN import_list CPAREN { $$ = mkjust(mkright($3)); }
+ | HIDING OPAREN import_list COMMA CPAREN { $$ = mkjust(mkright($3)); }
;
import_list:
;
import : var { $$ = mkentid(mknoqual($1)); }
- | tycon { $$ = mkenttype(mknoqual($1)); }
- | tycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall(mknoqual($1)); }
- | tycon OPAREN CPAREN { $$ = mkenttypenamed(mknoqual($1),Lnil); }
- | tycon OPAREN inames CPAREN { $$ = mkenttypenamed(mknoqual($1),$3); }
+ | itycon { $$ = mkenttype($1); }
+ | itycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
+ | itycon OPAREN CPAREN { $$ = mkenttypenamed($1,Lnil);}
+ | itycon OPAREN inames CPAREN { $$ = mkenttypenamed($1,$3); }
+ ;
+
+itycon : tycon { $$ = mknoqual($1); }
+ | OBRACK CBRACK { $$ = creategid(NILGID); }
+ | OPAREN CPAREN { $$ = creategid(UNITGID); }
+ | OPAREN commas CPAREN { $$ = creategid($2); }
;
inames : iname { $$ = lsing($1); }
| con { $$ = mknoqual($1); }
;
-
-/**********************************************************************
-* *
-* *
-* Reading interface files *
-* *
-* *
-**********************************************************************/
-
-dointerface : { /* filename returned in "iface_filename" */
- char *module_name = id_to_string(importmod);
- if ( ! etags ) {
- find_module_on_imports_dirlist(
- (haskell1_2Flag && strcmp(module_name, "Prelude") == 0)
- ? "Prel12" : module_name,
- FALSE, iface_filename);
- } else {
- find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
- }
- if (strcmp(module_name,"PreludeCore")==0) {
- hsperror("Cannot explicitly import `PreludeCore'");
-
- } else if (strcmp(module_name,"Prelude")==0) {
- prelude_imports = prelude_core_import; /* unavoidable */
- }
- thisIfacePragmaVersion = 0;
- setyyin(iface_filename);
- }
- readinterface
- { $$ = $2; }
- ;
-
-readpreludecore:{
- if ( implicitPrelude && !etags ) {
- /* we try to avoid reading interfaces when etagging */
- find_module_on_imports_dirlist(
- (haskell1_2Flag) ? "PrelCore12" : "PreludeCore",
- TRUE,iface_filename);
- } else {
- find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
- }
- thisIfacePragmaVersion = 0;
- setyyin(iface_filename);
- }
- readinterface
- {
- binding prelude_core = mkimport(iface_name,xstrdup(iface_filename),$2,
- install_literal("PreludeCore"),
- 0,mknothing(),mknothing(),0);
- prelude_core_import = (! implicitPrelude) ? Lnil : lsing(prelude_core);
- }
- ;
-
-readprelude : {
- if ( implicitPrelude && !etags ) {
- find_module_on_imports_dirlist(
- ( haskell1_2Flag ) ? "Prel12" : "Prelude",
- TRUE,iface_filename);
- } else {
- find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
- }
- thisIfacePragmaVersion = 0;
- setyyin(iface_filename);
- }
- readinterface
- {
- binding prelude = mkimport(iface_name,xstrdup(iface_filename),$2,
- install_literal("Prelude"),
- 0,mknothing(),mknothing(),0);
- prelude_imports = (! implicitPrelude) ? Lnil
- : lconc(prelude_core_import,lsing(prelude));
- }
- ;
-
-readinterface:
- interface LEOF
- {
- $$ = $1;
- }
- ;
-
-interface:
- INTERFACE modid
- {
- iface_name = $2;
- }
- WHERE ibody
- {
- $$ = $5;
- }
- ;
-
-ibody : ocurly maybeiimports maybeifixes itopdecls ccurly
- {
- $$ = mkabind($2,mkabind($3,$4));
- }
- | ocurly iimports ccurly
- {
- $$ = $2;
- }
- | vocurly maybeiimports maybeifixes itopdecls vccurly
- {
- $$ = mkabind($2,mkabind($3,$4));
- }
- | vocurly iimports vccurly
- {
- $$ = $2;
- }
- ;
-
-maybeifixes: /* empty */ { $$ = mknullbind(); }
- | fixes SEMI { $$ = mkmfbind($1); }
- ;
-
-maybeiimports : /* empty */ { $$ = mknullbind(); }
- | iimports SEMI { $$ = $1; }
- ;
-
-iimports : iimport { $$ = $1; }
- | iimports SEMI iimport { $$ = mkabind($1,$3); }
- ;
-
-iimport : importkey modid OPAREN import_list CPAREN
- { $$ = mkmbind($2,$4,startlineno); }
- ;
-
-
-itopdecls : itopdecl { $$ = $1; }
- | itopdecls SEMI itopdecl { $$ = mkabind($1,$3); }
- ;
-
-itopdecl: ityped { $$ = $1; }
- | idatad { $$ = $1; }
- | inewtd { $$ = $1; }
- | iclassd { $$ = $1; }
- | iinstd { $$ = $1; }
- | ivarsd { $$ = $1; }
- | /* empty */ { $$ = mknullbind(); }
- ;
-
-ivarsd : qvarsk DCOLON ctype ival_pragma
- { $$ = mksbind($1,$3,startlineno,$4); }
- ;
-
-ityped : typekey simple EQUAL type
- { $$ = mknbind($2,$4,startlineno); }
- ;
-
-idatad : datakey simple idata_pragma
- { $$ = mktbind(Lnil,$2,Lnil,mknothing(),startlineno,$3); }
- | datakey simple EQUAL constrs idata_pragma
- { $$ = mktbind(Lnil,$2,$4,mknothing(),startlineno,$5); }
- | datakey context DARROW simple idata_pragma
- { $$ = mktbind($2,$4,Lnil,mknothing(),startlineno,$5); }
- | datakey context DARROW simple EQUAL constrs idata_pragma
- { $$ = mktbind($2,$4,$6,mknothing(),startlineno,$7); }
- ;
-
-inewtd : newtypekey simple inewt_pragma
- { $$ = mkntbind(Lnil,$2,Lnil,mknothing(),startlineno,$3); }
- | newtypekey simple EQUAL constr1 inewt_pragma
- { $$ = mkntbind(Lnil,$2,$4,mknothing(),startlineno,$5); }
- | newtypekey context DARROW simple inewt_pragma
- { $$ = mkntbind($2,$4,Lnil,mknothing(),startlineno,$5); }
- | newtypekey context DARROW simple EQUAL constr1 inewt_pragma
- { $$ = mkntbind($2,$4,$6,mknothing(),startlineno,$7); }
- ;
-
-iclassd : classkey context DARROW class iclas_pragma cbody
- { $$ = mkcbind($2,$4,$6,startlineno,$5); }
- | classkey class iclas_pragma cbody
- { $$ = mkcbind(Lnil,$2,$4,startlineno,$3); }
- ;
-
-iinstd : instkey modid context DARROW gtycon general_inst iinst_pragma
- { $$ = mkibind(0/*not source*/,$2,$3,$5,$6,mknullbind(),startlineno,$7); }
- | instkey modid gtycon general_inst iinst_pragma
- { $$ = mkibind(0/*not source*/,$2,Lnil,$3,$4,mknullbind(),startlineno,$5); }
- ;
-
-
-/**********************************************************************
-* *
-* *
-* Interface pragma stuff *
-* *
-* *
-**********************************************************************/
-
-idata_pragma:
- GHC_PRAGMA constrs idata_pragma_specs END_PRAGMA
- { $$ = mkidata_pragma($2, $3); }
- | GHC_PRAGMA idata_pragma_specs END_PRAGMA
- { $$ = mkidata_pragma(Lnil, $2); }
- | /* empty */ { $$ = mkno_pragma(); }
- ;
-
-inewt_pragma:
- GHC_PRAGMA constr1 idata_pragma_specs END_PRAGMA
- { $$ = mkidata_pragma($2, $3); }
- | GHC_PRAGMA idata_pragma_specs END_PRAGMA
- { $$ = mkidata_pragma(Lnil, $2); }
- | /* empty */ { $$ = mkno_pragma(); }
- ;
-
-idata_pragma_specs :
- SPECIALISE_PRAGMA idata_pragma_specslist
- { $$ = $2; }
- | /* empty */ { $$ = Lnil; }
- ;
-
-idata_pragma_specslist:
- idata_pragma_spectypes { $$ = lsing($1); }
- | idata_pragma_specslist COMMA idata_pragma_spectypes
- { $$ = lapp($1, $3); }
- ;
-
-idata_pragma_spectypes:
- OBRACK type_maybes CBRACK { $$ = mkidata_pragma_4s($2); }
- ;
-
-iclas_pragma:
- GHC_PRAGMA gen_pragma_list END_PRAGMA { $$ = mkiclas_pragma($2); }
- | /* empty */ { $$ = mkno_pragma(); }
- ;
-
-iclasop_pragma:
- GHC_PRAGMA gen_pragma gen_pragma END_PRAGMA
- { $$ = mkiclasop_pragma($2, $3); }
- | /* empty */
- { $$ = mkno_pragma(); }
- ;
-
-iinst_pragma:
- GHC_PRAGMA gen_pragma END_PRAGMA
- { $$ = mkiinst_simpl_pragma($2); }
-
- | GHC_PRAGMA gen_pragma name_pragma_pairs END_PRAGMA
- { $$ = mkiinst_const_pragma($2, $3); }
-
- | /* empty */
- { $$ = mkno_pragma(); }
- ;
-
-ival_pragma:
- GHC_PRAGMA gen_pragma END_PRAGMA
- { $$ = $2; }
- | /* empty */
- { $$ = mkno_pragma(); }
- ;
-
-gen_pragma:
- NOINFO_PRAGMA
- { $$ = mkno_pragma(); }
- | arity_pragma update_pragma deforest_pragma strictness_pragma unfolding_pragma type_pragma_pairs_maybe
- { $$ = mkigen_pragma($1, $2, $3, $4, $5, $6); }
- ;
-
-arity_pragma:
- NO_PRAGMA { $$ = mkno_pragma(); }
- | ARITY_PRAGMA INTEGER { $$ = mkiarity_pragma($2); }
- ;
-
-update_pragma:
- NO_PRAGMA { $$ = mkno_pragma(); }
- | UPDATE_PRAGMA INTEGER { $$ = mkiupdate_pragma($2); }
- ;
-
-deforest_pragma:
- NO_PRAGMA { $$ = mkno_pragma(); }
- | DEFOREST_PRAGMA { $$ = mkideforest_pragma(); }
- ;
-
-strictness_pragma:
- NO_PRAGMA { $$ = mkno_pragma(); }
- | STRICTNESS_PRAGMA COCON { $$ = mkistrictness_pragma(installHstring(1, "B"),
- /* _!_ = COCON = bottom */ mkno_pragma());
- }
- | STRICTNESS_PRAGMA STRING worker_info
- { $$ = mkistrictness_pragma($2, $3); }
- ;
-
-worker_info:
- OCURLY gen_pragma CCURLY { $$ = $2; }
- | /* empty */ { $$ = mkno_pragma(); }
-
-unfolding_pragma:
- NO_PRAGMA { $$ = mkno_pragma(); }
- | MAGIC_UNFOLDING_PRAGMA vark
- { $$ = mkimagic_unfolding_pragma($2); }
- | UNFOLDING_PRAGMA unfolding_guidance core_expr
- { $$ = mkiunfolding_pragma($2, $3); }
- ;
-
-unfolding_guidance:
- UNFOLD_ALWAYS
- { $$ = mkiunfold_always(); }
- | UNFOLD_IF_ARGS INTEGER INTEGER CONID INTEGER
- { $$ = mkiunfold_if_args($2, $3, $4, $5); }
- ;
-
-gen_pragma_list:
- gen_pragma { $$ = lsing($1); }
- | gen_pragma_list COMMA gen_pragma { $$ = lapp($1, $3); }
- ;
-
-type_pragma_pairs_maybe:
- NO_PRAGMA { $$ = Lnil; }
- | SPECIALISE_PRAGMA type_pragma_pairs { $$ = $2; }
- ;
-
-/* 1 S/R conflict at COMMA -> shift */
-type_pragma_pairs:
- type_pragma_pair { $$ = lsing($1); }
- | type_pragma_pairs COMMA type_pragma_pair { $$ = lapp($1, $3); }
- ;
-
-type_pragma_pair:
- OBRACK type_maybes CBRACK INTEGER worker_info
- { $$ = mkitype_pragma_pr($2, $4, $5); }
- ;
-
-type_maybes:
- type_maybe { $$ = lsing($1); }
- | type_maybes COMMA type_maybe { $$ = lapp($1, $3); }
- ;
-
-type_maybe:
- NO_PRAGMA { $$ = mknothing(); }
- | type { $$ = mkjust($1); }
- ;
-
-name_pragma_pairs:
- name_pragma_pair { $$ = lsing($1); }
- | name_pragma_pairs COMMA name_pragma_pair { $$ = lapp($1, $3); }
- ;
-
-name_pragma_pair:
- /* if the gen_pragma concludes with a *comma*-separated SPECs list,
- we get a parse error --- we have to bracket the gen_pragma
- */
-
- var EQUAL OCURLY gen_pragma CCURLY
- { $$ = mkiname_pragma_pr($1, $4); }
- ;
-
-/**********************************************************************
-* *
-* *
-* Core syntax stuff *
-* *
-* *
-**********************************************************************/
-
-core_expr:
- LAMBDA core_binders RARROW core_expr
- { $$ = mkcolam($2, $4); }
- | TYLAMBDA core_tyvars RARROW core_expr
- { $$ = mkcotylam($2, $4); }
- | COCON con core_types core_atoms
- { $$ = mkcocon(mkco_id($2), $3, $4); }
- | COCON CO_ORIG_NM modid con core_types core_atoms
- { $$ = mkcocon(mkco_orig_id($3,$4), $5, $6); }
- | COPRIM co_primop core_types core_atoms
- { $$ = mkcoprim($2, $3, $4); }
- | COAPP core_expr core_atoms
- { $$ = mkcoapp($2, $3); }
- | COTYAPP core_expr OCURLY core_type CCURLY
- { $$ = mkcotyapp($2, $4); }
- | CASE core_expr OF OCURLY core_case_alts CCURLY
- { $$ = mkcocase($2, $5); }
- | LET OCURLY core_binder EQUAL core_expr CCURLY IN core_expr
- { $$ = mkcolet(mkcononrec($3, $5), $8); }
- | CO_LETREC OCURLY corec_binds CCURLY IN core_expr
- { $$ = mkcolet(mkcorec($3), $6); }
- | SCC OCURLY co_scc CCURLY core_expr
- { $$ = mkcoscc($3, $5); }
- | lit_constant { $$ = mkcoliteral($1); }
- | core_id { $$ = mkcovar($1); }
- ;
-
-core_case_alts :
- CO_ALG_ALTS core_alg_alts core_default
- { $$ = mkcoalg_alts($2, $3); }
- | CO_PRIM_ALTS core_prim_alts core_default
- { $$ = mkcoprim_alts($2, $3); }
- ;
-
-core_alg_alts :
- /* empty */ { $$ = Lnil; }
- | core_alg_alts core_alg_alt { $$ = lapp($1, $2); }
- ;
-
-core_alg_alt:
- core_id core_binders RARROW core_expr SEMI { $$ = mkcoalg_alt($1, $2, $4); }
- /* core_id is really too generous */
- ;
-
-core_prim_alts :
- /* empty */ { $$ = Lnil; }
- | core_prim_alts core_prim_alt { $$ = lapp($1, $2); }
- ;
-
-core_prim_alt:
- lit_constant RARROW core_expr SEMI { $$ = mkcoprim_alt($1, $3); }
- ;
-
-core_default:
- CO_NO_DEFAULT { $$ = mkconodeflt(); }
- | core_binder RARROW core_expr { $$ = mkcobinddeflt($1, $3); }
- ;
-
-corec_binds:
- corec_bind { $$ = lsing($1); }
- | corec_binds SEMI corec_bind { $$ = lapp($1, $3); }
- ;
-
-corec_bind:
- core_binder EQUAL core_expr { $$ = mkcorec_pair($1, $3); }
- ;
-
-co_scc :
- CO_PRELUDE_DICTS_CC co_dupd { $$ = mkco_preludedictscc($2); }
- | CO_ALL_DICTS_CC STRING STRING co_dupd { $$ = mkco_alldictscc($2,$3,$4); }
- | CO_USER_CC STRING STRING STRING co_dupd co_caf
- { $$ = mkco_usercc($2,$3,$4,$5,$6); }
- | CO_AUTO_CC core_id STRING STRING co_dupd co_caf
- { $$ = mkco_autocc($2,$3,$4,$5,$6); }
- | CO_DICT_CC core_id STRING STRING co_dupd co_caf
- { $$ = mkco_dictcc($2,$3,$4,$5,$6); }
-
-co_caf : NO_PRAGMA { $$ = mkco_scc_noncaf(); }
- | CO_CAF_CC { $$ = mkco_scc_caf(); }
-
-co_dupd : NO_PRAGMA { $$ = mkco_scc_nondupd(); }
- | CO_DUPD_CC { $$ = mkco_scc_dupd(); }
-
-core_id: /* more to come?? */
- CO_SDSEL_ID tycon tycon { $$ = mkco_sdselid($2, $3); }
- | CO_METH_ID tycon var { $$ = mkco_classopid($2, $3); }
- | CO_DEFM_ID tycon var { $$ = mkco_defmid($2, $3); }
- | CO_DFUN_ID tycon OPAREN core_type CPAREN
- { $$ = mkco_dfunid($2, $4); }
- | CO_CONSTM_ID tycon var OPAREN core_type CPAREN
- { $$ = mkco_constmid($2, $3, $5); }
- | CO_SPEC_ID core_id OBRACK core_type_maybes CBRACK
- { $$ = mkco_specid($2, $4); }
- | CO_WRKR_ID core_id { $$ = mkco_wrkrid($2); }
- | CO_ORIG_NM modid var { $$ = mkco_orig_id($2, $3); }
- | CO_ORIG_NM modid con { $$ = mkco_orig_id($2, $3); }
- | var { $$ = mkco_id($1); }
- | con { $$ = mkco_id($1); }
- ;
-
-co_primop :
- OPAREN CCALL ccallid OCURLY core_types core_type CCURLY CPAREN
- { $$ = mkco_ccall($3,0,$5,$6); }
- | OPAREN CCALL_GC ccallid OCURLY core_types core_type CCURLY CPAREN
- { $$ = mkco_ccall($3,1,$5,$6); }
- | OPAREN CASM lit_constant OCURLY core_types core_type CCURLY CPAREN
- { $$ = mkco_casm($3,0,$5,$6); }
- | OPAREN CASM_GC lit_constant OCURLY core_types core_type CCURLY CPAREN
- { $$ = mkco_casm($3,1,$5,$6); }
- | VARID { $$ = mkco_primop($1); }
- ;
-
-core_binders :
- /* empty */ { $$ = Lnil; }
- | core_binders core_binder { $$ = lapp($1, $2); }
- ;
-
-core_binder :
- OPAREN VARID DCOLON core_type CPAREN { $$ = mkcobinder($2, $4); }
-
-core_atoms :
- OBRACK CBRACK { $$ = Lnil; }
- | OBRACK core_atom_list CBRACK { $$ = $2; }
- ;
-
-core_atom_list :
- core_atom { $$ = lsing($1); }
- | core_atom_list COMMA core_atom { $$ = lapp($1, $3); }
- ;
-
-core_atom :
- lit_constant { $$ = mkcolit($1); }
- | core_id { $$ = mkcolocal($1); }
- ;
-
-core_tyvars :
- VARID { $$ = lsing($1); }
- | core_tyvars VARID { $$ = lapp($1, $2); }
- ;
-
-core_tv_templates :
- TYVAR_TEMPLATE_ID { $$ = lsing($1); }
- | core_tv_templates COMMA TYVAR_TEMPLATE_ID { $$ = lapp($1, $3); }
- ;
-
-core_types :
- OBRACK CBRACK { $$ = Lnil; }
- | OBRACK core_type_list CBRACK { $$ = $2; }
- ;
-
-core_type_list :
- core_type { $$ = lsing($1); }
- | core_type_list COMMA core_type { $$ = lapp($1, $3); }
- ;
-
-core_type :
- type { $$ = $1; }
- ;
-
-/*
-core_type :
- FORALL core_tv_templates DARROW core_type
- { $$ = mkuniforall($2, $4); }
- | OCURLY OCURLY CONID core_type CCURLY CCURLY RARROW core_type
- { $$ = mktfun(mkunidict($3, $4), $8); }
- | OCURLY OCURLY CONID core_type CCURLY CCURLY
- { $$ = mkunidict($3, $4); }
- | OPAREN OCURLY OCURLY CONID core_type CCURLY CCURLY COMMA core_type_list CPAREN RARROW core_type
- { $$ = mktfun(mkttuple(mklcons(mkunidict($4, $5), $9)), $12); }
- | OPAREN OCURLY OCURLY CONID core_type CCURLY CCURLY COMMA core_type_list CPAREN
- { $$ = mkttuple(mklcons(mkunidict($4,$5), $9)); }
- | type { $$ = $1; }
- ;
-*/
-
-core_type_maybes:
- core_type_maybe { $$ = lsing($1); }
- | core_type_maybes COMMA core_type_maybe { $$ = lapp($1, $3); }
- ;
-
-core_type_maybe:
- NO_PRAGMA { $$ = mknothing(); }
- | core_type { $$ = mkjust($1); }
- ;
-
-
/**********************************************************************
* *
* *
* *
**********************************************************************/
-maybefixes: /* empty */ { $$ = Lnil; }
- | fixes SEMI { $$ = $1; }
- ;
-
-fixes : fix { $$ = $1; }
- | fixes SEMI fix { $$ = lconc($1,$3); }
- ;
-
-fix : INFIXL INTEGER { Precedence = checkfixity($2); Fixity = INFIXL; }
- ops { $$ = $4; }
- | INFIXR INTEGER { Precedence = checkfixity($2); Fixity = INFIXR; }
- ops { $$ = $4; }
- | INFIX INTEGER { Precedence = checkfixity($2); Fixity = INFIX; }
- ops { $$ = $4; }
- | INFIXL { Fixity = INFIXL; Precedence = 9; }
- ops { $$ = $3; }
- | INFIXR { Fixity = INFIXR; Precedence = 9; }
- ops { $$ = $3; }
- | INFIX { Fixity = INFIX; Precedence = 9; }
- ops { $$ = $3; }
- ;
-
-ops : op { makeinfix($1,Fixity,Precedence,the_module_name,
- inimport,importas,importmod,asmod,importqual,
- importspec,importhide,importlist);
- $$ = lsing(mkfixop($1,infixint(Fixity),Precedence));
- }
- | ops COMMA op { makeinfix($3,Fixity,Precedence,the_module_name,
- inimport,importas,importmod,asmod,importqual,
- importspec,importhide,importlist);
- $$ = lapp($1,mkfixop($3,infixint(Fixity),Precedence));
- }
- ;
+topdecls: topdecls1 opt_semi { $$ = $1; }
-topdecls: topdecl
- | topdecls SEMI topdecl
+topdecls1: topdecl
+ | topdecls1 SEMI topdecl
{
if($1 != NULL)
if($3 != NULL)
$$ = $3;
SAMEFN = 0;
}
- ;
+ ;
-topdecl : typed { $$ = $1; }
- | datad { $$ = $1; }
- | newtd { $$ = $1; }
- | classd { $$ = $1; }
- | instd { $$ = $1; }
- | defaultd { $$ = $1; }
+topdecl : typed { $$ = $1; FN = NULL; SAMEFN = 0; }
+ | datad { $$ = $1; FN = NULL; SAMEFN = 0; }
+ | newtd { $$ = $1; FN = NULL; SAMEFN = 0; }
+ | classd { $$ = $1; FN = NULL; SAMEFN = 0; }
+ | instd { $$ = $1; FN = NULL; SAMEFN = 0; }
+ | defaultd { $$ = $1; FN = NULL; SAMEFN = 0; }
+ | foreignd { $$ = $1; FN = NULL; SAMEFN = 0; }
| decl { $$ = $1; }
;
-typed : typekey simple EQUAL type { $$ = mknbind($2,$4,startlineno); }
+typed : typekey simple_con_app EQUAL tautype { $$ = mknbind($2,$4,startlineno); }
;
-datad : datakey simple EQUAL constrs
- { $$ = mktbind(Lnil,$2,$4,mknothing(),startlineno,mkno_pragma()); }
- | datakey simple EQUAL constrs DERIVING dtyclses
- { $$ = mktbind(Lnil,$2,$4,mkjust($6),startlineno,mkno_pragma()); }
- | datakey context DARROW simple EQUAL constrs
- { $$ = mktbind($2,$4,$6,mknothing(),startlineno,mkno_pragma()); }
- | datakey context DARROW simple EQUAL constrs DERIVING dtyclses
- { $$ = mktbind($2,$4,$6,mkjust($8),startlineno,mkno_pragma()); }
+datad : datakey simple_con_app EQUAL constrs deriving
+ { $$ = mktbind(Lnil,$2,$4,$5,startlineno); }
+ | datakey simple_context DARROW simple_con_app EQUAL constrs deriving
+ { $$ = mktbind($2,$4,$6,$7,startlineno); }
;
-newtd : newtypekey simple EQUAL constr1
- { $$ = mkntbind(Lnil,$2,$4,mknothing(),startlineno,mkno_pragma()); }
- | newtypekey simple EQUAL constr1 DERIVING dtyclses
- { $$ = mkntbind(Lnil,$2,$4,mkjust($6),startlineno,mkno_pragma()); }
- | newtypekey context DARROW simple EQUAL constr1
- { $$ = mkntbind($2,$4,$6,mknothing(),startlineno,mkno_pragma()); }
- | newtypekey context DARROW simple EQUAL constr1 DERIVING dtyclses
- { $$ = mkntbind($2,$4,$6,mkjust($8),startlineno,mkno_pragma()); }
+newtd : newtypekey simple_con_app EQUAL constr1 deriving
+ { $$ = mkntbind(Lnil,$2,lsing($4),$5,startlineno); }
+ | newtypekey simple_context DARROW simple_con_app EQUAL constr1 deriving
+ { $$ = mkntbind($2,$4,lsing($6),$7,startlineno); }
;
-classd : classkey context DARROW class cbody { $$ = mkcbind($2,$4,$5,startlineno,mkno_pragma()); }
- | classkey class cbody { $$ = mkcbind(Lnil,$2,$3,startlineno,mkno_pragma()); }
+deriving: /* empty */ { $$ = mknothing(); }
+ | DERIVING dtyclses { $$ = mkjust($2); }
;
-cbody : /* empty */ { $$ = mknullbind(); }
- | WHERE ocurly decls ccurly { checkorder($3); $$ = $3; }
- | WHERE vocurly decls vccurly { checkorder($3); $$ = $3; }
+classd : classkey apptype DARROW simple_con_app1 maybe_where
+ /* Context can now be more than simple_context */
+ { $$ = mkcbind(type2context($2),$4,$5,startlineno); }
+ | classkey apptype maybe_where
+ /* We have to say apptype rather than simple_con_app1, else
+ we get reduce/reduce errs */
+ { check_class_decl_head($2);
+ $$ = mkcbind(Lnil,$2,$3,startlineno); }
;
-instd : instkey context DARROW gtycon restrict_inst rinst
- { $$ = mkibind(1/*source*/,the_module_name,$2,$4,$5,$6,startlineno,mkno_pragma()); }
- | instkey gtycon general_inst rinst
- { $$ = mkibind(1/*source*/,the_module_name,Lnil,$2,$3,$4,startlineno,mkno_pragma()); }
+instd : instkey inst_type maybe_where { $$ = mkibind($2,$3,startlineno); }
;
-rinst : /* empty */ { $$ = mknullbind(); }
- | WHERE ocurly instdefs ccurly { $$ = $3; }
- | WHERE vocurly instdefs vccurly { $$ = $3; }
- ;
+/* Compare polytype */
+/* [July 98: first production was tautype DARROW tautype, but I can't see why.] */
+inst_type : apptype DARROW apptype { is_context_format( $3, 0 ); /* Check the instance head */
+ $$ = mkforall(Lnil,type2context($1),$3); }
+ | apptype { is_context_format( $1, 0 ); /* Check the instance head */
+ $$ = $1; }
+ ;
+
-restrict_inst : gtycon { $$ = mktname($1); }
- | OPAREN gtyconvars CPAREN { $$ = $2; }
- | OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); }
- | OBRACK tyvar CBRACK { $$ = mktllist($2); }
- | OPAREN tyvar RARROW tyvar CPAREN { $$ = mktfun($2,$4); }
+defaultd: defaultkey OPAREN tautypes CPAREN { $$ = mkdbind($3,startlineno); }
+ | defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); }
;
-general_inst : gtycon { $$ = mktname($1); }
- | OPAREN gtyconapp CPAREN { $$ = $2; }
- | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
- | OBRACK type CBRACK { $$ = mktllist($2); }
- | OPAREN btype RARROW type CPAREN { $$ = mktfun($2,$4); }
+/* FFI primitive declarations - GHC/Hugs specific */
+foreignd: foreignkey IMPORT callconv ext_name unsafe_flag qvarid DCOLON tautype
+ { $$ = mkfobind($6,$8,$4,$5,$3,FOREIGN_IMPORT,startlineno); }
+ | foreignkey EXPORT callconv ext_name qvarid DCOLON tautype
+ { $$ = mkfobind($5,$7,$4,0,$3,FOREIGN_EXPORT,startlineno); }
+ | foreignkey LABEL ext_name qvarid DCOLON tautype
+ { $$ = mkfobind($4,$6,$3,0,-1,FOREIGN_LABEL,startlineno); }
;
-defaultd: defaultkey OPAREN types CPAREN { $$ = mkdbind($3,startlineno); }
- | defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); }
+callconv: STDCALL { $$ = CALLCONV_STDCALL; }
+ | C_CALL { $$ = CALLCONV_CCALL; }
+ | PASCAL { $$ = CALLCONV_PASCAL; }
+ | FASTCALL { $$ = CALLCONV_FASTCALL; }
+/* If you leave out the specification of a calling convention, you'll (probably) get C's. */
+ | /*empty*/ { $$ = CALLCONV_NONE; }
;
-decls : decl
- | decls SEMI decl
+ext_name: STRING { $$ = mkjust(lsing($1)); }
+ | STRING STRING { $$ = mkjust(mklcons ($1,lsing($2))); }
+ | DYNAMIC { $$ = mknothing(); }
+
+unsafe_flag: UNSAFE { $$ = 1; }
+ | /*empty*/ { $$ = 0; }
+ ;
+
+decls : decls1 opt_semi { $$ = $1; }
+
+decls1 : decl
+ | decls1 SEMI decl
{
if(SAMEFN)
{
}
;
+opt_semi : /*empty*/
+ | SEMI
+ ;
/*
Note: if there is an iclasop_pragma here, then we must be
to real mischief (ugly, but likely to work).
*/
-decl : qvarsk DCOLON ctype iclasop_pragma
- { $$ = mksbind($1,$3,startlineno,$4);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+decl : fixdecl
+
+ | qvarsk DCOLON polytype
+ { $$ = mksbind($1,$3,startlineno);
+ FN = NULL; SAMEFN = 0;
}
+
+ | qvark DCOLON polytype
+ { $$ = mksbind(lsing($1),$3,startlineno);
+ FN = NULL; SAMEFN = 0;
+ }
+
/* User-specified pragmas come in as "signatures"...
They are similar in that they can appear anywhere in the module,
and have to be "joined up" with their related entity.
| SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
{
$$ = mkvspec_uprag($2, $4, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+ FN = NULL; SAMEFN = 0;
}
- | SPECIALISE_UPRAGMA INSTANCE gtycon general_inst END_UPRAGMA
+ | SPECIALISE_UPRAGMA INSTANCE gtycon atype END_UPRAGMA
{
$$ = mkispec_uprag($3, $4, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+ FN = NULL; SAMEFN = 0;
}
| SPECIALISE_UPRAGMA DATA gtycon atypes END_UPRAGMA
{
$$ = mkdspec_uprag($3, $4, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+ FN = NULL; SAMEFN = 0;
}
| INLINE_UPRAGMA qvark END_UPRAGMA
{
$$ = mkinline_uprag($2, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+ FN = NULL; SAMEFN = 0;
}
- | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
+ | NOINLINE_UPRAGMA qvark END_UPRAGMA
{
- $$ = mkmagicuf_uprag($2, $3, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+ $$ = mknoinline_uprag($2, startlineno);
+ FN = NULL; SAMEFN = 0;
}
- | DEFOREST_UPRAGMA qvark END_UPRAGMA
- {
- $$ = mkdeforest_uprag($2, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+ | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
+ {
+ $$ = mkmagicuf_uprag($2, $3, startlineno);
+ FN = NULL; SAMEFN = 0;
}
/* end of user-specified pragmas */
| valdef
- | /* empty */ { $$ = mknullbind(); PREVPATT = NULL; FN = NULL; SAMEFN = 0; }
;
+fixdecl : INFIXL INTEGER { Precedence = checkfixity($2); Fixity = INFIXL; }
+ fix_ops { $$ = $4; }
+ | INFIXR INTEGER { Precedence = checkfixity($2); Fixity = INFIXR; }
+ fix_ops { $$ = $4; }
+ | INFIX INTEGER { Precedence = checkfixity($2); Fixity = INFIX; }
+ fix_ops { $$ = $4; }
+ | INFIXL { Fixity = INFIXL; Precedence = 9; }
+ fix_ops { $$ = $3; }
+ | INFIXR { Fixity = INFIXR; Precedence = 9; }
+ fix_ops { $$ = $3; }
+ | INFIX { Fixity = INFIX; Precedence = 9; }
+ fix_ops { $$ = $3; }
+ ;
+
+/* Grotesque global-variable hack to
+ make a separate fixity decl for each op */
+fix_ops : fix_op
+ | fix_ops COMMA fix_op { $$ = mkabind($1,$3); }
+ ;
+
+fix_op : op { $$ = mkfixd(mknoqual($1),infixint(Fixity),Precedence,startlineno); }
+ ;
+
qvarsk : qvark COMMA qvars_list { $$ = mklcons($1,$3); }
- | qvark { $$ = lsing($1); }
;
qvars_list: qvar { $$ = lsing($1); }
;
type_and_maybe_id :
- type { $$ = mkvspec_ty_and_id($1,mknothing()); }
- | type EQUAL qvark { $$ = mkvspec_ty_and_id($1,mkjust($3)); }
+ tautype { $$ = mkvspec_ty_and_id($1,mknothing()); }
+ | tautype EQUAL qvark { $$ = mkvspec_ty_and_id($1,mkjust($3)); }
/**********************************************************************
* *
**********************************************************************/
-/* "DCOLON context => type" vs "DCOLON type" is a problem,
+/* "DCOLON context => tautype" vs "DCOLON tautype" is a problem,
because you can't distinguish between
foo :: (Baz a, Baz a)
bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
- with one token of lookahead. The HACK is to have "DCOLON ttype"
- [tuple type] in the first case, then check that it has the right
+ with one token of lookahead. The HACK is to have "DCOLON apptype"
+ in the first case, then check that it has the right
form C a, or (C1 a, C2 b, ... Cn z) and convert it into a
context. Blaach!
*/
- /* 1 S/R conflict at DARROW -> shift */
-ctype : type DARROW type { $$ = mkcontext(type2context($1),$3); }
- | type
- ;
+/* --------------------------- */
- /* 1 S/R conflict at RARROW -> shift */
-type : btype { $$ = $1; }
- | btype RARROW type { $$ = mktfun($1,$3); }
+polyatype : atype
+ ;
- | FORALL core_tv_templates DARROW type { $$ = mkuniforall($2, $4); }
- ;
+polytype : FORALL tyvars1 DOT
+ apptype DARROW tautype { $$ = mkforall($2, type2context($4), $6); }
+ | FORALL tyvars1 DOT tautype { $$ = mkforall($2, Lnil, $4); }
+ | apptype DARROW tautype { $$ = mkforall(Lnil, type2context($1), $3); }
+ | tautype
+ ;
-/* btype is split so we can parse gtyconapp without S/R conflicts */
-btype : gtyconapp { $$ = $1; }
- | ntyconapp { $$ = $1; }
- ;
+/* --------------------------- */
+/* tautype is just a monomorphic type.
+ But it may have nested for-alls if we're in a rank-2 type */
-ntyconapp: ntycon { $$ = $1; }
- | ntyconapp atype { $$ = mktapp($1,$2); }
+tautype : apptype RARROW tautype { $$ = mktfun($1,$3); }
+ | apptype { $$ = $1; }
;
-gtyconapp: gtycon { $$ = mktname($1); }
- | gtyconapp atype { $$ = mktapp($1,$2); }
- ;
+tautypes : tautype { $$ = lsing($1); }
+ | tautypes COMMA tautype { $$ = lapp($1,$3); }
+ ;
+/* --------------------------- */
+/* apptype: type application */
-atype : gtycon { $$ = mktname($1); }
- | ntycon { $$ = $1; }
+apptype : apptype atype { $$ = mktapp($1,$2); }
+ | atype { $$ = $1; }
;
-ntycon : tyvar { $$ = $1; }
- | OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
- | OBRACK type CBRACK { $$ = mktllist($2); }
- | OPAREN type CPAREN { $$ = $2; }
+/* --------------------------- */
+/* atype: an atomic or bracketed type: T, x, [ty], tuple ty */
- | OCURLY OCURLY gtycon type CCURLY CCURLY { $$ = mkunidict($3, $4); }
- | TYVAR_TEMPLATE_ID { $$ = mkunityvartemplate($1); }
- ;
+atypes : atype { $$ = lsing($1); }
+ | atype atypes { $$ = mklcons($1,$2); }
+ ;
-gtycon : qtycon
- | OPAREN RARROW CPAREN { $$ = creategid(-2); }
- | OBRACK CBRACK { $$ = creategid(-1); }
- | OPAREN CPAREN { $$ = creategid(0); }
- | OPAREN commas CPAREN { $$ = creategid($2); }
- ;
+atype : gtycon { $$ = mktname($1); }
+ | tyvar { $$ = mknamedtvar($1); }
+
+ | OPAREN tautype COMMA
+ tautypes CPAREN { $$ = mkttuple(mklcons($2,$4)); }
+
+ | OUNBOXPAREN tautype COMMA
+ tautypes CUNBOXPAREN { $$ = mktutuple(mklcons($2,$4)); }
-atypes : atype { $$ = lsing($1); }
- | atypes atype { $$ = lapp($1,$2); }
+ | OBRACK tautype CBRACK { $$ = mktllist($2); }
+ | OPAREN polytype CPAREN { $$ = $2; }
;
-types : type { $$ = lsing($1); }
- | types COMMA type { $$ = lapp($1,$3); }
+/* --------------------------- */
+gtycon : qtycon
+ | OPAREN RARROW CPAREN { $$ = creategid(ARROWGID); }
+ | OBRACK CBRACK { $$ = creategid(NILGID); }
+ | OPAREN CPAREN { $$ = creategid(UNITGID); }
+ | OPAREN commas CPAREN { $$ = creategid($2); }
;
commas : COMMA { $$ = 1; }
* *
**********************************************************************/
-simple : gtycon { $$ = mktname($1); }
- | gtyconvars { $$ = $1; }
- ;
+/* C a b c, where a,b,c are type variables */
+/* C can be a class or tycon */
-gtyconvars: gtycon tyvar { $$ = mktapp(mktname($1),$2); }
- | gtyconvars tyvar { $$ = mktapp($1,$2); }
+/* simple_con_app can have no args; simple_con_app1 must have at least one */
+simple_con_app: gtycon { $$ = mktname($1); }
+ | simple_con_app1 { $$ = $1; }
;
-
-context : OPAREN context_list CPAREN { $$ = $2; }
- | class { $$ = lsing($1); }
+
+simple_con_app1: gtycon tyvar { $$ = mktapp(mktname($1),mknamedtvar($2)); }
+ | simple_con_app1 tyvar { $$ = mktapp($1, mknamedtvar($2)); }
;
-context_list: class { $$ = lsing($1); }
- | context_list COMMA class { $$ = lapp($1,$3); }
+simple_context : OPAREN simple_context_list CPAREN { $$ = $2; }
+ | OPAREN CPAREN { $$ = Lnil; }
+ | simple_con_app1 { $$ = lsing($1); }
;
-class : gtycon tyvar { $$ = mktapp(mktname($1),$2); }
+simple_context_list : simple_con_app1 { $$ = lsing($1); }
+ | simple_context_list COMMA simple_con_app1 { $$ = lapp($1,$3); }
;
constrs : constr { $$ = lsing($1); }
| constrs VBAR constr { $$ = lapp($1,$3); }
;
-constr : btyconapp { qid tyc; list tys;
+constr : forall constr_context DARROW constr_after_context { $$ = mkconstrex ( $1, $2, $4 ); }
+ | forall constr_after_context { $$ = mkconstrex ( $1, Lnil, $2 ); }
+ ;
+
+forall : { $$ = Lnil }
+ | FORALL tyvars1 DOT { $$ = $2; }
+ ;
+
+constr_context
+ : conapptype conargatype { $$ = type2context( mktapp($1,$2) ); }
+ | conargatype { $$ = type2context( $1 ); }
+ ;
+
+constr_after_context :
+
+ /* We have to parse the constructor application as a *type*, else we get
+ into terrible ambiguity problems. Consider the difference between
+
+ data T = S Int Int Int `R` Int
+ and
+ data T = S Int Int Int
+
+ It isn't till we get to the operator that we discover that the "S" is
+ part of a type in the first, but part of a constructor application in the
+ second.
+ */
+
+/* Con !Int (Tree a) */
+ conapptype { qid tyc; list tys;
splittyconapp($1, &tyc, &tys);
$$ = mkconstrpre(tyc,tys,hsplineno); }
- | OPAREN qconsym CPAREN { $$ = mkconstrpre($2,Lnil,hsplineno); }
- | OPAREN qconsym CPAREN batypes { $$ = mkconstrpre($2,$4,hsplineno); }
- | btyconapp qconop bbtype { checknobangs($1);
- $$ = mkconstrinf($1,$2,$3,hsplineno); }
- | ntyconapp qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
- | BANG atype qconop bbtype { $$ = mkconstrinf(mktbang($2),$3,$4,hsplineno); }
- /* 1 S/R conflict on OCURLY -> shift */
- | gtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
- ;
+/* (::) (Tree a) Int */
+ | OPAREN qconsym CPAREN conargatypes { $$ = mkconstrpre($2,$4,hsplineno); }
-btyconapp: gtycon { $$ = mktname($1); }
- | btyconapp batype { $$ = mktapp($1,$2); }
- ;
+/* !Int `Con` Tree a */
+ | conargatype qconop conargatype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
-bbtype : btype { $$ = $1; }
- | BANG atype { $$ = mktbang($2); }
+/* Con { op1 :: Int } */
+ | qtycon OCURLY CCURLY { $$ = mkconstrrec($1,Lnil,hsplineno); }
+ | qtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
+ | OPAREN qconsym CPAREN OCURLY fields CCURLY { $$ = mkconstrrec($2,$5,hsplineno); }
;
+ /* 1 S/R conflict on OCURLY -> shift */
-batype : atype { $$ = $1; }
- | BANG atype { $$ = mktbang($2); }
- ;
-batypes : batype { $$ = lsing($1); }
- | batypes batype { $$ = lapp($1,$2); }
- ;
+conapptype : gtycon { $$ = mktname($1); }
+ | conapptype conargatype { $$ = mktapp($1, $2); }
+ ;
+
+conargatype : polyatype { $$ = $1; }
+ | BANG polyatype { $$ = mktbang( $2 ); }
+ ;
+conargatypes : { $$ = Lnil; }
+ | conargatype conargatypes { $$ = mklcons($1,$2); }
+ ;
fields : field { $$ = lsing($1); }
| fields COMMA field { $$ = lapp($1,$3); }
;
-field : qvars_list DCOLON type { $$ = mkfield($1,$3); }
- | qvars_list DCOLON BANG atype { $$ = mkfield($1,mktbang($4)); }
+field : qvars_list DCOLON polytype { $$ = mkfield($1,$3); }
+ | qvars_list DCOLON BANG polyatype { $$ = mkfield($1,mktbang($4)); }
;
-constr1 : gtycon atype { $$ = lsing(mkconstrnew($1,$2,hsplineno)); }
+constr1 : gtycon conargatype { $$ = mkconstrnew($1,$2,mknothing(),hsplineno); }
+ | gtycon OCURLY qvar DCOLON polytype CCURLY { $$ = mkconstrnew($1,$5,mkjust($3),hsplineno); }
;
| dtycls_list COMMA qtycls { $$ = lapp($1,$3); }
;
-instdefs : /* empty */ { $$ = mknullbind(); }
- | instdef { $$ = $1; }
- | instdefs SEMI instdef
- {
- if(SAMEFN)
- {
- extendfn($1,$3);
- $$ = $1;
- }
- else
- $$ = mkabind($1,$3);
- }
- ;
-
-/* instdef: same as valdef, except certain user-pragmas may appear */
-instdef :
- SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
- {
- $$ = mkvspec_uprag($2, $4, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
- }
+valdef : funlhs opt_sig { checksamefn($1); }
+ get_line_no valrhs { $$ = mkfbind( lsing(mkpmatch( lsing($1), $2, $5 )), $4); }
- | INLINE_UPRAGMA qvark END_UPRAGMA
- {
- $$ = mkinline_uprag($2, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
- }
+/* Special case for f :: type = e
+ We treat it as a special kind of pattern binding */
+ | qvark DCOLON tautype
+ get_line_no valrhs { $$ = mkpbind( mkrestr( mkident($1), $3 ), $5, $4 );
+ FN = NULL; SAMEFN = 0; }
- | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
- {
- $$ = mkmagicuf_uprag($2, $3, startlineno);
- PREVPATT = NULL; FN = NULL; SAMEFN = 0;
- }
+ | patk
+ get_line_no valrhs { $$ = mkpbind($1, $3, $2);
+ FN = NULL; SAMEFN = 0; }
- | valdef
- ;
+get_line_no : { $$ = hsplineno; /* startlineno; */ }
+ ;
+/* This grammar still isn't quite right
+ If you say
+ (x + 2) y = e
+ you should get a function binding, but actually the (x+3) will
+ parse as a pattern, and you'll get a parse error. */
+funlhs : patk qvarop cpat { $$ = mkinfixap($2,$1,$3); }
+ | funlhs1 apat { $$ = mkap( $1, $2 ); }
-valdef : opatk
- {
- tree fn = function($1);
- PREVPATT = $1;
-
- if(ttree(fn) == ident)
- {
- qid fun_id = gident((struct Sident *) fn);
- checksamefn(fun_id);
- FN = fun_id;
- }
+funlhs1 : oparenkey funlhs2 CPAREN { $$ = mkpar($2); }
+ | funlhs1 apat { $$ = mkap( $1, $2 ); }
+ | qvark { $$ = mkident($1); }
+ ;
- else if (ttree(fn) == infixap)
- {
- qid fun_id = ginffun((struct Sinfixap *) fn);
- checksamefn(fun_id);
- FN = fun_id;
- }
+funlhs2 : cpat qvarop cpat { $$ = mkinfixap($2,$1,$3); }
+ | funlhs3 apat { $$ = mkap( $1, $2 ); }
- else if(etags)
-#if 1/*etags*/
- printf("%u\n",startlineno);
-#else
- fprintf(stderr,"%u\tvaldef\n",startlineno);
-#endif
- }
- valrhs
- {
- if ( lhs_is_patt($1) )
- {
- $$ = mkpbind($3, startlineno);
- FN = NULL;
- SAMEFN = 0;
- }
- else /* lhs is function */
- $$ = mkfbind($3,startlineno);
+funlhs3 : OPAREN funlhs2 CPAREN { $$ = mkpar($2); }
+ | funlhs3 apat { $$ = mkap( $1, $2 ); }
+ | qvar { $$ = mkident($1); }
+ ;
- PREVPATT = NULL;
- }
- ;
+opt_sig : { $$ = mknothing(); }
+ | DCOLON tautype { $$ = mkjust($2); }
+ ;
-valrhs : valrhs1 maybe_where { $$ = lsing(createpat($1, $2)); }
- ;
+/* opt_asig is the same, but with a parenthesised type */
+opt_asig : { $$ = mknothing(); }
+ | DCOLON atype { $$ = mkjust($2); }
+ ;
-valrhs1 : gdrhs { $$ = mkpguards($1); }
- | EQUAL exp { $$ = mkpnoguards($2); }
+valrhs : EQUAL get_line_no exp maybe_where { $$ = mkpnoguards($2, $3, $4); }
+ | gdrhs maybe_where { $$ = mkpguards($1, $2); }
;
-gdrhs : gd EQUAL exp { $$ = lsing(mkpgdexp($1,$3)); }
- | gd EQUAL exp gdrhs { $$ = mklcons(mkpgdexp($1,$3),$4); }
+gdrhs : gd EQUAL get_line_no exp { $$ = lsing(mkpgdexp($1,$3,$4)); }
+ | gd EQUAL get_line_no exp gdrhs { $$ = mklcons(mkpgdexp($1,$3,$4),$5); }
;
maybe_where:
WHERE ocurly decls ccurly { $$ = $3; }
| WHERE vocurly decls vccurly { $$ = $3; }
+ /* A where containing no decls is OK */
+ | WHERE { $$ = mknullbind(); }
| /* empty */ { $$ = mknullbind(); }
;
-gd : VBAR oexp { $$ = $2; }
+gd : VBAR quals { $$ = $2; }
;
* *
**********************************************************************/
-exp : oexp DCOLON ctype { $$ = mkrestr($1,$3); }
+exp : oexp DCOLON polytype { $$ = mkrestr($1,$3); }
| oexp
;
Operators must be left-associative at the same precedence for
precedence parsing to work.
*/
- /* 9 S/R conflicts on qop -> shift */
-oexp : oexp qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); precparse($$); }
+ /* 10 S/R conflicts on qop -> shift */
+oexp : oexp qop dexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
| dexp
;
This comes here because of the funny precedence rules concerning
prefix minus.
*/
-dexp : MINUS kexp { $$ = mknegate($2,NULL,NULL); }
+dexp : MINUS kexp { $$ = mknegate($2); }
| kexp
;
/*
We need to factor out a leading let expression so we can set
- inpat=TRUE when parsing (non let) expressions inside stmts and quals
+ pat_check=FALSE when parsing (non let) expressions inside stmts and quals
*/
-expLno : oexpLno DCOLON ctype { $$ = mkrestr($1,$3); }
- | oexpLno
+expLno : oexpLno DCOLON polytype { $$ = mkrestr($1,$3); }
+ | oexpLno
;
-oexpLno : oexpLno qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); precparse($$); }
+oexpLno : oexpLno qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
| dexpLno
;
-dexpLno : MINUS kexp { $$ = mknegate($2,NULL,NULL); }
+dexpLno : MINUS kexp { $$ = mknegate($2); }
| kexpLno
;
-expL : oexpL DCOLON ctype { $$ = mkrestr($1,$3); }
+expL : oexpL DCOLON polytype { $$ = mkrestr($1,$3); }
| oexpL
;
-oexpL : oexpL qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); precparse($$); }
+oexpL : oexpL qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
| kexpL
;
| kexpLno
;
+/* kexpL = a let expression */
kexpL : letdecls IN exp { $$ = mklet($1,$3); }
;
+/* kexpLno = any other expression more tightly binding than operator application */
kexpLno : LAMBDA
{ hsincindent(); /* push new context for FN = NULL; */
FN = NULL; /* not actually concerned about indenting */
- $<ulong>$ = hsplineno; /* remember current line number */
- }
- lampats
- { hsendindent();
- }
- RARROW exp /* lambda abstraction */
- {
- $$ = mklambda($3, $6, $<ulong>2);
}
+ lampats opt_asig
+ { hsendindent(); }
+
+ RARROW get_line_no exp /* lambda abstraction */
+ { $$ = mklambda( mkpmatch( $3, $4, mkpnoguards( $7, $8, mknullbind() ) ) ); }
/* If Expression */
| IF {$<ulong>$ = hsplineno;}
/* SCC Expression */
| SCC STRING exp
{ if (ignoreSCC) {
- $$ = $3;
+ if (warnSCC) {
+ fprintf(stderr,
+ "\"%s\":%d: _scc_ (`set [profiling] cost centre') ignored\n",
+ input_filename, hsplineno);
+ }
+ $$ = mkpar($3); /* Note the mkpar(). If we don't have it, then
+ (x >> _scc_ y >> z) parses as (x >> (y >> z)),
+ right associated. But the precedence reorganiser expects
+ the parser to *left* associate all operators unless there
+ are explicit parens. The _scc_ acts like an explicit paren,
+ so if we omit it we'd better add explicit parens instead. */
} else {
$$ = mkscc($2, $3);
}
aexp : qvar { $$ = mkident($1); }
| gcon { $$ = mkident($1); }
| lit_constant { $$ = mklit($1); }
- | OPAREN exp CPAREN { $$ = mkpar($2); } /* mkpar: stop infix parsing at ()'s */
- | qcon OCURLY rbinds CCURLY { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */
+ | OPAREN exp CPAREN { $$ = mkpar($2); } /* mkpar: stop infix parsing at ()'s */
+ | qcon OCURLY rbinds CCURLY { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */
| OBRACK list_exps CBRACK { $$ = mkllist($2); }
- | OPAREN exp COMMA texps CPAREN { if (ttree($4) == tuple)
- $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
- else
- $$ = mktuple(ldub($2, $4)); }
+ | OPAREN exp COMMA texps CPAREN { $$ = mktuple(mklcons($2,$4)); }
+ /* unboxed tuples */
+ | OUNBOXPAREN exp COMMA texps CUNBOXPAREN
+ { $$ = mkutuple(mklcons($2,$4)); }
/* only in expressions ... */
- | aexp OCURLY rbinds CCURLY { $$ = mkrupdate($1,$3); }
+ | aexp OCURLY rbinds1 CCURLY { $$ = mkrupdate($1,$3); }
| OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); }
| OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); }
| OBRACK exp COMMA exp DOTDOT CBRACK { $$ = mkeenum($2,mkjust($4),mknothing()); }
/* these add 2 S/R conflict with with aexp . OCURLY rbinds CCURLY */
| qvar AT aexp { checkinpat(); $$ = mkas($1,$3); }
| LAZY aexp { checkinpat(); $$ = mklazyp($2); }
- | WILDCARD { checkinpat(); $$ = mkwildp(); }
;
/* ccall arguments */
caserest: ocurly alts ccurly { $$ = $2; }
| vocurly alts vccurly { $$ = $2; }
-dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; }
+dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; }
| vocurly stmts vccurly { checkdostmts($2); $$ = $2; }
;
-rbinds : rbind { $$ = lsing($1); }
- | rbinds COMMA rbind { $$ = lapp($1,$3); }
+rbinds : /* empty */ { $$ = Lnil; }
+ | rbinds1
;
-rbind : qvar { $$ = mkrbind($1,mknothing()); }
- | qvar EQUAL exp { $$ = mkrbind($1,mkjust($3)); }
+rbinds1 : rbind { $$ = lsing($1); }
+ | rbinds1 COMMA rbind { $$ = lapp($1,$3); }
;
-texps : exp { $$ = mkpar($1); } /* mkpar: so we don't flatten last element in tuple */
- | exp COMMA texps
- { if (ttree($3) == tuple)
- $$ = mktuple(mklcons($1, gtuplelist((struct Stuple *) $3)));
- else
- $$ = mktuple(ldub($1, $3));
- }
+rbind : qvar EQUAL exp { $$ = mkrbind($1,mkjust($3)); }
+;
+
+texps : exp { $$ = lsing($1); }
+ | exp COMMA texps { $$ = mklcons($1, $3) }
/* right recursion? WDP */
;
-
list_exps :
exp { $$ = lsing($1); }
+ | exp COMMA exp { $$ = mklcons( $1, lsing($3) ); }
+ | exp COMMA exp COMMA list_rest { $$ = mklcons( $1, mklcons( $3, reverse_list( $5 ))); }
+ ;
+
+/* Use left recusion for list_rest, because we sometimes get programs with
+ very long explicit lists. */
+list_rest : exp { $$ = lsing($1); }
+ | list_rest COMMA exp { $$ = mklcons( $3, $1 ); }
+ ;
+
+/*
+ exp { $$ = lsing($1); }
| exp COMMA list_exps { $$ = mklcons($1, $3); }
+*/
/* right recursion? (WDP)
It has to be this way, though, otherwise you
(In fact, if you change the grammar and throw yacc/bison
at it, it *will* do the wrong thing [WDP 94/06])
*/
- ;
-letdecls: LET ocurly decls ccurly { $$ = $3 }
- | LET vocurly decls vccurly { $$ = $3 }
+letdecls: LET { pat_check = TRUE; } ocurly decls ccurly { $$ = $4; }
+ | LET { pat_check = TRUE; } vocurly decls vccurly { $$ = $4; }
;
-quals : qual { $$ = lsing($1); }
- | quals COMMA qual { $$ = lapp($1,$3); }
- ;
+/*
+ When parsing patterns inside do stmt blocks or quals, we have
+ to tentatively parse them as expressions, since we don't know at
+ the time of parsing `p' whether it will be part of "p <- e" (pat)
+ or "p" (expr). When we eventually can tell the difference, the parse
+ of `p' is examined to see if it consitutes a syntactically legal pattern
+ or expression.
+
+ The expr rule used to parse the pattern/expression do contain
+ pattern-special productions (e.g., _ , a@pat, etc.), which are
+ illegal in expressions. Since we don't know whether what
+ we're parsing is an expression rather than a pattern, we turn off
+ the check and instead do it later.
+
+ The rather clumsy way that this check is turned on/off is there
+ to work around a Bison feature/shortcoming. Turning the flag
+ on/off just around the relevant nonterminal by decorating it
+ with simple semantic actions, e.g.,
+
+ {pat_check = FALSE; } expLNo { pat_check = TRUE; }
+
+ causes Bison to generate a parser where in one state it either
+ has to reduce/perform a semantic action ( { pat_check = FALSE; })
+ or reduce an error (the error production used to implement
+ vccurly.) Bison picks the semantic action, which it ideally shouldn't.
+ The work around is to lift out the setting of { pat_check = FALSE; }
+ and then later reset pat_check. Not pretty.
-qual : letdecls { $$ = mkseqlet($1); }
- | expL { $$ = $1; }
- | {inpat=TRUE;} expLno {inpat=FALSE;}leftexp
- { if ($4 == NULL) {
- expORpat(LEGIT_EXPR,$2);
- $$ = mkguard($2);
- } else {
- expORpat(LEGIT_PATT,$2);
- $$ = mkqual($2,$4);
- }
- }
+*/
+
+
+quals : { pat_check = FALSE;} qual { pat_check = TRUE; $$ = lsing($2); }
+ | quals COMMA { pat_check = FALSE; } qual { pat_check = TRUE; $$ = lapp($1,$4); }
;
-alts : alt { $$ = $1; }
- | alts SEMI alt { $$ = lconc($1,$3); }
+qual : letdecls { $$ = mkseqlet($1); }
+ | expL { expORpat(LEGIT_EXPR,$1); $$ = $1; }
+ | expLno { pat_check = TRUE; } leftexp
+ { if ($3 == NULL) {
+ expORpat(LEGIT_EXPR,$1);
+ $$ = mkguard($1);
+ } else {
+ expORpat(LEGIT_PATT,$1);
+ $$ = mkqual($1,$3);
+ }
+ }
;
-alt : pat { PREVPATT = $1; } altrest { $$ = lsing($3); PREVPATT = NULL; }
- | /* empty */ { $$ = Lnil; }
+alts : /* empty */ { $$ = Lnil; }
+ | alt { $$ = lsing($1); }
+ | alt SEMI alts { $$ = mklcons($1,$3); }
+ | SEMI alts { $$ = $2; }
;
-altrest : gdpat maybe_where { $$ = createpat(mkpguards($1), $2); }
- | RARROW exp maybe_where { $$ = createpat(mkpnoguards($2),$3); }
+alt : dpat opt_sig altrhs { $$ = mkpmatch( lsing($1), $2, $3 ); }
;
-gdpat : gd RARROW exp { $$ = lsing(mkpgdexp($1,$3)); }
- | gd RARROW exp gdpat { $$ = mklcons(mkpgdexp($1,$3),$4); }
+altrhs : RARROW get_line_no exp maybe_where { $$ = mkpnoguards($2, $3, $4); }
+ | gdpat maybe_where { $$ = mkpguards($1, $2); }
+ ;
+
+gdpat : gd RARROW get_line_no exp { $$ = lsing(mkpgdexp($1,$3,$4)); }
+ | gd RARROW get_line_no exp gdpat { $$ = mklcons(mkpgdexp($1,$3,$4),$5); }
;
-stmts : stmt { $$ = $1; }
- | stmts SEMI stmt { $$ = lconc($1,$3); }
+stmts : {pat_check = FALSE;} stmt {pat_check=TRUE; $$ = $2; }
+ | stmts SEMI {pat_check=FALSE;} stmt {pat_check=TRUE; $$ = lconc($1,$4); }
;
-stmt : /* empty */ { $$ = Lnil; }
- | letdecls { $$ = lsing(mkseqlet($1)); }
- | expL { $$ = lsing($1); }
- | {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
- { if ($4 == NULL) {
- expORpat(LEGIT_EXPR,$2);
- $$ = lsing(mkdoexp($2,endlineno));
- } else {
- expORpat(LEGIT_PATT,$2);
- $$ = lsing(mkdobind($2,$4,endlineno));
- }
- }
+stmt : /* empty */ { $$ = Lnil; }
+ | letdecls { $$ = lsing(mkseqlet($1)); }
+ | expL { expORpat(LEGIT_EXPR,$1); $$ = lsing(mkdoexp($1,hsplineno)); }
+ | expLno {pat_check=TRUE;} leftexp
+ { if ($3 == NULL) {
+ expORpat(LEGIT_EXPR,$1);
+ $$ = lsing(mkdoexp($1,endlineno));
+ } else {
+ expORpat(LEGIT_PATT,$1);
+ $$ = lsing(mkdobind($1,$3,endlineno));
+ }
+ }
;
+
leftexp : LARROW exp { $$ = $2; }
| /* empty */ { $$ = NULL; }
;
* *
**********************************************************************/
-/*
- The xpatk business is to do with accurately recording
- the starting line for definitions.
-*/
-
-opatk : dpatk
- | opatk qop opat %prec MINUS
- {
- $$ = mkinfixap($2,$1,$3);
+pat : dpat DCOLON tautype { $$ = mkrestr($1,$3); }
+ | dpat
+ ;
- if (isconstr(qid_to_string($2)))
- precparse($$);
- else
- {
- checkprec($1,$2,FALSE); /* Check the precedence of the left pattern */
- checkprec($3,$2,TRUE); /* then check the right pattern */
- }
- }
+dpat : qvar PLUS INTEGER { $$ = mkplusp($1, mkinteger($3)); }
+ | cpat
;
-opat : dpat
- | opat qop opat %prec MINUS
- {
- $$ = mkinfixap($2,$1,$3);
-
- if(isconstr(qid_to_string($2)))
- precparse($$);
- else
- {
- checkprec($1,$2,FALSE); /* Check the precedence of the left pattern */
- checkprec($3,$2,TRUE); /* then check the right pattern */
- }
- }
- ;
-
-/*
- This comes here because of the funny precedence rules concerning
- prefix minus.
-*/
-
-
-dpat : MINUS fpat { $$ = mknegate($2,NULL,NULL); }
- | fpat
+cpat : cpat qconop bpat { $$ = mkinfixap($2,$1,$3); }
+ | bpat
;
- /* Function application */
-fpat : fpat aapat { $$ = mkap($1,$2); }
- | aapat
+bpat : apatc
+ | conpat
+ | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
+ | MINUS INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
+ | MINUS FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
;
-dpatk : minuskey fpat { $$ = mknegate($2,NULL,NULL); }
- | fpatk
+conpat : gcon { $$ = mkident($1); }
+ | conpat apat { $$ = mkap($1,$2); }
;
- /* Function application */
-fpatk : fpatk aapat { $$ = mkap($1,$2); }
- | aapatk
+apat : gcon { $$ = mkident($1); }
+ | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
+ | apatc
;
-aapat : qvar { $$ = mkident($1); }
+apatc : qvar { $$ = mkident($1); }
| qvar AT apat { $$ = mkas($1,$3); }
- | gcon { $$ = mkident($1); }
- | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
| lit_constant { $$ = mklit($1); }
- | WILDCARD { $$ = mkwildp(); }
- | OPAREN opat CPAREN { $$ = mkpar($2); }
- | OPAREN opat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
+ | OPAREN pat CPAREN { $$ = mkpar($2); }
+ | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
+ | OUNBOXPAREN pat COMMA pats CUNBOXPAREN { $$ = mkutuple(mklcons($2,$4)); }
| OBRACK pats CBRACK { $$ = mkllist($2); }
| LAZY apat { $$ = mklazyp($2); }
;
-
-aapatk : qvark { $$ = mkident($1); }
- | qvark AT apat { $$ = mkas($1,$3); }
- | gconk { $$ = mkident($1); }
- | qconk OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
- | lit_constant { $$ = mklit($1); setstartlineno(); }
- | WILDCARD { $$ = mkwildp(); setstartlineno(); }
- | oparenkey opat CPAREN { $$ = mkpar($2); }
- | oparenkey opat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
- | obrackkey pats CBRACK { $$ = mkllist($2); }
- | lazykey apat { $$ = mklazyp($2); }
- ;
-
-gcon : qcon
- | OBRACK CBRACK { $$ = creategid(-1); }
- | OPAREN CPAREN { $$ = creategid(0); }
- | OPAREN commas CPAREN { $$ = creategid($2); }
- ;
-
-gconk : qconk
- | obrackkey CBRACK { $$ = creategid(-1); }
- | oparenkey CPAREN { $$ = creategid(0); }
- | oparenkey commas CPAREN { $$ = creategid($2); }
+lit_constant:
+ INTEGER { $$ = mkinteger($1); }
+ | FLOAT { $$ = mkfloatr($1); }
+ | CHAR { $$ = mkcharr($1); }
+ | STRING { $$ = mkstring($1); }
+ | CHARPRIM { $$ = mkcharprim($1); }
+ | STRINGPRIM { $$ = mkstringprim($1); }
+ | INTPRIM { $$ = mkintprim($1); }
+ | FLOATPRIM { $$ = mkfloatprim($1); }
+ | DOUBLEPRIM { $$ = mkdoubleprim($1); }
+ | CLITLIT /* yurble yurble */ { $$ = mkclitlit($1); }
;
+/* Sequence of apats for a lambda abstraction */
lampats : apat lampats { $$ = mklcons($1,$2); }
| apat { $$ = lsing($1); }
/* right recursion? (WDP) */
;
+/* Comma-separated sequence of pats */
pats : pat COMMA pats { $$ = mklcons($1, $3); }
| pat { $$ = lsing($1); }
/* right recursion? (WDP) */
;
-pat : pat qconop bpat { $$ = mkinfixap($2,$1,$3); precparse($$); }
- | bpat
+/* Comma separated sequence of record patterns, each of form 'field=pat' */
+rpats : /* empty */ { $$ = Lnil; }
+ | rpats1
;
-bpat : apatc
- | conpat
- | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
- | MINUS INTEGER { $$ = mklit(mkinteger(ineg($2))); }
- | MINUS FLOAT { $$ = mklit(mkfloatr(ineg($2))); }
+rpats1 : rpat { $$ = lsing($1); }
+ | rpats1 COMMA rpat { $$ = lapp($1,$3); }
;
-conpat : gcon { $$ = mkident($1); }
- | conpat apat { $$ = mkap($1,$2); }
+rpat : qvar EQUAL pat { $$ = mkrbind($1,mkjust($3)); }
;
-apat : gcon { $$ = mkident($1); }
- | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
- | apatc
+
+/* I can't figure out just what these ...k patterns are for.
+ It seems to have something to do with recording the line number */
+
+/* Corresponds to a cpat */
+patk : patk qconop bpat { $$ = mkinfixap($2,$1,$3); }
+ | bpatk
;
-apatc : qvar { $$ = mkident($1); }
- | qvar AT apat { $$ = mkas($1,$3); }
- | lit_constant { $$ = mklit($1); }
- | WILDCARD { $$ = mkwildp(); }
- | OPAREN pat CPAREN { $$ = mkpar($2); }
- | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
- | OBRACK pats CBRACK { $$ = mkllist($2); }
- | LAZY apat { $$ = mklazyp($2); }
+bpatk : apatck
+ | conpatk
+ | qconk OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
+ | minuskey INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
+ | minuskey FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
;
-lit_constant:
- INTEGER { $$ = mkinteger($1); }
- | FLOAT { $$ = mkfloatr($1); }
- | CHAR { $$ = mkcharr($1); }
- | STRING { $$ = mkstring($1); }
- | CHARPRIM { $$ = mkcharprim($1); }
- | STRINGPRIM { $$ = mkstringprim($1); }
- | INTPRIM { $$ = mkintprim($1); }
- | FLOATPRIM { $$ = mkfloatprim($1); }
- | DOUBLEPRIM { $$ = mkdoubleprim($1); }
- | CLITLIT /* yurble yurble */ { $$ = mkclitlit($1, ""); }
- | CLITLIT KIND_PRAGMA CONID { $$ = mkclitlit($1, $3); }
- | NOREP_INTEGER INTEGER { $$ = mknorepi($2); }
- | NOREP_RATIONAL INTEGER INTEGER { $$ = mknorepr($2, $3); }
- | NOREP_STRING STRING { $$ = mknoreps($2); }
+conpatk : gconk { $$ = mkident($1); }
+ | conpatk apat { $$ = mkap($1,$2); }
;
-rpats : rpat { $$ = lsing($1); }
- | rpats COMMA rpat { $$ = lapp($1,$3); }
+apatck : qvark { $$ = mkident($1); }
+ | qvark AT apat { $$ = mkas($1,$3); }
+ | lit_constant { $$ = mklit($1); setstartlineno(); }
+ | oparenkey pat CPAREN { $$ = mkpar($2); }
+ | oparenkey pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
+ | ounboxparenkey pat COMMA pats CUNBOXPAREN
+ { $$ = mkutuple(mklcons($2,$4)); }
+ | obrackkey pats CBRACK { $$ = mkllist($2); }
+ | lazykey apat { $$ = mklazyp($2); }
;
-rpat : qvar { $$ = mkrbind($1,mknothing()); }
- | qvar EQUAL pat { $$ = mkrbind($1,mkjust($3)); }
+
+gcon : qcon
+ | OBRACK CBRACK { $$ = creategid(NILGID); }
+ | OPAREN CPAREN { $$ = creategid(UNITGID); }
+ | OPAREN commas CPAREN { $$ = creategid($2); }
;
+gconk : qconk
+ | obrackkey CBRACK { $$ = creategid(NILGID); }
+ | oparenkey CPAREN { $$ = creategid(UNITGID); }
+ | oparenkey commas CPAREN { $$ = creategid($2); }
+ ;
/**********************************************************************
* *
* *
**********************************************************************/
-importkey: IMPORT { setstartlineno(); }
+importkey: IMPORT { setstartlineno(); $$ = 0; }
+ | IMPORT SOURCE_UPRAGMA { setstartlineno(); $$ = 1; }
;
datakey : DATA { setstartlineno();
defaultkey: DEFAULT { setstartlineno(); }
;
+foreignkey: FOREIGN { setstartlineno(); }
+ ;
+
classkey: CLASS { setstartlineno();
if(etags)
#if 1/*etags*/
}
;
-minuskey: MINUS { setstartlineno(); }
- ;
-
modulekey: MODULE { setstartlineno();
if(etags)
#if 1/*etags*/
oparenkey: OPAREN { setstartlineno(); }
;
+ounboxparenkey: OUNBOXPAREN { setstartlineno(); }
+ ;
+
obrackkey: OBRACK { setstartlineno(); }
;
lazykey : LAZY { setstartlineno(); }
;
+minuskey: MINUS { setstartlineno(); }
+ ;
+
/**********************************************************************
* *
| MINUS { $$ = install_literal("-"); }
;
+/* PLUS, BANG are valid varsyms */
+varsym_nominus : VARSYM
+ | PLUS { $$ = install_literal("+"); }
+ | BANG { $$ = install_literal("!"); }
+ | DOT { $$ = install_literal("."); }
+ ;
+
/* AS HIDING QUALIFIED are valid varids */
-varid : VARID
+varid : varid_noforall
+ | FORALL { $$ = install_literal("forall"); }
+ ;
+
+varid_noforall
+ : VARID
| AS { $$ = install_literal("as"); }
| HIDING { $$ = install_literal("hiding"); }
| QUALIFIED { $$ = install_literal("qualified"); }
- | INTERFACE { $$ = install_literal("interface"); }
- ;
-
-/* DARROW BANG are valid varsyms */
-varsym_nominus : VARSYM
- | DARROW { $$ = install_literal("=>"); }
- | BANG { $$ = install_literal("!"); }
+/* The rest of these guys are used by the FFI decls, a ghc (and hugs) extension. */
+ | EXPORT { $$ = install_literal("export"); }
+ | UNSAFE { $$ = install_literal("unsafe"); }
+ | DYNAMIC { $$ = install_literal("dynamic"); }
+ | LABEL { $$ = install_literal("label"); }
+ | C_CALL { $$ = install_literal("ccall"); }
+ | STDCALL { $$ = install_literal("stdcall"); }
+ | PASCAL { $$ = install_literal("pascal"); }
;
ccallid : VARID
| CONID
;
-tyvar : varid { $$ = mknamedtvar($1); }
- ;
tycon : CONID
;
modid : CONID
;
-tyvar_list: tyvar { $$ = lsing($1); }
- | tyvar_list COMMA tyvar { $$ = lapp($1,$3); }
+/* ---------------------------------------------- */
+tyvar : varid_noforall { $$ = $1; }
+ ;
+
+/* tyvars1: At least one tyvar */
+tyvars1 : tyvar { $$ = lsing($1); }
+ | tyvar tyvars1 { $$ = mklcons($1,$2); }
;
/**********************************************************************
ccurly :
CCURLY
{
- FN = NULL; SAMEFN = 0; PREVPATT = NULL;
+ FN = NULL; SAMEFN = 0;
hsendindent();
}
;
vccurly1:
VCCURLY
{
- FN = NULL; SAMEFN = 0; PREVPATT = NULL;
+ FN = NULL; SAMEFN = 0;
hsendindent();
}
| error
{
yyerrok;
- FN = NULL; SAMEFN = 0; PREVPATT = NULL;
+ FN = NULL; SAMEFN = 0;
hsendindent();
}
- ;
+ ;
%%
* *
**********************************************************************/
+
+void
+checkinpat()
+{
+ if(pat_check)
+ hsperror("pattern syntax used in expression");
+}
+
/* The parser calls "hsperror" when it sees a
`report this and die' error. It sets the stage
and calls "yyerror".
/* We want to be able to distinguish 'error'-raised yyerrors
from yyerrors explicitly coded by the parser hacker.
*/
- if (expect_ccurly && ! error_and_I_mean_it ) {
+ if ( expect_ccurly && ! error_and_I_mean_it ) {
/*NOTHING*/;
} else {
- fprintf(stderr, "\"%s\", line %d, column %d: %s on input: ",
+ fprintf(stderr, "%s:%d:%d: %s on input: ",
input_filename, hsplineno, hspcolno + 1, s);
if (yyleng == 1 && *yytext == '\0')
projects / ghc-hetmet.git / blobdiff