* included in the distribution.
*
* $RCSfile: parser.y,v $
- * $Revision: 1.15 $
- * $Date: 1999/11/29 18:53:14 $
+ * $Revision: 1.21 $
+ * $Date: 2000/01/05 18:05:34 $
* ------------------------------------------------------------------------*/
%{
#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 qualify(ps,t) (nonNull(ps) ? ap(QUAL,pair(ps,t)) : t)
%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 interface files -----------------------------*/
-iface : INTERFACE ifName NUMLIT checkVersion WHERE ifDecls
- {$$ = gc6(NIL); }
+iface : INTERFACE ifCon NUMLIT ifOrphans ifCheckVersion WHERE ifTopDecls
+ {$$ = gc7(ap(I_INTERFACE,
+ zpair($2,$7))); }
| INTERFACE error {syntaxError("interface file");}
;
-ifDecls: {$$=gc0(NIL);}
- | ifDecl ';' ifDecls {$$=gc3(cons($1,$3));}
- ;
-varid_or_conid
- : VARID { $$=gc1($1); }
- | CONID { $$=gc1($1); }
- ;
-opt_bang : '!' {$$=gc1(NIL);}
- | {$$=gc0(NIL);}
- ;
-ifName : CONID {openGHCIface(textOf($1));
- $$ = gc1(NIL);}
-checkVersion
- : NUMLIT {$$ = gc1(NIL); }
+
+ifTopDecls: {$$=gc0(NIL);}
+ | ifTopDecl ';' ifTopDecls {$$=gc3(cons($1,$3));}
;
-ifDecl
- : IMPORT CONID NUMLIT opt_bang COCO version_list_junk
- { addGHCImports(intOf($3),textOf($2),
- $6);
- $$ = gc6(NIL);
- }
- | INSTIMPORT CONID {$$=gc2(NIL);}
-
- | UUEXPORT CONID ifEntities { addGHCExports($2,$3);
- $$=gc3(NIL);}
-
- | NUMLIT INFIXL optDigit varid_or_conid
- {$$ = gc4(fixdecl($2,singleton($4),
- LEFT_ASS,$3)); }
- | NUMLIT INFIXR optDigit varid_or_conid
- {$$ = gc4(fixdecl($2,singleton($4),
- RIGHT_ASS,$3)); }
- | NUMLIT INFIXN optDigit varid_or_conid
- {$$ = gc4(fixdecl($2,singleton($4),
- NON_ASS,$3)); }
-
- | TINSTANCE ifCtxInst ifInstHd '=' ifVar
- { addGHCInstance(intOf($1),$2,$3,
- textOf($5));
- $$ = gc5(NIL); }
+ifTopDecl
+ : IMPORT CONID NUMLIT ifOrphans ifOptCOCO ifVersionList
+ {$$=gc6(ap(I_IMPORT,zpair($2,$6))); }
+
+ | INSTIMPORT CONID {$$=gc2(ap(I_INSTIMPORT,NIL));}
+
+ | UUEXPORT CONID ifEntities {$$=gc3(ap(I_EXPORT,zpair($2,$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)));}
+
+ | TINSTANCE ifCtxInst ifInstHdL '=' ifVar
+ {$$=gc5(ap(I_INSTANCE,
+ z5ble($1,$2,$3,$5,NIL)));}
+
| NUMLIT TYPE ifCon ifKindedTyvarL '=' ifType
- { addGHCSynonym(intOf($2),$3,$4,$6);
- $$ = gc6(NIL); }
+ {$$=gc6(ap(I_TYPE,
+ z4ble($2,$3,$4,$6)));}
| NUMLIT DATA ifCtxDecl ifConData ifKindedTyvarL ifConstrs
- { addGHCDataDecl(intOf($2),
- $3,$4,$5,$6);
- $$ = gc6(NIL); }
+ {$$=gc6(ap(I_DATA,
+ z5ble($2,$3,$4,$5,$6)));}
| NUMLIT TNEWTYPE ifCtxDecl ifConData ifKindedTyvarL ifNewTypeConstr
- { addGHCNewType(intOf($2),
- $3,$4,$5,$6);
- $$ = gc6(NIL); }
- | NUMLIT TCLASS ifCtxDecl ifCon ifTyvar ifCmeths
- { addGHCClass(intOf($2),$3,$4,$5,$6);
- $$ = gc6(NIL); }
+ {$$=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
- { addGHCVar(intOf($3),textOf($2),$4);
- $$ = gc4(NIL); }
+ {$$=gc4(ap(I_VALUE,
+ ztriple($3,$2,$4)));}
+
| error { syntaxError(
"interface declaration"); }
;
+/*- Top-level misc interface stuff ------------------------*/
+ifOrphans : '!' {$$=gc1(NIL);}
+ | {$$=gc0(NIL);}
+ ;
+ifOptCOCO : COCO {$$=gc1(NIL);}
+ | {$$=gc0(NIL);}
+ ;
+ifCheckVersion
+ : NUMLIT {$$ = gc1(NIL); }
+ ;
+
+
+
/*- Interface variable and constructor ids ----------------*/
ifTyvar : VARID {$$ = $1;}
;
;
ifCon : CONID {$$ = gc1($1);}
;
+
+ifVarCon : VARID {$$ = gc1($1);}
+ | CONID {$$ = gc1($1);}
+ ;
+
ifQCon : CONID {$$ = gc1($1);}
| QCONID {$$ = gc1($1);}
;
/*- Interface contexts ------------------------------------*/
-ifCtxInst /* __forall [a b] {M.C1 a, M.C2 b} => */
- /* :: [(QConId, VarId)] */
- : ALL ifForall ifCtxDecl {$$=gc3($3);}
- | ALL ifForall IMPLIES {$$=gc3(NIL);}
+ifCtxInst /* __forall [a b] => :: [((VarId,Kind))] */
+ : ALL ifForall IMPLIES {$$=gc3($2);}
| {$$=gc0(NIL);}
;
-ifInstHd /* { Class aType } :: (ConId, Type) */
- : '{' ifCon ifAType '}' {$$=gc4(pair($2,$3));}
+ifInstHd /* { Class aType } :: ((ConId, Type)) */
+ : '{' ifQCon ifAType '}' {$$=gc4(ap(DICTAP,
+ zpair($2,$3)));}
;
-ifCtxDecl /* {M.C1 a, C2 b} :: [(QConId, VarId)] */
- : { $$ = gc0(NIL); }
- | '{' ifCtxDeclL '}' IMPLIES { $$ = gc4($2); }
+ifInstHdL /* { C a1 } -> { C2 a2 } -> ... -> { Cn an } :: Type */
+ : ifInstHd ARROW ifInstHdL {$$=gc3(ap($1,$3));}
+ | ifInstHd {$$=gc1($1);}
+ ;
+
+ifCtxDecl /* {M.C1 a, C2 b} => :: [(QConId, VarId)] */
+ : ifCtxDeclT IMPLIES { $$ = gc2($1); }
+ | { $$ = gc0(NIL); }
;
ifCtxDeclT /* {M.C1 a, C2 b} :: [(QConId, VarId)] */
: { $$ = gc0(NIL); }
| '{' ifCtxDeclL '}' { $$ = gc3($2); }
;
+
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(pair($1,$2));}
+ : ifQCon ifTyvar {$$=gc2(zpair($1,$2));}
;
/*- Interface data declarations - constructor lists -------*/
-ifConstrs /* = Con1 | ... | ConN :: [(ConId,[(Type,Text)],NIL)] */
+/* 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.
+*/
+
+ifConstrs /* = Con1 | ... | ConN :: [((ConId,[((Type,VarId,Int))]))] */
: {$$ = gc0(NIL);}
| '=' ifConstrL {$$ = gc2($2);}
;
-ifConstrL /* [(ConId,[(Type,Text)],NIL)] */
+ifConstrL /* [((ConId,[((Type,VarId,Int))]))] */
: ifConstr {$$ = gc1(singleton($1));}
| ifConstr '|' ifConstrL {$$ = gc3(cons($1,$3));}
;
-ifConstr /* (ConId,[(Type,Text)],NIL) */
- : ifConData ifDataAnonFieldL {$$ = gc2(triple($1,$2,NIL));}
+ifConstr /* ((ConId,[((Type,VarId,Int))])) */
+ : ifConData ifDataAnonFieldL {$$ = gc2(zpair($1,$2));}
| ifConData '{' ifDataNamedFieldL '}'
- {$$ = gc4(triple($1,$3,NIL));}
+ {$$ = gc4(zpair($1,$3));}
;
-ifDataAnonFieldL /* [(Type,Text)] */
+ifDataAnonFieldL /* [((Type,VarId,Int))] */
: {$$=gc0(NIL);}
| ifDataAnonField ifDataAnonFieldL
{$$=gc2(cons($1,$2));}
;
-ifDataNamedFieldL /* [(Type,Text)] */
+ifDataNamedFieldL /* [((Type,VarId,Int))] */
: {$$=gc0(NIL);}
| ifDataNamedField {$$=gc1(cons($1,NIL));}
| ifDataNamedField ',' ifDataNamedFieldL
{$$=gc3(cons($1,$3));}
;
-ifDataAnonField /* (Type,Text) */
- : ifAType {$$=gc1(pair($1,NIL));}
+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)));}
;
-ifDataNamedField /* (Type,Text) */
- : VARID COCO ifAType {$$=gc3(pair($3,$1));}
+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)));}
;
/*- Interface class declarations - methods ----------------*/
-ifCmeths /* [(VarId,Type)] */
+ifCmeths /* [((VarId,Type))] */
: { $$ = gc0(NIL); }
| WHERE '{' ifCmethL '}' { $$ = gc4($3); }
;
-ifCmethL /* [(VarId,Type)] */
+ifCmethL /* [((VarId,Type))] */
: ifCmeth { $$ = gc1(singleton($1)); }
| ifCmeth ';' ifCmethL { $$ = gc3(cons($1,$3)); }
;
-ifCmeth /* (VarId,Type) */
- : ifVar COCO ifType { $$ = gc3(pair($1,$3)); }
- | ifVar '=' COCO ifType { $$ = gc4(pair($1,$4)); }
+ifCmeth /* ((VarId,Type)) */
+ : ifVar COCO ifType { $$ = gc3(zpair($1,$3)); }
+ | ifVar '=' COCO ifType { $$ = gc4(zpair($1,$4)); }
/* has default method */
;
/*- Interface newtype declararions ------------------------*/
-ifNewTypeConstr /* (ConId,Type) */
- : '=' ifCon ifAType { $$ = gc3(pair($2,$3)); }
+ifNewTypeConstr /* ((ConId,Type)) */
+ : '=' ifCon ifAType { $$ = gc3(zpair($2,$3)); }
;
| ifBType ARROW ifType { $$ = gc3(fn($1,$3)); }
| ifBType { $$ = gc1($1); }
;
-ifForall /* [(VarId,Kind)] */
+ifForall /* [((VarId,Kind))] */
: '[' ifKindedTyvarL ']' { $$ = gc3($2); }
- ;
-ifTypes2 : ifType ',' ifType { $$ = gc3(doubleton($1,$3)); }
- | ifType ',' ifTypes2 { $$ = gc3(cons($1,$3)); }
;
+
+ifTypeL2 /* [Type], 2 or more */
+ : ifType ',' ifType { $$ = gc3(doubleton($1,$3)); }
+ | ifType ',' ifTypeL2 { $$ = gc3(cons($1,$3)); }
+ ;
+
+ifTypeL /* [Type], 0 or more */
+ : ifType ',' ifTypeL { $$ = gc3(cons($1,$3)); }
+ | ifType { $$ = gc1(singleton($1)); }
+ | { $$ = gc0(NIL); }
+ ;
+
ifBType : ifAType { $$ = gc1($1); }
| ifBType ifAType { $$ = gc2(ap($1,$2)); }
+ | UUUSAGE ifUsage ifAType { $$ = gc3($3); }
;
+
ifAType : ifQTCName { $$ = gc1($1); }
| ifTyvar { $$ = gc1($1); }
| '(' ')' { $$ = gc2(typeUnit); }
- | '(' ifTypes2 ')' { $$ = gc3(buildTuple($2)); }
- | '[' ifType ']' { $$ = gc3(ap(typeList,$2));}
- | '{' ifQTCName ifATypes '}' { $$ = gc4(ap(DICTAP,
+ | '(' 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)); }
;
-ifATypes : { $$ = gc0(NIL); }
- | ifAType ifATypes { $$ = gc2(cons($1,$2)); }
+
+
+/*- KW's usage stuff --------------------------------------*/
+ifUsage : '-' { $$ = gc1(NIL); }
+ | '!' { $$ = gc1(NIL); }
+ | ifVar { $$ = gc1(NIL); }
;
/*- Interface kinds ---------------------------------------*/
-ifKindedTyvarL /* [(VarId,Kind)] */
+ifKindedTyvarL /* [((VarId,Kind))] */
: { $$ = gc0(NIL); }
| ifKindedTyvar ifKindedTyvarL { $$ = gc2(cons($1,$2)); }
;
-ifKindedTyvar /* (VarId,Kind) */
- : ifTyvar { $$ = gc1(pair($1,STAR)); }
- | ifTyvar COCO ifAKind { $$ = gc3(pair($1,$3)); }
+ifKindedTyvar /* ((VarId,Kind)) */
+ : ifTyvar { $$ = gc1(zpair($1,STAR)); }
+ | ifTyvar COCO ifAKind { $$ = gc3(zpair($1,$3)); }
;
ifKind : ifAKind { $$ = gc1($1); }
| ifAKind ARROW ifKind { $$ = gc3(fn($1,$3)); }
;
ifEntity
: ifEntityOcc {$$=gc1($1);}
- | ifEntityOcc ifStuffInside {$$=gc2(pair($1,$2));}
+ | ifEntityOcc ifStuffInside {$$=gc2(zpair($1,$2));}
;
ifEntityOcc
: ifVar { $$ = gc1($1); }
| ifVar ifValOccs { $$ = gc2(cons($1,$2)); }
| ifCon ifValOccs { $$ = gc2(cons($1,$2)); }
;
-version_list_junk
- : {$$=gc0(NIL);}
- | VARID NUMLIT version_list_junk {$$=gc3(cons($1,$3));}
- | CONID NUMLIT version_list_junk {$$=gc3(cons($1,$3));}
+
+ifVersionList
+ : {$$=gc0(NIL);}
+ | VARID NUMLIT ifVersionList {$$=gc3(cons($1,$3));}
+ | CONID NUMLIT ifVersionList {$$=gc3(cons($1,$3));}
;
/*- Haskell module header/import parsing: -----------------------------------
-
* Syntax for Haskell modules (module headers and imports) is parsed but
* most of it is ignored. However, module names in import declarations
* are used, of course, if import chasing is turned on.
projects / ghc-hetmet.git / blobdiff