-/* -*- mode: hugs-c; -*- */
+
/* --------------------------------------------------------------------------
* Hugs parser (included as part of input.c)
*
- * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
- * All rights reserved. See NOTICE for details and conditions of use etc...
- * Hugs version 1.4, December 1997
+ * Expect 6 shift/reduce conflicts when passing this grammar through yacc,
+ * but don't worry; they should all be resolved in an appropriate manner.
*
- * Expect 24 shift/reduce conflicts when passing this grammar through yacc,
- * but don't worry; they will all be resolved in an appropriate manner.
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved. It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
*
* $RCSfile: parser.y,v $
- * $Revision: 1.2 $
- * $Date: 1998/12/02 13:22:26 $
+ * $Revision: 1.30 $
+ * $Date: 2000/04/25 17:43:50 $
* ------------------------------------------------------------------------*/
%{
#ifndef lint
#define lint
#endif
-#define defTycon(n,l,lhs,rhs,w) tyconDefn(intOf(l),lhs,rhs,w); sp-=n
#define sigdecl(l,vs,t) ap(SIGDECL,triple(l,vs,t))
+#define fixdecl(l,ops,a,p) ap(FIXDECL,\
+ triple(l,ops,mkInt(mkSyntax(a,intOf(p)))))
#define grded(gs) ap(GUARDED,gs)
-#define bang(t) ap(BANG,t)
#define only(t) ap(ONLY,t)
#define letrec(bs,e) (nonNull(bs) ? ap(LETREC,pair(bs,e)) : e)
-#define exportSelf() singleton(ap(MODULEENT,mkCon(module(currentModule).text)))
+#define qualify(ps,t) (nonNull(ps) ? ap(QUAL,pair(ps,t)) : t)
#define yyerror(s) /* errors handled elsewhere */
#define YYSTYPE Cell
-static Cell local gcShadow Args((Int,Cell));
-static Void local syntaxError Args((String));
-static String local unexpected Args((Void));
-static Cell local checkPrec Args((Cell));
-static Void local fixDefn Args((Syntax,Cell,Cell,List));
-static Void local setSyntax Args((Int,Syntax,Cell));
-static Cell local buildTuple Args((List));
-static List local checkContext Args((List));
-static Cell local checkPred Args((Cell));
-static Pair local checkDo Args((List));
-static Cell local checkTyLhs Args((Cell));
+static Cell local gcShadow ( Int,Cell );
+static Void local syntaxError ( String );
+static String local unexpected ( Void );
+static Cell local checkPrec ( Cell );
+static Void local fixDefn ( Syntax,Cell,Cell,List );
+static Cell local buildTuple ( List );
+static List local checkCtxt ( List );
+static Cell local checkPred ( Cell );
+static Pair local checkDo ( List );
+static Cell local checkTyLhs ( Cell );
#if !TREX
-static Void local noTREX Args((String));
+static Void local noTREX ( String );
+#endif
+#if !IPARAM
+static Void local noIP ( String );
#endif
-static Cell local tidyInfix Args((Cell));
/* For the purposes of reasonably portable garbage collection, it is
* necessary to simulate the YACC stack on the Hugs stack to keep
* taking account of look-ahead tokens as described by gcShadow()
* below.
*
- * Of the non-terminals used below, only start, topDecl, fixDecl & begin
+ * Of the non-terminals used below, only start, topDecl & begin
* do not leave any values on the Hugs stack. The same is true for the
* terminals EXPR and SCRIPT. At the end of a successful parse, there
* should only be one element left on the stack, containing the result
* of the parse.
*/
-#define gc0(e) gcShadow(0,e)
-#define gc1(e) gcShadow(1,e)
-#define gc2(e) gcShadow(2,e)
-#define gc3(e) gcShadow(3,e)
-#define gc4(e) gcShadow(4,e)
-#define gc5(e) gcShadow(5,e)
-#define gc6(e) gcShadow(6,e)
-#define gc7(e) gcShadow(7,e)
+#define gc0(e) gcShadow(0,e)
+#define gc1(e) gcShadow(1,e)
+#define gc2(e) gcShadow(2,e)
+#define gc3(e) gcShadow(3,e)
+#define gc4(e) gcShadow(4,e)
+#define gc5(e) gcShadow(5,e)
+#define gc6(e) gcShadow(6,e)
+#define gc7(e) gcShadow(7,e)
+#define gc8(e) gcShadow(8,e)
+#define gc9(e) gcShadow(9,e)
%}
-%token EXPR SCRIPT
+%token EXPR CONTEXT SCRIPT
%token CASEXP OF DATA TYPE IF
%token THEN ELSE WHERE LET IN
-%token INFIX INFIXL INFIXR FOREIGN TNEWTYPE
+%token INFIXN INFIXL INFIXR FOREIGN TNEWTYPE
%token DEFAULT DERIVING DO TCLASS TINSTANCE
-%token REPEAT ALL
-%token VAROP VARID NUMLIT CHARLIT STRINGLIT
-%token CONOP CONID
+%token MDO
+/*#if IPARAM*/
+%token WITH DLET
+/*#endif*/
+%token REPEAT ALL NUMLIT CHARLIT STRINGLIT
+%token VAROP VARID CONOP CONID
%token QVAROP QVARID QCONOP QCONID
/*#if TREX*/
-%token RECSELID
+%token RECSELID IPVARID
/*#endif*/
%token COCO '=' UPTO '@' '\\'
%token '|' '-' FROM ARROW '~'
%token '!' IMPLIES '(' ',' ')'
%token '[' ';' ']' '`' '.'
-%token MODULETOK IMPORT HIDING QUALIFIED ASMOD
-%token EXPORT INTERFACE REQUIRES UNSAFE
+%token TMODULE IMPORT HIDING QUALIFIED ASMOD
+%token EXPORT UUEXPORT INTERFACE REQUIRES UNSAFE
+%token INSTIMPORT DYNAMIC CCALL STDKALL
+%token UTL UTR UUUSAGE
%%
-/*- Top level script/module structure: ------------------------------------*/
+/*- Top level script/module structure -------------------------------------*/
-start : EXPR exp wherePart {inputExpr = letrec($3,$2); sp-=2;}
- | SCRIPT topModule {valDefns = $2; sp-=1;}
- | INTERFACE iface {sp-=1;}
- | error {syntaxError("input");}
+start : EXPR exp wherePart {inputExpr = letrec($3,$2); sp-=2;}
+ | CONTEXT context {inputContext = $2; sp-=1;}
+ | SCRIPT topModule {drop(); push($2);}
+ | INTERFACE iface {sp-=1;}
+ | error {syntaxError("input");}
;
+
/*- GHC interface file parsing: -------------------------------------------*/
/* Reading in an interface file is surprisingly like reading
* have to read in expressions.
*/
-iface : INTERFACE ifaceName NUMLIT checkVersion ifaceDecls { $$ = gc5(NIL); }
+/*- Top-level interface files -----------------------------*/
+iface : INTERFACE STRINGLIT ifCon NUMLIT ifOrphans ifCheckVersion WHERE ifTopDecls
+ {$$ = gc8(ap(I_INTERFACE,
+ zpair($3,$8))); }
| INTERFACE error {syntaxError("interface file");}
;
-ifaceName : CONID {openGHCIface(textOf($1)); $$ = gc1(NIL);}
+ifTopDecls: {$$=gc0(NIL);}
+ | ifTopDecl ';' ifTopDecls {$$=gc3(cons($1,$3));}
;
-ifaceDecls: {$$=gc0(NIL);}
- | ifaceDecl ';' ifaceDecls {$$=gc3(cons($1,$2));}
- ;
+ifTopDecl
+ : IMPORT CONID NUMLIT ifOrphans ifIsBoot ifOptCOCO ifVersionList
+ {$$=gc7(ap(I_IMPORT,zpair($2,$7))); }
-/* We use ifaceData in data decls so as to include () */
-ifaceDecl : IMPORT CONID NUMLIT { extern String scriptFile;
- String fileName = findPathname(scriptFile,textToStr(textOf($2)));
- addGHCImport(intOf($1),textOf($2),fileName);
- $$ = gc3(NIL);
- }
- | EXPORT CONID ifaceEntities {}
- | REQUIRES STRINGLIT { extern String scriptFile;
- String fileName = findPathname(scriptFile,textToStr(textOf($2)));
- loadSharedLib(fileName);
- $$ = gc2(NIL);
- }
- | INFIXL optdigit op { fixDefn(LEFT_ASS,$1,$2,$3); $$ = gc3(NIL); }
- | INFIXR optdigit op { fixDefn(RIGHT_ASS,$1,$2,$3); $$ = gc3(NIL); }
- | INFIX optdigit op { fixDefn(NON_ASS,$1,$2,$3); $$ = gc3(NIL); }
- | TINSTANCE ifaceQuant ifaceClass '=' ifaceVar { addGHCInstance(intOf($1),$2,$3,textOf($5)); $$ = gc5(NIL); }
- | NUMLIT TYPE ifaceTCName ifaceTVBndrs '=' ifaceType { addGHCSynonym(intOf($2),$3,$4,$6); $$ = gc6(NIL); }
- | NUMLIT DATA ifaceData ifaceTVBndrs ifaceConstrs ifaceSels { addGHCDataDecl(intOf($2),$3,$4,$5,$6); $$ = gc6(NIL); }
- | NUMLIT TNEWTYPE ifaceTCName ifaceTVBndrs ifaceNewTypeConstr { addGHCNewType(intOf($2),$3,$4,$5); $$ = gc5(NIL); }
- | NUMLIT TCLASS ifaceDeclContext ifaceTCName ifaceTVBndrs ifaceCSigs { addGHCClass(intOf($2),$3,$4,$5,$6); $$ = gc6(NIL); }
- | NUMLIT ifaceVar COCO ifaceType { addGHCVar(intOf($3),textOf($2),$4); $$ = gc4(NIL); }
- | error { syntaxError("interface declaration"); }
- ;
+ | INSTIMPORT CONID {$$=gc2(ap(I_INSTIMPORT,NIL));}
-checkVersion
- : NUMLIT { $$ = gc1(NIL); }
- ;
+ | UUEXPORT CONID ifEntities {$$=gc3(ap(I_EXPORT,zpair($2,$3)));}
-ifaceSels /* [(VarId,Type)] */
- : { $$ = gc0(NIL); }
- | WHERE '{' ifaceSels1 '}' { $$ = gc4($3); }
- ;
+ | NUMLIT INFIXL optDigit ifVarCon
+ {$$=gc4(ap(I_FIXDECL,
+ ztriple($3,mkInt(LEFT_ASS),$4)));}
+ | NUMLIT INFIXR optDigit ifVarCon
+ {$$=gc4(ap(I_FIXDECL,
+ ztriple($3,mkInt(RIGHT_ASS),$4)));}
+ | NUMLIT INFIXN optDigit ifVarCon
+ {$$=gc4(ap(I_FIXDECL,
+ ztriple($3,mkInt(NON_ASS),$4)));}
-ifaceSels1 /* [(VarId,Type)] */
- : ifaceSel { $$ = gc1(singleton($1)); }
- | ifaceSel ';' ifaceSels1 { $$ = gc3(cons($1,$3)); }
- ;
+ | TINSTANCE ifCtxInst ifInstHdL '=' ifVar
+ {$$=gc5(ap(I_INSTANCE,
+ z5ble($1,$2,$3,$5,NIL)));}
-ifaceSel /* (VarId,Type) */
- : ifaceVarName COCO ifaceType { $$ = gc3(pair($1,$3)); }
- ;
+ | NUMLIT TYPE ifCon ifKindedTyvarL '=' ifType
+ {$$=gc6(ap(I_TYPE,
+ z4ble($2,$3,$4,$6)));}
-ifaceCSigs /* [(VarId,Type)] */
- : { $$ = gc0(NIL); }
- | WHERE '{' ifaceCSigs1 '}' { $$ = gc4($3); }
- ;
+ | NUMLIT DATA ifCtxDecl ifConData ifKindedTyvarL ifConstrs
+ {$$=gc6(ap(I_DATA,
+ z5ble($2,$3,$4,$5,$6)));}
+
+ | NUMLIT TNEWTYPE ifCtxDecl ifConData ifKindedTyvarL ifNewTypeConstr
+ {$$=gc6(ap(I_NEWTYPE,
+ z5ble($2,$3,$4,$5,$6)));}
+
+ | NUMLIT TCLASS ifCtxDecl ifCon ifKindedTyvar ifCmeths
+ {$$=gc6(ap(I_CLASS,
+ z5ble($2,$3,$4,
+ singleton($5),$6)));}
+
+ | NUMLIT ifVar COCO ifType
+ {$$=gc4(ap(I_VALUE,
+ ztriple($3,$2,$4)));}
-ifaceCSigs1 /* [(VarId,Type)] */
- : ifaceCSig { $$ = gc1(singleton($1)); }
- | ifaceCSig ';' ifaceCSigs1 { $$ = gc3(cons($1,$3)); }
+ | error { syntaxError(
+ "interface declaration"); }
;
-ifaceCSig /* (VarId,Type) */
- : ifaceVarName COCO ifaceType { $$ = gc3(pair($1,$3)); }
- | ifaceVarName '=' COCO ifaceType { $$ = gc4(pair($1,$4)); } /* has default method */
+
+/*- Top-level misc interface stuff ------------------------*/
+ifOrphans : '!' {$$=gc1(NIL);}
+ | {$$=gc0(NIL);}
+ifIsBoot : '@' {$$=gc1(NIL);}
+ | {$$=gc0(NIL);}
+ ;
+ifOptCOCO : COCO {$$=gc1(NIL);}
+ | {$$=gc0(NIL);}
+ ;
+ifCheckVersion
+ : NUMLIT {$$ = gc1(NIL); }
;
-ifaceConstrs /* [(ConId,[VarId],Type)] */
- : { $$ = gc0(NIL); }
- | '=' ifaceConstrs1 { $$ = gc2($2); }
+
+
+/*- Interface variable and constructor ids ----------------*/
+ifTyvar : VARID {$$ = $1;}
+ ;
+ifVar : VARID {$$ = gc1($1);}
+ ;
+ifCon : CONID {$$ = gc1($1);}
;
-ifaceConstrs1 /* [(ConId,[VarId],Type)] */
- : ifaceConstr { $$ = gc1(singleton($1)); }
- | ifaceConstr '|' ifaceConstrs1 { $$ = gc3(cons($1,$3)); }
+ifVarCon : VARID {$$ = gc1($1);}
+ | CONID {$$ = gc1($1);}
;
-/* We use ifaceData so as to include () */
-ifaceConstr /* (ConId,[VarId],Type) */
- : ifaceData COCO ifaceType { $$ = gc3(triple($1,NIL,$3)); }
- | ifaceData '{' ifaceVarNames1 '}' COCO ifaceType { $$ = gc6(triple($1,$3,$6)); }
+ifQCon : CONID {$$ = gc1($1);}
+ | QCONID {$$ = gc1($1);}
+ ;
+ifConData : ifCon {$$ = gc1($1);}
+ | '(' ')' {$$ = gc2(typeUnit);}
+ | '[' ']' {$$ = gc2(typeList);}
+ | '(' ARROW ')' {$$ = gc3(typeArrow);}
;
+ifTCName : CONID { $$ = gc1($1); }
+ | CONOP { $$ = gc1($1); }
+ | '(' ARROW ')' { $$ = gc3(typeArrow); }
+ | '[' ']' { $$ = gc1(typeList); }
+ ;
+ifQTCName : ifTCName { $$ = gc1($1); }
+ | QCONID { $$ = gc1($1); }
+ | QCONOP { $$ = gc1($1); }
+ ;
+
-ifaceNewTypeConstr /* (ConId,Type) */
- : { $$ = gc0(NIL); }
- | '=' ifaceDataName COCO ifaceType { $$ = gc4(pair($2,$4)); }
+/*- Interface contexts ------------------------------------*/
+ifCtxInst /* __forall [a b] => :: [((VarId,Kind))] */
+ : ALL ifForall IMPLIES {$$=gc3($2);}
+ | {$$=gc0(NIL);}
+ ;
+ifInstHd /* { Class aType } :: ((ConId, Type)) */
+ : '{' ifQCon ifAType '}' {$$=gc4(ap(DICTAP,
+ zpair($2,$3)));}
;
-ifaceQuant /* Maybe ([(VarId,Kind)],[(ConId, [Type])]) */
- : { $$ = gc0(NIL); }
- | ALL ifaceForall ifaceContext IMPLIES { $$ = gc4(pair($2,$3)); }
+ifInstHdL /* { C a1 } -> { C2 a2 } -> ... -> { Cn an } :: Type */
+ : ifInstHd ARROW ifInstHdL {$$=gc3(ap($1,$3));}
+ | ifInstHd {$$=gc1($1);}
;
-ifaceType
- : ALL ifaceForall ifaceContext IMPLIES ifaceType { $$ = gc5(ap(POLYTYPE,triple($2,$3,$5))); }
- | ifaceBType ARROW ifaceType { $$ = gc3(fn($1,$3)); }
- | ifaceBType { $$ = gc1($1); }
- ;
-
-ifaceForall /* [(VarId,Kind)] */
- : '[' ifaceTVBndrs ']' { $$ = gc3($2); }
- ;
-
-ifaceDeclContext /* [(ConId, [Type])] */
- : { $$ = gc0(NIL); }
- | '{' ifaceContextList1 '}' IMPLIES { $$ = gc4($2); }
+ifCtxDecl /* {M.C1 a, C2 b} => :: [(QConId, VarId)] */
+ : ifCtxDeclT IMPLIES { $$ = gc2($1); }
+ | { $$ = gc0(NIL); }
;
-
-ifaceContext /* [(ConId, [Type])] */
- : { $$ = gc0(NIL); }
- | '{' ifaceContextList1 '}' { $$ = gc3($2); }
+ifCtxDeclT /* {M.C1 a, C2 b} :: [(QConId, VarId)] */
+ : { $$ = gc0(NIL); }
+ | '{' ifCtxDeclL '}' { $$ = gc3($2); }
;
-
-ifaceContextList1 /* [(ConId, [Type])] */
- : ifaceClass { $$ = gc1(singleton($1)); }
- | ifaceClass ',' ifaceContextList1 { $$ = gc3(cons($1,$3)); }
+
+ifCtxDeclL /* M.C1 a, C2 b :: [(QConId, VarId)] */
+ : ifCtxDeclLE ',' ifCtxDeclL {$$=gc3(cons($1,$3));}
+ | ifCtxDeclLE {$$=gc1(cons($1,NIL));}
+ | {$$=gc0(NIL);}
;
+ifCtxDeclLE /* M.C1 a :: (QConId,VarId) */
+ : ifQCon ifTyvar {$$=gc2(zpair($1,$2));}
+ ;
+
-ifaceClass /* (ConId, [Type]) */
- : ifaceQTCName ifaceATypes { $$ = gc2(pair($1,$2)); }
- ;
+/*- Interface data declarations - constructor lists -------*/
+/* The (Type,VarId,Int) are (field type, name (or NIL), strictness).
+ Strictness is a number: mkInt(0) indicates lazy, mkInt(1)
+ indicates a strict field (!type) as in standard H98, and
+ mkInt(2) indicates unpacked -- a GHC extension.
+*/
-ifaceTypes2
- : ifaceType ',' ifaceType { $$ = gc3(doubleton($1,$3)); }
- | ifaceType ',' ifaceTypes2 { $$ = gc3(cons($1,$3)); }
+ifConstrs /* = Con1 | ... | ConN :: [((ConId,[((Type,VarId,Int))]))] */
+ : {$$ = gc0(NIL);}
+ | '=' ifConstrL {$$ = gc2($2);}
;
-
-ifaceBType
- : ifaceAType { $$ = gc1($1); }
- | ifaceBType ifaceAType { $$ = gc2(ap($1,$2)); }
+ifConstrL /* [((ConId,[((Type,VarId,Int))]))] */
+ : ifConstr {$$ = gc1(singleton($1));}
+ | ifConstr '|' ifConstrL {$$ = gc3(cons($1,$3));}
;
-
-ifaceAType
- : ifaceQTCName { $$ = gc1($1); }
- | ifaceTVName { $$ = gc1($1); }
- | '(' ')' { $$ = gc2(conPreludeUnit); }
- | '(' ifaceTypes2 ')' { $$ = gc3(buildTuple($2)); }
- | '[' ifaceType ']' { $$ = gc3(ap(conPreludeList,$2));}
- | '{' ifaceQTCName ifaceATypes '}' { $$ = gc4(ap(DICTAP,pair($2,$3))); }
- | '(' ifaceType ')' { $$ = gc3($2); }
+ifConstr /* ((ConId,[((Type,VarId,Int))])) */
+ : ifConData ifDataAnonFieldL {$$ = gc2(zpair($1,$2));}
+ | ifConData '{' ifDataNamedFieldL '}'
+ {$$ = gc4(zpair($1,$3));}
;
-
-ifaceATypes
- : { $$ = gc0(NIL); }
- | ifaceAType ifaceATypes { $$ = gc2(cons($1,$2)); }
+ifDataAnonFieldL /* [((Type,VarId,Int))] */
+ : {$$=gc0(NIL);}
+ | ifDataAnonField ifDataAnonFieldL
+ {$$=gc2(cons($1,$2));}
;
-
-ifaceEntities
- : { $$ = gc0(NIL); }
- | ifaceEntity ifaceEntities { $$ = gc2(cons($1,$2)); }
+ifDataNamedFieldL /* [((Type,VarId,Int))] */
+ : {$$=gc0(NIL);}
+ | ifDataNamedField {$$=gc1(cons($1,NIL));}
+ | ifDataNamedField ',' ifDataNamedFieldL
+ {$$=gc3(cons($1,$3));}
;
-
-ifaceEntity
- : ifaceEntityOcc {}
- | ifaceEntityOcc ifaceStuffInside {}
-| ifaceEntityOcc '|' ifaceStuffInside {} /* exporting datacons but not tycon */
+ifDataAnonField /* ((Type,VarId,Int)) */
+ : ifAType {$$=gc1(ztriple($1,NIL,mkInt(0)));}
+ | '!' ifAType {$$=gc2(ztriple($2,NIL,mkInt(1)));}
+ | '!' '!' ifAType {$$=gc3(ztriple($3,NIL,mkInt(2)));}
;
-
-ifaceEntityOcc
- : ifaceVar { $$ = gc1($1); }
- | ifaceData { $$ = gc1($1); }
- | ARROW { $$ = gc3(typeArrow); }
- | '(' ARROW ')' { $$ = gc3(typeArrow); } /* why allow both? */
+ifDataNamedField /* ((Type,VarId,Int)) */
+ : ifVar COCO ifAType {$$=gc3(ztriple($3,$1,mkInt(0)));}
+ | ifVar COCO '!' ifAType {$$=gc4(ztriple($4,$1,mkInt(1)));}
+ | ifVar COCO '!' '!' ifAType {$$=gc5(ztriple($5,$1,mkInt(2)));}
;
-ifaceStuffInside
- : '{' ifaceValOccs '}' { $$ = gc1($1); }
+
+/*- Interface class declarations - methods ----------------*/
+ifCmeths /* [((VarId,Type))] */
+ : { $$ = gc0(NIL); }
+ | WHERE '{' ifCmethL '}' { $$ = gc4($3); }
+ ;
+ifCmethL /* [((VarId,Type))] */
+ : ifCmeth { $$ = gc1(singleton($1)); }
+ | ifCmeth ';' ifCmethL { $$ = gc3(cons($1,$3)); }
+ ;
+ifCmeth /* ((VarId,Type)) */
+ : ifVar COCO ifType { $$ = gc3(zpair($1,$3)); }
+ | ifVar '=' COCO ifType { $$ = gc4(zpair($1,$4)); }
+ /* has default method */
;
-ifaceValOccs
- : ifaceValOcc { $$ = gc1(singleton($1)); }
- | ifaceValOcc ifaceValOccs { $$ = gc2(cons($1,$2)); }
+/*- Interface newtype declararions ------------------------*/
+ifNewTypeConstr /* ((ConId,Type)) */
+ : '=' ifCon ifAType { $$ = gc3(zpair($2,$3)); }
;
-ifaceValOcc
- : ifaceVar {$$ = gc1($1); }
- | ifaceData {$$ = gc1($1); }
- ;
-ifaceVar : VARID {$$ = gc1($1); }
- | VAROP {$$ = gc1($1); }
- | '!' {$$ = gc1(varBang); }
- | '.' {$$ = gc1(varDot); }
- | '-' {$$ = gc1(varMinus);}
+/*- Interface type expressions ----------------------------*/
+ifType : ALL ifForall ifCtxDeclT IMPLIES ifType
+ { if ($3 == NIL)
+ $$=gc5($5); else
+ $$=gc5(pair(QUAL,pair($3,$5)));
+ }
+ | ifBType ARROW ifType { $$ = gc3(fn($1,$3)); }
+ | ifBType { $$ = gc1($1); }
+ ;
+ifForall /* [((VarId,Kind))] */
+ : '[' ifKindedTyvarL ']' { $$ = gc3($2); }
;
-ifaceData /* ConId | QualConId */
- : CONID {$$ = gc1($1);}
- | CONOP {$$ = gc1($1);}
- | '(' ')' {$$ = gc2(conPreludeUnit);}
- | '[' ']' {$$ = gc2(conPreludeList);}
+ifTypeL2 /* [Type], 2 or more */
+ : ifType ',' ifType { $$ = gc3(doubleton($1,$3)); }
+ | ifType ',' ifTypeL2 { $$ = gc3(cons($1,$3)); }
;
-ifaceVarName /* VarId */
- : ifaceVar { $$ = gc1($1); }
+ifTypeL /* [Type], 0 or more */
+ : ifType ',' ifTypeL { $$ = gc3(cons($1,$3)); }
+ | ifType { $$ = gc1(singleton($1)); }
+ | { $$ = gc0(NIL); }
;
-ifaceDataName /* ConId|QualConId */
- : ifaceData { $$ = gc1($1); }
+ifBType : ifAType { $$ = gc1($1); }
+ | ifBType ifAType { $$ = gc2(ap($1,$2)); }
+ | UUUSAGE ifUsage ifAType { $$ = gc3($3); }
;
-ifaceVarNames1 /* [VarId] */
- : ifaceVarName { $$ = gc1(singleton($1)); }
- | ifaceVarName ifaceVarNames1 { $$ = gc2(cons($1,$2)); }
+ifAType : ifQTCName { $$ = gc1($1); }
+ | ifTyvar { $$ = gc1($1); }
+ | '(' ')' { $$ = gc2(typeUnit); }
+ | '(' ifTypeL2 ')' { $$ = gc3(buildTuple(reverse($2))); }
+ | '[' ifType ']' { $$ = gc3(ap(mkCon(tycon(typeList).text),
+ $2));}
+ | '{' ifQTCName ifAType '}' { $$ = gc4(ap(DICTAP,
+ pair($2,$3))); }
+ | '(' ifType ')' { $$ = gc3($2); }
+ | UTL ifTypeL UTR { $$ = gc3(ap(UNBOXEDTUP,$2)); }
;
-ifaceTVName /* VarId */
- : VARID { $$ = gc1($1); }
- ;
-ifaceTVBndrs /* [(VarId,Kind)] */
- : { $$ = gc0(NIL); }
- | ifaceTVBndr ifaceTVBndrs { $$ = gc2(cons($1,$2)); }
+/*- KW's usage stuff --------------------------------------*/
+ifUsage : '-' { $$ = gc1(NIL); }
+ | '!' { $$ = gc1(NIL); }
+ | ifVar { $$ = gc1(NIL); }
;
-ifaceTVBndr /* (VarId,Kind) */
- : ifaceTVName { $$ = gc1(pair($1,STAR)); }
- | ifaceTVName COCO ifaceAKind { $$ = gc3(pair($1,$3)); }
- ;
-ifaceKind
- : ifaceAKind { $$ = gc1($1); }
- | ifaceAKind ARROW ifaceKind { $$ = gc3(fn($1,$3)); }
+/*- Interface kinds ---------------------------------------*/
+ifKindedTyvarL /* [((VarId,Kind))] */
+ : { $$ = gc0(NIL); }
+ | ifKindedTyvar ifKindedTyvarL { $$ = gc2(cons($1,$2)); }
+ ;
+ifKindedTyvar /* ((VarId,Kind)) */
+ : ifTyvar { $$ = gc1(zpair($1,STAR)); }
+ | ifTyvar COCO ifAKind { $$ = gc3(zpair($1,$3)); }
+ ;
+ifKind : ifAKind { $$ = gc1($1); }
+ | ifAKind ARROW ifKind { $$ = gc3(ap($1,$3)); }
;
+ifAKind : VAROP { $$ = gc1(STAR); }
+ /* should be '*' */
+ | '(' ifKind ')' { $$ = gc3($2); }
+ ;
+
-ifaceAKind
- : VAROP { $$ = gc1(STAR); } /* should be '*' */
- | '(' ifaceKind ')' { $$ = gc1($1); }
+/*- Interface version/export/import stuff -----------------*/
+ifEntities
+ : { $$ = gc0(NIL); }
+ | ifEntity ifEntities { $$ = gc2(cons($1,$2)); }
+ ;
+ifEntity
+ : ifEntityOcc {$$=gc1($1);}
+ | ifEntityOcc ifStuffInside {$$=gc2(zpair($1,$2));}
+ ;
+ifEntityOcc
+ : ifVar { $$ = gc1($1); }
+ | ifCon { $$ = gc1($1); }
+ | ARROW { $$ = gc1(typeArrow); }
+ | '(' ARROW ')' { $$ = gc3(typeArrow); }
+ /* why allow both? */
+ ;
+ifStuffInside
+ : '{' ifValOccs '}' { $$ = gc3($2); }
+ ;
+ifValOccs
+ : { $$ = gc0(NIL); }
+ | ifVar ifValOccs { $$ = gc2(cons($1,$2)); }
+ | ifCon ifValOccs { $$ = gc2(cons($1,$2)); }
;
-ifaceTCName
- : CONID { $$ = gc1($1); }
- | CONOP { $$ = gc1($1); }
- | '(' ARROW ')' { $$ = gc3(typeArrow); }
- | '[' ']' { $$ = gc1(conPreludeList); }
- ;
+ifVersionList
+ : {$$=gc0(NIL);}
+ | VARID NUMLIT ifVersionList {$$=gc3(cons($1,$3));}
+ | CONID NUMLIT ifVersionList {$$=gc3(cons($1,$3));}
+ ;
-ifaceQTCName
- : ifaceTCName { $$ = gc1($1); }
- | QCONID { $$ = gc1($1); }
- | QCONOP { $$ = gc1($1); }
- ;
-/*- Haskell module header/import parsing: ---------------------------------*/
+/*- Haskell module header/import parsing: -----------------------------------
+ * Module chasing is now totally different from Classic Hugs98. We parse
+ * the entire syntax tree. Subsequent passes over the tree collect and
+ * chase imports; we no longer attempt to do so whilst parsing.
+ *-------------------------------------------------------------------------*/
/* In Haskell 1.2, the default module header was "module Main where"
* In 1.3, this changed to "module Main(main) where".
* We use the 1.2 header because it breaks much less pre-module code.
+ * STG Hugs, 15 March 00: disallow default headers (pro tem).
*/
-topModule : startMain begin modBody end {
- setExportList(singleton(ap(MODULEENT,mkCon(module(currentModule).text))));
- $$ = gc3($3);
- }
- | MODULETOK modname expspec WHERE '{' modBody end
- {setExportList($3); $$ = gc7($6);}
- | MODULETOK error {syntaxError("module definition");}
- ;
-/* To implement the Haskell module system, we have to keep track of the
- * current module. We rely on the use of LALR parsing to ensure that this
- * side effect happens before any declarations within the module.
- */
-startMain : /* empty */ {startModule(conMain);
- $$ = gc0(NIL);}
+topModule : TMODULE modname expspec WHERE '{' modBody end
+ {$$=gc7(ap(M_MODULE,
+ ztriple($2,$3,$6)));}
+ | TMODULE modname WHERE '{' modBody end
+ {$$=gc6(ap(M_MODULE,
+ ztriple(
+ $2,
+ singleton(ap(MODULEENT,$2)),
+ $5)));}
+
+ | begin modBody end {ConId fakeNm = mkCon(module(
+ moduleBeingParsed).text);
+ $$ = gc2(ap(M_MODULE,
+ ztriple(fakeNm,
+ singleton(ap(MODULEENT,fakeNm)),
+ $2)));}
+
+ | TMODULE error {syntaxError("module definition");}
;
-modname : CONID {startModule($1); $$ = gc1(NIL);}
+
+modname : CONID {$$ = gc1($1);}
;
modid : CONID {$$ = gc1($1);}
- | STRINGLIT { extern String scriptFile;
- String modName = findPathname(scriptFile,textToStr(textOf($1)));
- if (modName) { /* fillin pathname if known */
- $$ = mkStr(findText(modName));
- } else {
- $$ = $1;
- }
- }
;
modBody : topDecls {$$ = gc1($1);}
- | fixDecls ';' topDecls {$$ = gc3($3);}
- | impDecls chase {$$ = gc2(NIL);}
- | impDecls ';' chase topDecls {$$ = gc4($4);}
- | impDecls ';' chase fixDecls ';' topDecls
- {$$ = gc6($6);}
+ | impDecls {$$ = gc1($1);}
+ | impDecls ';' topDecls {$$ = gc3(appendOnto($1,$3));}
;
/*- Exports: --------------------------------------------------------------*/
-expspec : /* empty */ {$$ = gc0(exportSelf());}
- | '(' ')' {$$ = gc2(NIL);}
+expspec : '(' ')' {$$ = gc2(NIL);}
| '(' exports ')' {$$ = gc3($2);}
| '(' exports ',' ')' {$$ = gc4($2);}
;
/* The qcon should be qconid.
* Relaxing the rule lets us explicitly export (:) from the Prelude.
*/
-export : qvar {$$ = gc1($1);}
- | qcon {$$ = gc1($1);}
- | qcon2 '(' UPTO ')' {$$ = gc4(pair($1,DOTDOT));}
- | qcon2 '(' qnames ')' {$$ = gc4(pair($1,$3));}
- | MODULETOK modid {$$ = gc2(ap(MODULEENT,$2));}
+export : qvar {$$ = $1;}
+ | qcon {$$ = $1;}
+ | qconid '(' UPTO ')' {$$ = gc4(pair($1,DOTDOT));}
+ | qconid '(' qnames ')' {$$ = gc4(pair($1,$3));}
+ | TMODULE modid {$$ = gc2(ap(MODULEENT,$2));}
;
qnames : /* empty */ {$$ = gc0(NIL);}
| ',' {$$ = gc1(NIL);}
- | qnames1 {$$ = gc1($1);}
+ | qnames1 {$$ = $1;}
| qnames1 ',' {$$ = gc2($1);}
;
qnames1 : qnames1 ',' qname {$$ = gc3(cons($3,$1));}
| qname {$$ = gc1(singleton($1));}
;
-qname : qvar {$$ = gc1($1);}
- | qcon {$$ = gc1($1);}
- | '(' ')' {$$ = gc2(conPreludeUnit);}
- | '[' ']' {$$ = gc2(conPreludeList);}
- ;
-qcon2 : '(' ')' {$$ = gc2(conPreludeUnit);}
- | '[' ']' {$$ = gc2(conPreludeList);}
- | qconid {$$ = gc1($1);}
+qname : qvar {$$ = $1;}
+ | qcon {$$ = $1;}
;
/*- Import declarations: --------------------------------------------------*/
-impDecls : impDecls ';' impDecl {imps = cons($3,imps); $$=gc3(NIL);}
- | impDecl {imps = singleton($1); $$=gc1(NIL);}
- ;
-chase : /* empty */ {if (chase(imps)) {
- clearStack();
- onto(imps);
- done();
- closeAnyInput();
- return 0;
- }
- $$ = gc0(NIL);
- }
+impDecls : impDecls ';' impDecl {$$ = gc3(appendOnto($3,$1));}
+ | impDecl {$$ = gc1($1);}
;
+
/* Note that qualified import ignores the import list. */
-impDecl : IMPORT modid impspec {addQualImport($2,$2);
- addUnqualImport($2,$3);
- $$ = gc3($2);}
+impDecl : IMPORT modid impspec {$$=gc3(doubleton(
+ ap(M_IMPORT_Q,zpair($2,$2)),
+ ap(M_IMPORT_UNQ,zpair($2,$3))
+ ));}
| IMPORT modid ASMOD modid impspec
- {addQualImport($2,$4);
- addUnqualImport($2,$5);
- $$ = gc5($2);}
+ {$$=gc5(doubleton(
+ ap(M_IMPORT_Q,zpair($2,$4)),
+ ap(M_IMPORT_UNQ,zpair($2,$5))
+ ));}
| IMPORT QUALIFIED modid ASMOD modid impspec
- {addQualImport($3,$5);
- $$ = gc6($3);}
+ {$$=gc6(singleton(
+ ap(M_IMPORT_Q,zpair($3,$5))
+ ));}
| IMPORT QUALIFIED modid impspec
- {addQualImport($3,$3);
- $$ = gc4($3);}
+ {$$=gc4(singleton(
+ ap(M_IMPORT_Q,zpair($3,$3))
+ ));}
| IMPORT error {syntaxError("import declaration");}
;
impspec : /* empty */ {$$ = gc0(DOTDOT);}
;
imports : /* empty */ {$$ = gc0(NIL);}
| ',' {$$ = gc1(NIL);}
- | imports1 {$$ = gc1($1);}
+ | imports1 {$$ = $1;}
| imports1 ',' {$$ = gc2($1);}
;
imports1 : imports1 ',' import {$$ = gc3(cons($3,$1));}
| import {$$ = gc1(singleton($1));}
;
-import : var {$$ = gc1($1);}
- | CONID {$$ = gc1($1);}
+import : var {$$ = $1;}
+ | CONID {$$ = $1;}
| CONID '(' UPTO ')' {$$ = gc4(pair($1,DOTDOT));}
| CONID '(' names ')' {$$ = gc4(pair($1,$3));}
;
names : /* empty */ {$$ = gc0(NIL);}
| ',' {$$ = gc1(NIL);}
- | names1 {$$ = gc1($1);}
+ | names1 {$$ = $1;}
| names1 ',' {$$ = gc2($1);}
;
names1 : names1 ',' name {$$ = gc3(cons($3,$1));}
| name {$$ = gc1(singleton($1));}
;
-name : var {$$ = gc1($1);}
- | con {$$ = gc1($1);}
- ;
-
-/*- Fixity declarations: --------------------------------------------------*/
-
-fixDecls : fixDecls ';' fixDecl {$$ = gc2(NIL);}
- | fixDecl {$$ = gc0(NIL);}
- ;
-fixDecl : INFIXL optdigit ops {fixDefn(LEFT_ASS,$1,$2,$3); sp-=3;}
- | INFIXR optdigit ops {fixDefn(RIGHT_ASS,$1,$2,$3);sp-=3;}
- | INFIX optdigit ops {fixDefn(NON_ASS,$1,$2,$3); sp-=3;}
- ;
-optdigit : NUMLIT {$$ = gc1(checkPrec($1));}
- | /* empty */ {$$ = gc0(mkInt(DEF_PREC));}
- ;
-ops : ops ',' op {$$ = gc3(cons($3,$1));}
- | op {$$ = gc1(cons($1,NIL));}
+name : var {$$ = $1;}
+ | con {$$ = $1;}
;
/*- Top-level declarations: -----------------------------------------------*/
-topDecls : /* empty */ {$$ = gc0(NIL);}
- | ';' {$$ = gc1(NIL);}
- | topDecls1 {$$ = gc1($1);}
- | topDecls1 ';' {$$ = gc2($1);}
- ;
-topDecls1 : topDecls1 ';' topDecl {$$ = gc2($1);}
- | topDecls1 ';' decl {$$ = gc3(cons($3,$1));}
- | topDecl {$$ = gc0(NIL);}
- | decl {$$ = gc1(cons($1,NIL));}
- ;
+topDecls : /* empty */ {$$=gc0(NIL);}
+ | topDecl ';' topDecls {$$=gc3(cons($1,$3));}
+ | decl ';' topDecls {$$=gc3(cons(ap(M_VALUE,$1),$3));}
+ | topDecl {$$=gc1(cons($1,NIL));}
+ | decl {$$=gc1(cons(ap(M_VALUE,$1),NIL));}
+ ;
/*- Type declarations: ----------------------------------------------------*/
-topDecl : TYPE tyLhs '=' type {defTycon(4,$3,$2,$4,SYNONYM);}
+topDecl : TYPE tyLhs '=' type {$$=gc4(ap(M_TYCON,
+ z4ble($3,$2,$4,
+ SYNONYM)));}
| TYPE tyLhs '=' type IN invars
- {defTycon(6,$3,$2,
- ap($4,$6),RESTRICTSYN);}
+ {$$=gc6(ap(M_TYCON,
+ z4ble($3,$2,ap($4,$6),
+ RESTRICTSYN)));}
+ | TYPE error {syntaxError("type definition");}
| DATA btype2 '=' constrs deriving
- {defTycon(5,$3,checkTyLhs($2),
- ap(rev($4),$5),DATATYPE);}
+ {$$=gc5(ap(M_TYCON,
+ z4ble($3,checkTyLhs($2),
+ ap(rev($4),$5),
+ DATATYPE)));}
| DATA context IMPLIES tyLhs '=' constrs deriving
- {defTycon(7,$5,$4,
- ap(ap(QUAL,pair($2,rev($6))),
- $7),DATATYPE);}
- | DATA btype2 {defTycon(2,$1,checkTyLhs($2),
- ap(NIL,NIL),DATATYPE);}
- | DATA context IMPLIES tyLhs {defTycon(4,$1,$4,
- ap(ap(QUAL,pair($2,NIL)),
- NIL),DATATYPE);}
+ {$$=gc7(ap(M_TYCON,
+ z4ble($5,$4,
+ ap(qualify($2,rev($6)),$7),
+ DATATYPE)));}
+ | DATA btype2 {$$=gc2(ap(M_TYCON,
+ z4ble($1,checkTyLhs($2),
+ ap(NIL,NIL),DATATYPE)));}
+ | DATA context IMPLIES tyLhs {$$=gc4(ap(M_TYCON,
+ z4ble($1,$4,
+ ap(qualify($2,NIL),NIL),
+ DATATYPE)));}
+ | DATA error {syntaxError("data definition");}
| TNEWTYPE btype2 '=' nconstr deriving
- {defTycon(5,$3,checkTyLhs($2),
- ap($4,$5),NEWTYPE);}
+ {$$=gc5(ap(M_TYCON,
+ z4ble($3,checkTyLhs($2),
+ ap($4,$5),NEWTYPE)));}
| TNEWTYPE context IMPLIES tyLhs '=' nconstr deriving
- {defTycon(7,$5,$4,
- ap(ap(QUAL,pair($2,$6)),
- $7),NEWTYPE);}
- ;
-tyLhs : tyLhs varid1 {$$ = gc2(ap($1,$2));}
- | CONID {$$ = gc1($1);}
- | '[' type ']' {$$ = gc3(ap(conList,$2));}
- | '(' ')' {$$ = gc2(conUnit);}
- | '(' typeTuple ')' {$$ = gc3(buildTuple($2));}
+ {$$=gc7(ap(M_TYCON,
+ z4ble($5,$4,
+ ap(qualify($2,$6),$7),
+ NEWTYPE)));}
+ | TNEWTYPE error {syntaxError("newtype definition");}
+ ;
+tyLhs : tyLhs varid {$$ = gc2(ap($1,$2));}
+ | CONID {$$ = $1;}
| error {syntaxError("type defn lhs");}
;
invars : invars ',' invar {$$ = gc3(cons($3,$1));}
| invar {$$ = gc1(cons($1,NIL));}
;
-invar : qvar COCO topType {$$ = gc3(sigdecl($2,singleton($1),
- $3));}
- | qvar {$$ = gc1($1);}
+invar : var COCO topType {$$ = gc3(sigdecl($2,singleton($1),
+ $3));}
+ | var {$$ = $1;}
;
-constrs : constrs '|' constr {$$ = gc3(cons($3,$1));}
- | constr {$$ = gc1(cons($1,NIL));}
+constrs : constrs '|' pconstr {$$ = gc3(cons($3,$1));}
+ | pconstr {$$ = gc1(cons($1,NIL));}
;
-constr : '!' btype conop bbtype {$$ = gc4(ap2($3,bang($2),$4));}
- | btype1 conop bbtype {$$ = gc3(ap2($2,$1,$3));}
- | btype2 conop bbtype {$$ = gc3(ap2($2,$1,$3));}
- | bpolyType conop bbtype {$$ = gc3(ap2($2,$1,$3));}
- | btype2 {$$ = gc1($1);}
- | btype3 {$$ = gc1($1);}
- | btype4 {$$ = gc1($1);}
+pconstr : ALL varids '.' qconstr {$$ = gc4(ap(POLYTYPE,
+ pair(rev($2),$4)));}
+ | qconstr {$$ = $1;}
+ ;
+qconstr : context IMPLIES constr {$$ = gc3(qualify($1,$3));}
+ | constr {$$ = $1;}
+ ;
+constr : '!' btype conop bbtype {$$ = gc4(ap(ap($3,bang($2)),$4));}
+ | btype1 conop bbtype {$$ = gc3(ap(ap($2,$1),$3));}
+ | btype2 conop bbtype {$$ = gc3(ap(ap($2,$1),$3));}
+ | bpolyType conop bbtype {$$ = gc3(ap(ap($2,$1),$3));}
+ | btype2 {$$ = $1;}
+ | btype3 {$$ = $1;}
+ | btype4 {$$ = $1;}
| con '{' fieldspecs '}' {$$ = gc4(ap(LABC,pair($1,rev($3))));}
- | '[' ']' {$$ = gc2(conNil);}
- | '(' ')' {$$ = gc2(conUnit);}
- | '(' typeTuple ')' {$$ = gc3(buildTuple($2));}
+ | con '{' '}' {$$ = gc3(ap(LABC,pair($1,NIL)));}
| error {syntaxError("data type definition");}
;
btype3 : btype2 '!' atype {$$ = gc3(ap($1,bang($3)));}
| btype4 '!' atype {$$ = gc3(ap($1,bang($3)));}
;
bbtype : '!' btype {$$ = gc2(bang($2));}
- | btype {$$ = gc1($1);}
- | bpolyType {$$ = gc1($1);}
+ | btype {$$ = $1;}
+ | bpolyType {$$ = $1;}
+ ;
+nconstr : pconstr {$$ = gc1(singleton($1));}
;
fieldspecs: fieldspecs ',' fieldspec {$$ = gc3(cons($3,$1));}
| fieldspec {$$ = gc1(cons($1,NIL));}
;
fieldspec : vars COCO polyType {$$ = gc3(pair(rev($1),$3));}
| vars COCO type {$$ = gc3(pair(rev($1),$3));}
- ;
-nconstr : con atype {$$ = gc2(singleton(ap($1,$2)));}
- | con bpolyType {$$ = gc2(singleton(ap($1,$2)));}
+ | vars COCO '!' type {$$ = gc4(pair(rev($1),bang($4)));}
;
deriving : /* empty */ {$$ = gc0(NIL);}
| DERIVING qconid {$$ = gc2(singleton($2));}
/*- Processing definitions of primitives ----------------------------------*/
-topDecl : FOREIGN IMPORT callconv ext_loc ext_name unsafe_flag var COCO type
- {foreignImport($1,pair($4,$5),$7,$9); sp-=9;}
- | FOREIGN EXPORT callconv ext_name qvarid COCO type
- {foreignExport($1,$4,$5,$7); sp-=7;}
+topDecl : FOREIGN IMPORT callconv DYNAMIC unsafe_flag var COCO type
+ {$$=gc8(ap(M_FOREIGN_IM,z5ble($1,$3,NIL,$6,$8)));}
+ | FOREIGN IMPORT callconv ext_loc ext_name unsafe_flag var COCO type
+ {$$=gc9(ap(M_FOREIGN_IM,z5ble($1,$3,pair($4,$5),$7,$9)));}
+ | FOREIGN EXPORT callconv DYNAMIC qvarid COCO type
+ {$$=gc7(ap(M_FOREIGN_EX,z5ble($1,$3,$4,$5,$7)));}
;
-callconv : var {$$ = gc1(NIL); /* ignored */ }
+callconv : CCALL {$$ = gc1(textCcall);}
+ | STDKALL {$$ = gc1(textStdcall);}
+ | /* empty */ {$$ = gc0(NIL);}
;
ext_loc : STRINGLIT {$$ = $1;}
;
/*- Class declarations: ---------------------------------------------------*/
-topDecl : TCLASS crule wherePart {classDefn(intOf($1),$2,$3); sp-=3;}
- | TINSTANCE irule wherePart {instDefn(intOf($1),$2,$3); sp-=3;}
- | DEFAULT '(' dtypes ')' {defaultDefn(intOf($1),$3); sp-=4;}
+topDecl : TCLASS crule fds wherePart {$$=gc4(ap(M_CLASS,z4ble($1,$2,$4,$3)));}
+ | TINSTANCE irule wherePart {$$=gc3(ap(M_INST,ztriple($1,$2,$3)));}
+ | DEFAULT '(' dtypes ')' {$$=gc4(ap(M_DEFAULT,zpair($1,$3)));}
+ | TCLASS error {syntaxError("class declaration");}
+ | TINSTANCE error {syntaxError("instance declaration");}
+ | DEFAULT error {syntaxError("default declaration");}
;
crule : context IMPLIES btype2 {$$ = gc3(pair($1,checkPred($3)));}
| btype2 {$$ = gc1(pair(NIL,checkPred($1)));}
| type {$$ = gc1(cons($1,NIL));}
;
-/*- Type expressions: -----------------------------------------------------*/
-
-sigType : context IMPLIES type {$$ = gc3(ap(QUAL,pair($1,$3)));}
- | type {$$ = gc1($1);}
- ;
-topType : context IMPLIES topType1 {$$ = gc3(ap(QUAL,pair($1,$3)));}
- | topType1 {$$ = gc1($1);}
+fds : /* empty */ {$$ = gc0(NIL);}
+ | '|' fds1 {h98DoesntSupport(row,"dependent parameters");
+ $$ = gc2(rev($2));}
+ ;
+fds1 : fds1 ',' fd {$$ = gc3(cons($3,$1));}
+ | fd {$$ = gc1(cons($1,NIL));}
+ |
+ ;
+fd : varids0 ARROW varids0 {$$ = gc3(pair(rev($1),rev($3)));}
+ ;
+varids0 : /* empty */ {$$ = gc0(NIL);}
+ | varids0 varid {$$ = gc2(cons($2,$1));}
+ ;
+
+ /*- Type expressions: -----------------------------------------------------*/
+
+topType : ALL varids '.' topType0 {$$ = gc4(ap(POLYTYPE,
+ pair(rev($2),$4)));}
+ | topType0 {$$ = $1;}
+ ;
+topType0 : context IMPLIES topType1 {$$ = gc3(qualify($1,$3));}
+ | topType1 {$$ = $1;}
;
topType1 : bpolyType ARROW topType1 {$$ = gc3(fn($1,$3));}
| btype1 ARROW topType1 {$$ = gc3(fn($1,$3));}
| btype2 ARROW topType1 {$$ = gc3(fn($1,$3));}
- | btype {$$ = gc1($1);}
+ | btype {$$ = $1;}
;
-polyType : ALL varid1s '.' sigType {$$ = gc4(ap(POLYTYPE,
+polyType : ALL varids '.' sigType {$$ = gc4(ap(POLYTYPE,
pair(rev($2),$4)));}
- | bpolyType {$$ = gc1($1);}
+ | context IMPLIES type {$$ = gc3(qualify($1,$3));}
+ | bpolyType {$$ = $1;}
;
bpolyType : '(' polyType ')' {$$ = gc3($2);}
;
-varid1s : varid1s ',' varid1 {$$ = gc3(cons($3,$1));}
- | varid1 {$$ = gc1(cons($1,NIL));}
+varids : varids varid {$$ = gc2(cons($2,$1));}
+ | varid {$$ = gc1(singleton($1));}
+ ;
+sigType : context IMPLIES type {$$ = gc3(qualify($1,$3));}
+ | type {$$ = $1;}
;
context : '(' ')' {$$ = gc2(NIL);}
| btype2 {$$ = gc1(singleton(checkPred($1)));}
| '(' btype2 ')' {$$ = gc3(singleton(checkPred($2)));}
- | '(' btypes2 ')' {$$ = gc3(checkContext($2));}
+ | '(' btypes2 ')' {$$ = gc3(checkCtxt(rev($2)));}
/*#if TREX*/
| lacks {$$ = gc1(singleton($1));}
- | '(' lacks1 ')' {$$ = gc3(checkContext($2));}
+ | '(' lacks1 ')' {$$ = gc3(checkCtxt(rev($2)));}
;
-lacks : varid1 '\\' varid1 {
+lacks : varid '\\' varid {
#if TREX
$$ = gc3(ap(mkExt(textOf($3)),$1));
#else
noTREX("a type context");
#endif
}
+ | IPVARID COCO type {
+#if IPARAM
+ $$ = gc3(pair(mkIParam($1),$3));
+#else
+ noIP("a type context");
+#endif
+ }
;
lacks1 : btypes2 ',' lacks {$$ = gc3(cons($3,$1));}
| lacks1 ',' btype2 {$$ = gc3(cons($3,$1));}
;
/*#endif*/
-type : type1 {$$ = gc1($1);}
- | btype2 {$$ = gc1($1);}
+type : type1 {$$ = $1;}
+ | btype2 {$$ = $1;}
;
-type1 : btype1 {$$ = gc1($1);}
+type1 : btype1 {$$ = $1;}
| btype1 ARROW type {$$ = gc3(fn($1,$3));}
| btype2 ARROW type {$$ = gc3(fn($1,$3));}
| error {syntaxError("type expression");}
;
-btype : btype1 {$$ = gc1($1);}
- | btype2 {$$ = gc1($1);}
+btype : btype1 {$$ = $1;}
+ | btype2 {$$ = $1;}
;
btype1 : btype1 atype {$$ = gc2(ap($1,$2));}
- | atype1 {$$ = gc1($1);}
+ | atype1 {$$ = $1;}
;
btype2 : btype2 atype {$$ = gc2(ap($1,$2));}
- | qconid {$$ = gc1($1);}
+ | qconid {$$ = $1;}
;
-atype : atype1 {$$ = gc1($1);}
- | qconid {$$ = gc1($1);}
+atype : atype1 {$$ = $1;}
+ | qconid {$$ = $1;}
;
-atype1 : varid1 {$$ = gc1($1);}
- | '(' ')' {$$ = gc2(conPreludeUnit);}
+atype1 : varid {$$ = $1;}
+ | '(' ')' {$$ = gc2(typeUnit);}
| '(' ARROW ')' {$$ = gc3(typeArrow);}
| '(' type1 ')' {$$ = gc3($2);}
| '(' btype2 ')' {$$ = gc3($2);}
| '(' tupCommas ')' {$$ = gc3($2);}
| '(' btypes2 ')' {$$ = gc3(buildTuple($2));}
| '(' typeTuple ')' {$$ = gc3(buildTuple($2));}
-/*#if TREX*/
| '(' tfields ')' {
#if TREX
$$ = gc3(revOnto($2,typeNoRow));
noTREX("a type");
#endif
}
- | '(' tfields '|' type ')' {$$ = gc5(revOnto($2,$4));}
-/*#endif*/
- | '[' type ']' {$$ = gc3(ap(conPreludeList,$2));}
- | '[' ']' {$$ = gc2(conPreludeList);}
- | '_' {$$ = gc1(inventVar());}
- ;
-tupCommas : tupCommas ',' {$$ = gc2(mkTuple(tupleOf($1)+1));}
- | ',' {$$ = gc1(mkTuple(2));}
+ | '(' tfields '|' type ')' {
+#if TREX
+ $$ = gc5(revOnto($2,$4));
+#else
+ noTREX("a type");
+#endif
+ }
+ | '[' type ']' {$$ = gc3(ap(typeList,$2));}
+ | '[' ']' {$$ = gc2(typeList);}
+ | '_' {h98DoesntSupport(row,"anonymous type variables");
+ $$ = gc1(inventVar());}
;
btypes2 : btypes2 ',' btype2 {$$ = gc3(cons($3,$1));}
| btype2 ',' btype2 {$$ = gc3(cons($3,cons($1,NIL)));}
tfields : tfields ',' tfield {$$ = gc3(cons($3,$1));}
| tfield {$$ = gc1(singleton($1));}
;
-tfield : varid COCO type {$$ = gc3(ap(mkExt(textOf($1)),$3));}
+tfield : varid COCO type {h98DoesntSupport(row,"extensible records");
+ $$ = gc3(ap(mkExt(textOf($1)),$3));}
;
/*#endif*/
/*- Value declarations: ---------------------------------------------------*/
-decllist : '{' decls end {$$ = gc3($2);}
+gendecl : INFIXN optDigit ops {$$ = gc3(fixdecl($1,$3,NON_ASS,$2));}
+ | INFIXN error {syntaxError("fixity decl");}
+ | INFIXL optDigit ops {$$ = gc3(fixdecl($1,$3,LEFT_ASS,$2));}
+ | INFIXL error {syntaxError("fixity decl");}
+ | INFIXR optDigit ops {$$ = gc3(fixdecl($1,$3,RIGHT_ASS,$2));}
+ | INFIXR error {syntaxError("fixity decl");}
+ | vars COCO topType {$$ = gc3(sigdecl($2,$1,$3));}
+ | vars COCO error {syntaxError("type signature");}
+ ;
+optDigit : NUMLIT {$$ = gc1(checkPrec($1));}
+ | /* empty */ {$$ = gc0(mkInt(DEF_PREC));}
+ ;
+ops : ops ',' op {$$ = gc3(cons($3,$1));}
+ | op {$$ = gc1(singleton($1));}
+ ;
+vars : vars ',' var {$$ = gc3(cons($3,$1));}
+ | var {$$ = gc1(singleton($1));}
+ ;
+decls : '{' decls0 end {$$ = gc3($2);}
+ | '{' decls1 end {$$ = gc3($2);}
;
-decls : /* empty */ {$$ = gc0(NIL);}
- | ';' {$$ = gc1(NIL);}
- | decls1 {$$ = gc1($1);}
+decls0 : /* empty */ {$$ = gc0(NIL);}
+ | decls0 ';' {$$ = gc2($1);}
| decls1 ';' {$$ = gc2($1);}
;
-decls1 : decls1 ';' decl {$$ = gc3(cons($3,$1));}
- | decl {$$ = gc1(cons($1,NIL));}
+decls1 : decls0 decl {$$ = gc2(cons($2,$1));}
;
-/* Sneakily using qvars to eliminate a conflict... */
-decl : qvars COCO topType {$$ = gc3(sigdecl($2,$1,$3));}
- | opExp rhs {$$ = gc2(pair($1,$2));}
+decl : gendecl {$$ = $1;}
+ | funlhs rhs {$$ = gc2(ap(FUNBIND,pair($1,$2)));}
+ | funlhs COCO type rhs {$$ = gc4(ap(FUNBIND,
+ pair($1,ap(RSIGN,
+ ap($4,$3)))));}
+ | pat0 rhs {$$ = gc2(ap(PATBIND,pair($1,$2)));}
+ ;
+funlhs : funlhs0 {$$ = $1;}
+ | funlhs1 {$$ = $1;}
+ | npk {$$ = $1;}
+ ;
+funlhs0 : pat10_vI varop pat0 {$$ = gc3(ap2($2,$1,$3));}
+ | infixPat varop pat0 {$$ = gc3(ap2($2,$1,$3));}
+ | NUMLIT varop pat0 {$$ = gc3(ap2($2,$1,$3));}
+ | var varop_pl pat0 {$$ = gc3(ap2($2,$1,$3));}
+ | var '+' pat0_INT {$$ = gc3(ap2(varPlus,$1,$3));}
+ ;
+funlhs1 : '(' funlhs0 ')' apat {$$ = gc4(ap($2,$4));}
+ | '(' funlhs1 ')' apat {$$ = gc4(ap($2,$4));}
+ | '(' npk ')' apat {$$ = gc4(ap($2,$4));}
+ | var apat {$$ = gc2(ap($1,$2));}
+ | funlhs1 apat {$$ = gc2(ap($1,$2));}
;
rhs : rhs1 wherePart {$$ = gc2(letrec($2,$1));}
| error {syntaxError("declaration");}
;
rhs1 : '=' exp {$$ = gc2(pair($1,$2));}
- | gdefs {$$ = gc1(grded(rev($1)));}
- ;
-wherePart : WHERE decllist {$$ = gc2($2);}
- | /*empty*/ {$$ = gc0(NIL);}
+ | gdrhs {$$ = gc1(grded(rev($1)));}
;
-gdefs : gdefs gdef {$$ = gc2(cons($2,$1));}
- | gdef {$$ = gc1(cons($1,NIL));}
+gdrhs : gdrhs gddef {$$ = gc2(cons($2,$1));}
+ | gddef {$$ = gc1(singleton($1));}
;
-gdef : '|' exp '=' exp {$$ = gc4(pair($3,pair($2,$4)));}
+gddef : '|' exp0 '=' exp {$$ = gc4(pair($3,pair($2,$4)));}
;
-vars : vars ',' var {$$ = gc3(cons($3,$1));}
- | var {$$ = gc1(cons($1,NIL));}
- ;
-qvars : qvars ',' qvar {$$ = gc3(cons($3,$1));}
- | qvar {$$ = gc1(cons($1,NIL));}
+wherePart : /* empty */ {$$ = gc0(NIL);}
+ | WHERE decls {$$ = gc2($2);}
;
+/*- Patterns: -------------------------------------------------------------*/
-
-var : varid {$$ = gc1($1);}
- | '(' '-' ')' {$$ = gc3(varMinus);}
+pat : npk {$$ = $1;}
+ | pat_npk {$$ = $1;}
;
-varid : varid1 {$$ = gc1($1);}
- | '(' VAROP ')' {$$ = gc3($2);}
- | '(' '!' ')' {$$ = gc3(varBang);}
- | '(' '.' ')' {$$ = gc3(varDot);}
+pat_npk : pat0 COCO type {$$ = gc3(ap(ESIGN,pair($1,$3)));}
+ | pat0 {$$ = $1;}
;
-varid1 : VARID {$$ = gc1($1);}
- | HIDING {$$ = gc1(varHiding);}
- | QUALIFIED {$$ = gc1(varQualified);}
- | ASMOD {$$ = gc1(varAsMod);}
+npk : var '+' NUMLIT {$$ = gc3(ap2(varPlus,$1,$3));}
;
-qvar : qvarid {$$ = gc1($1);}
- | '(' qvarsym ')' {$$ = gc3($2);}
- | '(' '.' ')' {$$ = gc3(varDot);}
- | '(' '!' ')' {$$ = gc3(varBang);}
- | '(' '-' ')' {$$ = gc3(varMinus);}
+pat0 : var {$$ = $1;}
+ | NUMLIT {$$ = $1;}
+ | pat0_vI {$$ = $1;}
;
-qvarid : varid1 {$$ = gc1($1);}
- | QVARID {$$ = gc1($1);}
+pat0_INT : var {$$ = $1;}
+ | pat0_vI {$$ = $1;}
;
-
-op : varop {$$ = gc1($1);}
- | conop {$$ = gc1($1);}
- | '-' {$$ = gc1(varMinus);}
+pat0_vI : pat10_vI {$$ = $1;}
+ | infixPat {$$ = gc1(ap(INFIX,$1));}
;
-qop : qvarop {$$ = gc1($1);}
- | qconop {$$ = gc1($1);}
- | '-' {$$ = gc1(varMinus);}
+infixPat : '-' pat10 {$$ = gc2(ap(NEG,only($2)));}
+ | '-' error {syntaxError("pattern");}
+ | var qconop pat10 {$$ = gc3(ap(ap($2,only($1)),$3));}
+ | var qconop '-' pat10 {$$ = gc4(ap(NEG,ap2($2,only($1),$4)));}
+ | NUMLIT qconop pat10 {$$ = gc3(ap(ap($2,only($1)),$3));}
+ | NUMLIT qconop '-' pat10 {$$ = gc4(ap(NEG,ap2($2,only($1),$4)));}
+ | pat10_vI qconop pat10 {$$ = gc3(ap(ap($2,only($1)),$3));}
+ | pat10_vI qconop '-' pat10 {$$ = gc4(ap(NEG,ap2($2,only($1),$4)));}
+ | infixPat qconop pat10 {$$ = gc3(ap(ap($2,$1),$3));}
+ | infixPat qconop '-' pat10 {$$ = gc4(ap(NEG,ap(ap($2,$1),$4)));}
;
-
-varop : VAROP {$$ = gc1($1);}
- | '!' {$$ = gc1(varBang);}
- | '.' {$$ = gc1(varDot);}
- | '`' varid1 '`' {$$ = gc3($2);}
+pat10 : fpat {$$ = $1;}
+ | apat {$$ = $1;}
;
-qvarop : qvarsym {$$ = gc1($1);}
- | '!' {$$ = gc1(varBang);}
- | '.' {$$ = gc1(varDot);}
- | '`' qvarid '`' {$$ = gc3($2);}
+pat10_vI : fpat {$$ = $1;}
+ | apat_vI {$$ = $1;}
;
-qvarsym : VAROP {$$ = gc1($1);}
- | QVAROP {$$ = gc1($1);}
+fpat : fpat apat {$$ = gc2(ap($1,$2));}
+ | gcon apat {$$ = gc2(ap($1,$2));}
;
-
-con : CONID {$$ = gc1($1);}
- | '(' CONOP ')' {$$ = gc3($2);}
+apat : NUMLIT {$$ = $1;}
+ | var {$$ = $1;}
+ | apat_vI {$$ = $1;}
;
-qcon : qconid {$$ = gc1($1);}
- | '(' qconsym ')' {$$ = gc3($2);}
+apat_vI : var '@' apat {$$ = gc3(ap(ASPAT,pair($1,$3)));}
+ | gcon {$$ = $1;}
+ | qcon '{' patbinds '}' {$$ = gc4(ap(CONFLDS,pair($1,$3)));}
+ | CHARLIT {$$ = $1;}
+ | STRINGLIT {$$ = $1;}
+ | '_' {$$ = gc1(WILDCARD);}
+ | '(' pat_npk ')' {$$ = gc3($2);}
+ | '(' npk ')' {$$ = gc3($2);}
+ | '(' pats2 ')' {$$ = gc3(buildTuple($2));}
+ | '[' pats1 ']' {$$ = gc3(ap(FINLIST,rev($2)));}
+ | '~' apat {$$ = gc2(ap(LAZYPAT,$2));}
+/*#if TREX*/
+ | '(' patfields ')' {
+#if TREX
+ $$ = gc3(revOnto($2,nameNoRec));
+#else
+ $$ = gc3(NIL);
+#endif
+ }
+ | '(' patfields '|' pat ')' {$$ = gc5(revOnto($2,$4));}
+/*#endif TREX*/
;
-qconid : CONID {$$ = gc1($1);}
- | QCONID {$$ = gc1($1);}
+pats2 : pats2 ',' pat {$$ = gc3(cons($3,$1));}
+ | pat ',' pat {$$ = gc3(cons($3,singleton($1)));}
;
-qconsym : CONOP {$$ = gc1($1);}
- | QCONOP {$$ = gc1($1);}
+pats1 : pats1 ',' pat {$$ = gc3(cons($3,$1));}
+ | pat {$$ = gc1(singleton($1));}
;
-
-conop : CONOP {$$ = gc1($1);}
- | '`' CONID '`' {$$ = gc3($2);}
+patbinds : /* empty */ {$$ = gc0(NIL);}
+ | patbinds1 {$$ = gc1(rev($1));}
+ ;
+patbinds1 : patbinds1 ',' patbind {$$ = gc3(cons($3,$1));}
+ | patbind {$$ = gc1(singleton($1));}
+ ;
+patbind : qvar '=' pat {$$ = gc3(pair($1,$3));}
+ | var {$$ = $1;}
+ ;
+/*#if TREX*/
+patfields : patfields ',' patfield {$$ = gc3(cons($3,$1));}
+ | patfield {$$ = gc1(singleton($1));}
;
-qconop : qconsym {$$ = gc1($1);}
- | '`' qconid '`' {$$ = gc3($2);}
+patfield : varid '=' pat {
+#if TREX
+ $$ = gc3(ap(mkExt(textOf($1)),$3));
+#else
+ noTREX("a pattern");
+#endif
+ }
;
+/*#endif TREX*/
/*- Expressions: ----------------------------------------------------------*/
-exp : exp1 {$$ = gc1($1);}
+exp : exp_err {$$ = $1;}
| error {syntaxError("expression");}
;
-exp1 : opExp COCO sigType {$$ = gc3(ap(ESIGN,pair($1,$3)));}
- | opExp {$$ = gc1($1);}
+exp_err : exp0a COCO sigType {$$ = gc3(ap(ESIGN,pair($1,$3)));}
+ | exp0a WITH dbinds {
+#if IPARAM
+ $$ = gc3(ap(WITHEXP,pair($1,$3)));
+#else
+ noIP("an expression");
+#endif
+ }
+ | exp0 {$$ = $1;}
+ ;
+exp0 : exp0a {$$ = $1;}
+ | exp0b {$$ = $1;}
;
-opExp : opExp0 {$$ = gc1(tidyInfix($1));}
- | pfxExp {$$ = gc1($1);}
+exp0a : infixExpa {$$ = gc1(ap(INFIX,$1));}
+ | exp10a {$$ = $1;}
;
-opExp0 : opExp0 qop '-' pfxExp {$$ = gc4(ap(NEG,ap(ap($2,$1),$4)));}
- | opExp0 qop pfxExp {$$ = gc3(ap2($2,$1,$3));}
- | '-' pfxExp {$$ = gc2(ap(NEG,only($2)));}
- | pfxExp qop pfxExp {$$ = gc3(ap(ap($2,only($1)),$3));}
- | pfxExp qop '-' pfxExp {$$ = gc4(ap(NEG,
+exp0b : infixExpb {$$ = gc1(ap(INFIX,$1));}
+ | exp10b {$$ = $1;}
+ ;
+infixExpa : infixExpa qop '-' exp10a {$$ = gc4(ap(NEG,ap(ap($2,$1),$4)));}
+ | infixExpa qop exp10a {$$ = gc3(ap(ap($2,$1),$3));}
+ | '-' exp10a {$$ = gc2(ap(NEG,only($2)));}
+ | exp10a qop '-' exp10a {$$ = gc4(ap(NEG,
+ ap(ap($2,only($1)),$4)));}
+ | exp10a qop exp10a {$$ = gc3(ap(ap($2,only($1)),$3));}
+ ;
+infixExpb : infixExpa qop '-' exp10b {$$ = gc4(ap(NEG,ap(ap($2,$1),$4)));}
+ | infixExpa qop exp10b {$$ = gc3(ap(ap($2,$1),$3));}
+ | '-' exp10b {$$ = gc2(ap(NEG,only($2)));}
+ | exp10a qop '-' exp10b {$$ = gc4(ap(NEG,
ap(ap($2,only($1)),$4)));}
+ | exp10a qop exp10b {$$ = gc3(ap(ap($2,only($1)),$3));}
+ ;
+exp10a : CASEXP exp OF '{' alts end {$$ = gc6(ap(CASE,pair($2,rev($5))));}
+ | DO '{' stmts end {$$ = gc4(ap(DOCOMP,checkDo($3)));}
+ | MDO '{' stmts end {$$ = gc4(ap(DOCOMP,checkDo($3)));}
+ | appExp {$$ = $1;}
;
-pfxExp : '\\' pats ARROW exp {$$ = gc4(ap(LAMBDA,
+exp10b : '\\' pats ARROW exp {$$ = gc4(ap(LAMBDA,
pair(rev($2),
pair($3,$4))));}
- | LET decllist IN exp {$$ = gc4(letrec($2,$4));}
+ | LET decls IN exp {$$ = gc4(letrec($2,$4));}
| IF exp THEN exp ELSE exp {$$ = gc6(ap(COND,triple($2,$4,$6)));}
- | CASEXP exp OF '{' alts end {$$ = gc6(ap(CASE,pair($2,rev($5))));}
- | DO '{' stmts end {$$ = gc4(ap(DOCOMP,checkDo($3)));}
- | appExp {$$ = gc1($1);}
+ | DLET dbinds IN exp {
+#if IPARAM
+ $$ = gc4(ap(WITHEXP,pair($4,$2)));
+#else
+ noIP("an expression");
+#endif
+ }
;
-pats : pats atomic {$$ = gc2(cons($2,$1));}
- | atomic {$$ = gc1(cons($1,NIL));}
+pats : pats apat {$$ = gc2(cons($2,$1));}
+ | apat {$$ = gc1(cons($1,NIL));}
;
-appExp : appExp atomic {$$ = gc2(ap($1,$2));}
- | atomic {$$ = gc1($1);}
+appExp : appExp aexp {$$ = gc2(ap($1,$2));}
+ | aexp {$$ = $1;}
;
-atomic : qvar {$$ = gc1($1);}
- | qvar '@' atomic {$$ = gc3(ap(ASPAT,pair($1,$3)));}
- | '~' atomic {$$ = gc2(ap(LAZYPAT,$2));}
+aexp : qvar {$$ = $1;}
+ | qvar '@' aexp {$$ = gc3(ap(ASPAT,pair($1,$3)));}
+ | '~' aexp {$$ = gc2(ap(LAZYPAT,$2));}
+ | IPVARID {$$ = $1;}
| '_' {$$ = gc1(WILDCARD);}
- | qcon {$$ = gc1($1);}
+ | gcon {$$ = $1;}
| qcon '{' fbinds '}' {$$ = gc4(ap(CONFLDS,pair($1,$3)));}
- | atomic '{' fbinds '}' {$$ = gc4(ap(UPDFLDS,
+ | aexp '{' fbinds '}' {$$ = gc4(ap(UPDFLDS,
triple($1,NIL,$3)));}
- | '(' ')' {$$ = gc2(conPreludeUnit);}
- | NUMLIT {$$ = gc1($1);}
- | CHARLIT {$$ = gc1($1);}
- | STRINGLIT {$$ = gc1($1);}
- | REPEAT {$$ = gc1($1);}
+ | NUMLIT {$$ = $1;}
+ | CHARLIT {$$ = $1;}
+ | STRINGLIT {$$ = $1;}
+ | REPEAT {$$ = $1;}
| '(' exp ')' {$$ = gc3($2);}
| '(' exps2 ')' {$$ = gc3(buildTuple($2));}
/*#if TREX*/
#endif
}
| '(' vfields '|' exp ')' {$$ = gc5(revOnto($2,$4));}
- | RECSELID {$$ = gc1($1);}
+ | RECSELID {$$ = $1;}
/*#endif*/
| '[' list ']' {$$ = gc3($2);}
- | '(' pfxExp qop ')' {$$ = gc4(ap($3,$2));}
- | '(' qvarop atomic ')' {$$ = gc4(ap2(varFlip,$2,$3));}
- | '(' qconop atomic ')' {$$ = gc4(ap2(varFlip,$2,$3));}
- | '(' tupCommas ')' {$$ = gc3($2);}
+ | '(' exp10a qop ')' {$$ = gc4(ap($3,$2));}
+ | '(' qvarop_mi exp0 ')' {$$ = gc4(ap(ap(nameFlip,$2),$3));}
+ | '(' qconop exp0 ')' {$$ = gc4(ap(ap(nameFlip,$2),$3));}
;
exps2 : exps2 ',' exp {$$ = gc3(cons($3,$1));}
| exp ',' exp {$$ = gc3(cons($3,cons($1,NIL)));}
vfields : vfields ',' vfield {$$ = gc3(cons($3,$1));}
| vfield {$$ = gc1(singleton($1));}
;
-vfield : qvarid '=' exp {
+vfield : varid '=' exp {
#if TREX
$$ = gc3(ap(mkExt(textOf($1)),$3));
#else
}
;
/*#endif*/
-alts : alts1 {$$ = gc1($1);}
+alts : alts1 {$$ = $1;}
| alts1 ';' {$$ = gc2($1);}
;
alts1 : alts1 ';' alt {$$ = gc3(cons($3,$1));}
| alt {$$ = gc1(cons($1,NIL));}
;
-alt : opExp altRhs wherePart {$$ = gc3(pair($1,letrec($3,$2)));}
+alt : pat altRhs wherePart {$$ = gc3(pair($1,letrec($3,$2)));}
;
altRhs : guardAlts {$$ = gc1(grded(rev($1)));}
| ARROW exp {$$ = gc2(pair($1,$2));}
guardAlts : guardAlts guardAlt {$$ = gc2(cons($2,$1));}
| guardAlt {$$ = gc1(cons($1,NIL));}
;
-guardAlt : '|' opExp ARROW exp {$$ = gc4(pair($3,pair($2,$4)));}
+guardAlt : '|' exp0 ARROW exp {$$ = gc4(pair($3,pair($2,$4)));}
;
stmts : stmts1 ';' {$$ = gc2($1);}
- | stmts1 {$$ = gc1($1);}
+ | stmts1 {$$ = $1;}
;
stmts1 : stmts1 ';' stmt {$$ = gc3(cons($3,$1));}
| stmt {$$ = gc1(cons($1,NIL));}
;
-stmt : exp1 FROM exp {$$ = gc3(ap(FROMQUAL,pair($1,$3)));}
- | LET decllist {$$ = gc2(ap(QWHERE,$2));}
- | IF exp {$$ = gc2(ap(BOOLQUAL,$2));}
- | exp1 {$$ = gc1(ap(DOQUAL,$1));}
+stmt : exp_err FROM exp {$$ = gc3(ap(FROMQUAL,pair($1,$3)));}
+ | LET decls {$$ = gc2(ap(QWHERE,$2));}
+/* | IF exp {$$ = gc2(ap(BOOLQUAL,$2));}*/
+ | exp_err {$$ = gc1(ap(DOQUAL,$1));}
;
fbinds : /* empty */ {$$ = gc0(NIL);}
| fbinds1 {$$ = gc1(rev($1));}
fbinds1 : fbinds1 ',' fbind {$$ = gc3(cons($3,$1));}
| fbind {$$ = gc1(singleton($1));}
;
-fbind : var {$$ = gc1($1);}
+fbind : var {$$ = $1;}
| qvar '=' exp {$$ = gc3(pair($1,$3));}
;
+dbinds : '{' dbs0 end {$$ = gc3($2);}
+ | '{' dbs1 end {$$ = gc3($2);}
+ ;
+dbs0 : /* empty */ {$$ = gc0(NIL);}
+ | dbs0 ';' {$$ = gc2($1);}
+ | dbs1 ';' {$$ = gc2($1);}
+ ;
+dbs1 : dbs0 dbind {$$ = gc2(cons($2,$1));}
+ ;
+dbind : IPVARID '=' exp {$$ = gc3(pair($1,$3));}
+ ;
+
/*- List Expressions: -------------------------------------------------------*/
-list : /* empty */ {$$ = gc0(conPreludeNil);}
- | exp {$$ = gc1(ap(FINLIST,cons($1,NIL)));}
+list : exp {$$ = gc1(ap(FINLIST,cons($1,NIL)));}
| exps2 {$$ = gc1(ap(FINLIST,rev($1)));}
| exp '|' quals {$$ = gc3(ap(COMP,pair($1,rev($3))));}
- | exp UPTO exp {$$ = gc3(ap2(varEnumFromTo,$1,$3));}
- | exp ',' exp UPTO {$$ = gc4(ap2(varEnumFromThen,$1,$3));}
- | exp UPTO {$$ = gc2(ap1(varEnumFrom,$1));}
- | exp ',' exp UPTO exp {$$ = gc5(ap3(varEnumFromThenTo,
- $1,$3,$5));}
+ | exp UPTO exp {$$ = gc3(ap(ap(nameFromTo,$1),$3));}
+ | exp ',' exp UPTO {$$ = gc4(ap(ap(nameFromThen,$1),$3));}
+ | exp UPTO {$$ = gc2(ap(nameFrom,$1));}
+ | exp ',' exp UPTO exp {$$ = gc5(ap(ap(ap(nameFromThenTo,
+ $1),$3),$5));}
;
quals : quals ',' qual {$$ = gc3(cons($3,$1));}
| qual {$$ = gc1(cons($1,NIL));}
;
qual : exp FROM exp {$$ = gc3(ap(FROMQUAL,pair($1,$3)));}
| exp {$$ = gc1(ap(BOOLQUAL,$1));}
- | LET decllist {$$ = gc2(ap(QWHERE,$2));}
+ | LET decls {$$ = gc2(ap(QWHERE,$2));}
+ ;
+
+/*- Identifiers and symbols: ----------------------------------------------*/
+
+gcon : qcon {$$ = $1;}
+ | '(' ')' {$$ = gc2(nameUnit);}
+ | '[' ']' {$$ = gc2(nameNil);}
+ | '(' tupCommas ')' {$$ = gc3($2);}
+ ;
+tupCommas : tupCommas ',' {$$ = gc2(mkTuple(tupleOf($1)+1));}
+ | ',' {$$ = gc1(mkTuple(2));}
+ ;
+varid : VARID {$$ = $1;}
+ | HIDING {$$ = gc1(varHiding);}
+ | QUALIFIED {$$ = gc1(varQualified);}
+ | ASMOD {$$ = gc1(varAsMod);}
+ ;
+qconid : QCONID {$$ = $1;}
+ | CONID {$$ = $1;}
+ ;
+var : varid {$$ = $1;}
+ | '(' VAROP ')' {$$ = gc3($2);}
+ | '(' '+' ')' {$$ = gc3(varPlus);}
+ | '(' '-' ')' {$$ = gc3(varMinus);}
+ | '(' '!' ')' {$$ = gc3(varBang);}
+ | '(' '.' ')' {$$ = gc3(varDot);}
+ ;
+qvar : QVARID {$$ = $1;}
+ | '(' QVAROP ')' {$$ = gc3($2);}
+ | var {$$ = $1;}
+ ;
+con : CONID {$$ = $1;}
+ | '(' CONOP ')' {$$ = gc3($2);}
+ ;
+qcon : QCONID {$$ = $1;}
+ | '(' QCONOP ')' {$$ = gc3($2);}
+ | con {$$ = $1;}
+ ;
+varop : '+' {$$ = gc1(varPlus);}
+ | '-' {$$ = gc1(varMinus);}
+ | varop_mipl {$$ = $1;}
+ ;
+varop_mi : '+' {$$ = gc1(varPlus);}
+ | varop_mipl {$$ = $1;}
+ ;
+varop_pl : '-' {$$ = gc1(varMinus);}
+ | varop_mipl {$$ = $1;}
+ ;
+varop_mipl: VAROP {$$ = $1;}
+ | '`' varid '`' {$$ = gc3($2);}
+ | '!' {$$ = gc1(varBang);}
+ | '.' {$$ = gc1(varDot);}
+ ;
+qvarop : '-' {$$ = gc1(varMinus);}
+ | qvarop_mi {$$ = $1;}
+ ;
+qvarop_mi : QVAROP {$$ = $1;}
+ | '`' QVARID '`' {$$ = gc3($2);}
+ | varop_mi {$$ = $1;}
+ ;
+
+conop : CONOP {$$ = $1;}
+ | '`' CONID '`' {$$ = gc3($2);}
+ ;
+qconop : QCONOP {$$ = $1;}
+ | '`' QCONID '`' {$$ = gc3($2);}
+ | conop {$$ = $1;}
+ ;
+op : varop {$$ = $1;}
+ | conop {$$ = $1;}
+ ;
+qop : qvarop {$$ = $1;}
+ | qconop {$$ = $1;}
+ ;
+
+/*- Stuff from STG hugs ---------------------------------------------------*/
+
+qvarid : varid1 {$$ = gc1($1);}
+ | QVARID {$$ = gc1($1);}
+
+varid1 : VARID {$$ = gc1($1);}
+ | HIDING {$$ = gc1(varHiding);}
+ | QUALIFIED {$$ = gc1(varQualified);}
+ | ASMOD {$$ = gc1(varAsMod);}
;
/*- Tricks to force insertion of leading and closing braces ---------------*/
-begin : error {yyerrok; goOffside(startColumn);}
+begin : error {yyerrok;
+ if (offsideON) goOffside(startColumn);}
;
- /* deal with trailing semicolon */
-end : '}' {$$ = gc1($1);}
+
+end : '}' {$$ = $1;}
| error {yyerrok;
- if (canUnOffside()) {
+ if (offsideON && canUnOffside()) {
unOffside();
/* insert extra token on stack*/
push(NIL);
* x1 | ... | xn | la ===> e | la
* top() top()
*
- * Othwerwise, the transformation is:
+ * Otherwise, the transformation is:
* pushed: n-1 0 0
* x1 | ... | xn ===> e
* top() top()
return e;
}
-static Void local syntaxError(s) /* report on syntax error */
+static Void local syntaxError(s) /* report on syntax error */
String s; {
ERRMSG(row) "Syntax error in %s (unexpected %s)", s, unexpected()
EEND;
#define keyword(kw) sprintf(buffer,fmt,kwd,kw); return buffer;
case INFIXL : keyword("infixl");
case INFIXR : keyword("infixr");
- case INFIX : keyword("infix");
+ case INFIXN : keyword("infix");
case FOREIGN : keyword("foreign");
case UNSAFE : keyword("unsafe");
case TINSTANCE : keyword("instance");
case DERIVING : keyword("deriving");
case DEFAULT : keyword("default");
case IMPORT : keyword("import");
- case EXPORT : keyword("export");
- case MODULETOK : keyword("module");
- case INTERFACE : keyword("interface");
- case WILDCARD : keyword("_");
- case ALL : keyword("forall");
+ case TMODULE : keyword("module");
+ /* AJG: Hugs98/Classic use the keyword forall
+ rather than __forall.
+ Agree on one or the other
+ */
+ case ALL : keyword("__forall");
+#if IPARAM
+ case DLET : keyword("dlet");
+ case WITH : keyword("with");
+#endif
#undef keyword
case ARROW : return "`->'";
case '@' : return "`@'";
case '(' : return "`('";
case ')' : return "`)'";
- case '{' : return "`{'";
- case '}' : return "`}'";
+ case '{' : return "`{', possibly due to bad layout";
+ case '}' : return "`}', possibly due to bad layout";
case '_' : return "`_'";
case '|' : return "`|'";
case '.' : return "`.'";
- case ';' : return "`;'";
+ case ';' : return "`;', possibly due to bad layout";
case UPTO : return "`..'";
case '[' : return "`['";
case ']' : return "`]'";
textToStr(extText(snd(yylval))));
return buffer;
#endif
+#if IPARAM
+ case IPVARID : sprintf(buffer,"implicit parameter \"?%s\"",
+ textToStr(textOf(yylval)));
+ return buffer;
+#endif
case VAROP :
case VARID :
case CONOP :
}
}
-static Cell local checkPrec(p) /* Check for valid precedence value */
+static Cell local checkPrec(p) /* Check for valid precedence value*/
Cell p; {
- if ((!isInt(p) || intOf(p)<MIN_PREC || intOf(p)>MAX_PREC)
- && (!isBignum(p) || bignumOf(p)<MIN_PREC || bignumOf(p)>MAX_PREC)
- ) {
+ if (!isInt(p) || intOf(p)<MIN_PREC || intOf(p)>MAX_PREC) {
ERRMSG(row) "Precedence value must be an integer in the range [%d..%d]",
MIN_PREC, MAX_PREC
EEND;
}
- if (isBignum(p)) {
- return mkInt(bignumOf(p));
- } else {
- return p;
- }
+ return p;
}
-static Void local fixDefn(a,line,p,ops)/* Declare syntax of operators */
-Syntax a;
-Cell line;
-Cell p;
-List ops; {
- Int l = intOf(line);
- a = mkSyntax(a,intOf(p));
- map2Proc(setSyntax,l,a,ops);
-}
-
-static Void local setSyntax(line,sy,op)/* set syntax of individ. operator */
-Int line;
-Syntax sy;
-Cell op; {
- addSyntax(line,textOf(op),sy);
- opDefns = cons(op,opDefns);
-}
-
-static Cell local buildTuple(tup) /* build tuple (x1,...,xn) from list*/
-List tup; { /* [xn,...,x1] */
+static Cell local buildTuple(tup) /* build tuple (x1,...,xn) from */
+List tup; { /* list [xn,...,x1] */
Int n = 0;
Cell t = tup;
Cell x;
- do { /* . . */
- x = fst(t); /* / \ / \ */
- fst(t) = snd(t); /* xn . . xn */
- snd(t) = x; /* . ===> . */
- x = t; /* . . */
- t = fun(x); /* . . */
- n++; /* / \ / \ */
- } while (nonNull(t)); /* x1 NIL (n) x1 */
+ do { /* . . */
+ x = fst(t); /* / \ / \ */
+ fst(t) = snd(t); /* xn . . xn */
+ snd(t) = x; /* . ===> . */
+ x = t; /* . . */
+ t = fun(x); /* . . */
+ n++; /* / \ / \ */
+ } while (nonNull(t)); /* x1 NIL (n) x1 */
fst(x) = mkTuple(n);
return tup;
}
-static List local checkContext(con) /* validate context */
+static List local checkCtxt(con) /* validate context */
Type con; {
mapOver(checkPred, con);
return con;
if (isExt(cn) && argCount==1)
return c;
#endif
- if (!isQCon(cn) || argCount==0)
+#if IPARAM
+ if (isIP(cn))
+ return c;
+#endif
+ if (!isQCon(cn) /*|| argCount==0*/)
syntaxError("class expression");
return c;
}
return dqs;
}
-static Cell local checkTyLhs(c) /* check that lhs is of the form */
-Cell c; { /* T a1 ... a */
+static Cell local checkTyLhs(c) /* check that lhs is of the form */
+Cell c; { /* T a1 ... a */
Cell tlhs = c;
- while (isAp(tlhs) && whatIs(arg(tlhs))==VARIDCELL)
- tlhs = fun(tlhs);
- switch (whatIs(tlhs)) {
- case CONIDCELL : return c;
-
- default :
- ERRMSG(row) "Illegal left hand side in datatype definition"
- EEND;
+ while (isAp(tlhs) && whatIs(arg(tlhs))==VARIDCELL) {
+ tlhs = fun(tlhs);
}
+ if (whatIs(tlhs)!=CONIDCELL) {
+ ERRMSG(row) "Illegal left hand side in datatype definition"
+ EEND;
+ }
+ return c;
}
+
#if !TREX
static Void local noTREX(where)
String where; {
- ERRMSG(row) "Attempt to use Typed Records with Extensions\nwhile parsing %s. This feature is disabled in this build of Hugs.",
- where
+ ERRMSG(row) "Attempt to use TREX records while parsing %s.\n", where ETHEN
+ ERRTEXT "(TREX is disabled in this build of Hugs)"
EEND;
}
#endif
-
-/* Expressions involving infix operators or unary minus are parsed as elements
- * of the following type:
- *
- * data OpExp = Only Exp | Neg OpExp | Infix OpExp Op Exp
- *
- * (The algorithms here do not assume that negation can be applied only once,
- * i.e., that - - x is a syntax error, as required by the Haskell report.
- * Instead, that restriction is captured by the grammar itself, given above.)
- *
- * There are rules of precedence and grouping, expressed by two functions:
- *
- * prec :: Op -> Int; assoc :: Op -> Assoc (Assoc = {L, N, R})
- *
- * OpExp values are rearranged accordingly when a complete expression has
- * been read using a simple shift-reduce parser whose result may be taken
- * to be a value of the following type:
- *
- * data Exp = Atom Int | Negate Exp | Apply Op Exp Exp | Error String
- *
- * The machine on which this parser is based can be defined as follows:
- *
- * tidy :: OpExp -> [(Op,Exp)] -> Exp
- * tidy (Only a) [] = a
- * tidy (Only a) ((o,b):ss) = tidy (Only (Apply o a b)) ss
- * tidy (Infix a o b) [] = tidy a [(o,b)]
- * tidy (Infix a o b) ((p,c):ss)
- * | shift o p = tidy a ((o,b):(p,c):ss)
- * | red o p = tidy (Infix a o (Apply p b c)) ss
- * | ambig o p = Error "ambiguous use of operators"
- * tidy (Neg e) [] = tidy (tidyNeg e) []
- * tidy (Neg e) ((o,b):ss)
- * | nshift o = tidy (Neg (underNeg o b e)) ss
- * | nred o = tidy (tidyNeg e) ((o,b):ss)
- * | nambig o = Error "illegal use of negation"
- *
- * At each stage, the parser can either shift, reduce, accept, or error.
- * The transitions when dealing with juxtaposed operators o and p are
- * determined by the following rules:
- *
- * shift o p = (prec o > prec p)
- * || (prec o == prec p && assoc o == L && assoc p == L)
- *
- * red o p = (prec o < prec p)
- * || (prec o == prec p && assoc o == R && assoc p == R)
- *
- * ambig o p = (prec o == prec p)
- * && (assoc o == N || assoc p == N || assoc o /= assoc p)
- *
- * The transitions when dealing with juxtaposed unary minus and infix operators
- * are as follows. The precedence of unary minus (infixl 6) is hardwired in
- * to these definitions, as it is to the definitions of the Haskell grammar
- * in the official report.
- *
- * nshift o = (prec o > 6)
- * nred o = (prec o < 6) || (prec o == 6 && assoc o == L)
- * nambig o = prec o == 6 && (assoc o == R || assoc o == N)
- *
- * An OpExp of the form (Neg e) means negate the last thing in the OpExp e;
- * we can force this negation using:
- *
- * tidyNeg :: OpExp -> OpExp
- * tidyNeg (Only e) = Only (Negate e)
- * tidyNeg (Infix a o b) = Infix a o (Negate b)
- * tidyNeg (Neg e) = tidyNeg (tidyNeg e)
- *
- * On the other hand, if we want to sneak application of an infix operator
- * under a negation, then we use:
- *
- * underNeg :: Op -> Exp -> OpExp -> OpExp
- * underNeg o b (Only e) = Only (Apply o e b)
- * underNeg o b (Neg e) = Neg (underNeg o b e)
- * underNeg o b (Infix e p f) = Infix e p (Apply o f b)
- *
- * As a concession to efficiency, we lower the number of calls to syntaxOf
- * by keeping track of the values of sye, sys throughout the process. The
- * value APPLIC is used to indicate that the syntax value is unknown.
- */
-
-#define UMINUS_PREC 6 /* Change these settings at your */
-#define UMINUS_ASSOC LEFT_ASS /* own risk; they may not work! */
-
-static Cell local tidyInfix(e) /* convert OpExp to Expr */
-Cell e; { /* :: OpExp */
- Cell s = NIL; /* :: [(Op,Exp)] */
- Syntax sye = APPLIC; /* Syntax of op in e (init unknown)*/
- Syntax sys = APPLIC; /* Syntax of op in s (init unknown)*/
-
- for (;;)
- switch (whatIs(e)) {
- case ONLY : e = snd(e);
- while (nonNull(s)) {
- Cell next = arg(fun(s));
- arg(fun(s)) = e;
- e = s;
- s = next;
- }
- return e;
-
- case NEG : if (nonNull(s)) {
-
- if (sys==APPLIC) { /* calculate sys */
- sys = identSyntax(fun(fun(s)));
- if (sys==APPLIC) sys=DEF_OPSYNTAX;
- }
-
- if (precOf(sys)==UMINUS_PREC && /* nambig */
- assocOf(sys)!=UMINUS_ASSOC) {
- ERRMSG(row)
- "Ambiguous use of unary minus with \"%s\"",
- textToStr(textOf(fun(fun(s))))
- EEND;
- }
-
- if (precOf(sys)>UMINUS_PREC) { /* nshift */
- Cell e1 = snd(e);
- Cell t = s;
- s = arg(fun(s));
- while (whatIs(e1)==NEG)
- e1 = snd(e1);
- arg(fun(t)) = arg(e1);
- arg(e1) = t;
- sys = APPLIC;
- continue;
- }
-
- }
-
- /* Intentional fall-thru for nreduce and isNull(s) */
- { Cell prev = e; /* e := tidyNeg e */
- Cell temp = arg(prev);
- Int nneg = 1;
- for (; whatIs(temp)==NEG; nneg++) {
- fun(prev) = varNegate;
- prev = temp;
- temp = arg(prev);
- }
- /* These special cases are required for
- * pattern matching.
- */
- if (isInt(arg(temp))) { /* special cases */
- if (nneg&1) /* for literals */
- arg(temp) = intNegate(arg(temp));
- }
- else if (isBignum(arg(temp))) {
- if (nneg&1)
- arg(temp) = bignumNegate(arg(temp));
- }
- else if (isFloat(arg(temp))) {
- if (nneg&1)
- arg(temp) = floatNegate(arg(temp));
- }
- else {
- fun(prev) = varNegate;
- arg(prev) = arg(temp);
- arg(temp) = e;
- }
- e = temp;
- }
- continue;
-
- default : if (isNull(s)) {/* Move operation onto empty stack */
- Cell next = arg(fun(e));
- s = e;
- arg(fun(s)) = NIL;
- e = next;
- sys = sye;
- sye = APPLIC;
- }
- else { /* deal with pair of operators */
-
- if (sye==APPLIC) { /* calculate sys and sye */
- sye = identSyntax(fun(fun(e)));
- if (sye==APPLIC) sye=DEF_OPSYNTAX;
- }
- if (sys==APPLIC) {
- sys = identSyntax(fun(fun(s)));
- if (sys==APPLIC) sys=DEF_OPSYNTAX;
- }
-
- if (precOf(sye)==precOf(sys) && /* ambig */
- (assocOf(sye)!=assocOf(sys) ||
- assocOf(sye)==NON_ASS)) {
- ERRMSG(row)
- "Ambiguous use of operator \"%s\" with \"%s\"",
- textToStr(textOf(fun(fun(e)))),
- textToStr(textOf(fun(fun(s))))
- EEND;
- }
-
- if (precOf(sye)>precOf(sys) || /* shift */
- (precOf(sye)==precOf(sys) &&
- assocOf(sye)==LEFT_ASS &&
- assocOf(sys)==LEFT_ASS)) {
- Cell next = arg(fun(e));
- arg(fun(e)) = s;
- s = e;
- e = next;
- sys = sye;
- sye = APPLIC;
- }
- else { /* reduce */
- Cell next = arg(fun(s));
- arg(fun(s)) = arg(e);
- arg(e) = s;
- s = next;
- sys = APPLIC;
- /* sye unchanged */
- }
- }
- continue;
- }
+#if !IPARAM
+static Void local noIP(where)
+String where; {
+ ERRMSG(row) "Attempt to use Implicit Parameters while parsing %s.\n", where ETHEN
+ ERRTEXT "(Implicit Parameters are disabled in this build of Hugs)"
+ EEND;
}
+#endif
/*-------------------------------------------------------------------------*/
projects / ghc-hetmet.git / blobdiff