Qualified names in instance decls

Sigbjorn Finne sigbjorn_finne@hotmail.com
Sat, 17 Mar 2001 20:59:29 +0100


This is a multi-part message in MIME format.

------=_NextPart_000_0180_01C0AF25.28B73540
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit

In an effort to fix problems rather than just work around them,
here's a patch to Feb2001 sources(*), which permits
the use of qualified names in instance declarations. Hopefully
in a good enough shape to be used; mildly tested.

--sigbjorn

(*) - not quite, diffs are wrt Feb2001 sources after having
applied the module re-exportation fix I suggested earlier.


------=_NextPart_000_0180_01C0AF25.28B73540
Content-Type: application/octet-stream;
	name="inst-patch"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="inst-patch"

*** parser.y.~1~	Tue Feb 29 02:29:00 2000
--- parser.y	Sat Mar 17 20:42:06 2001
***************
*** 1,8 ****
  /* =
-------------------------------------------------------------------------=
-
   * Hugs parser (included as part of input.c)
   *
!  * Expect 15 shift/reduce conflicts when passing this grammar through =
yacc,
   * but don't worry; they should 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
--- 1,8 ----
  /* =
-------------------------------------------------------------------------=
-
   * Hugs parser (included as part of input.c)
   *
!  * Expect 16 shift/reduce conflicts when passing this grammar through =
yacc,
   * but don't worry; they should 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
***************
*** 421,429 ****
 =20
  /*- Class declarations: =
---------------------------------------------------*/
 =20
  topDecl	  : TCLASS crule fds wherePart	{classDefn(intOf($1),$2,$4,$3); =
sp-=3D4;}
! 	  | TINSTANCE irule wherePart	{instDefn(intOf($1),$2,$3);  sp-=3D3;}
  	  | DEFAULT '(' dtypes ')'	{defaultDefn(intOf($1),$3);  sp-=3D4;}
  	  | TCLASS error		{syntaxError("class declaration");}
  	  | TINSTANCE error		{syntaxError("instance declaration");}
  	  | DEFAULT error		{syntaxError("default declaration");}
--- 421,429 ----
 =20
  /*- Class declarations: =
---------------------------------------------------*/
 =20
  topDecl	  : TCLASS crule fds wherePart	{classDefn(intOf($1),$2,$4,$3); =
sp-=3D4;}
! 	  | TINSTANCE irule iwherePart	{instDefn(intOf($1),$2,$3);  sp-=3D3;}
  	  | DEFAULT '(' dtypes ')'	{defaultDefn(intOf($1),$3);  sp-=3D4;}
  	  | TCLASS error		{syntaxError("class declaration");}
  	  | TINSTANCE error		{syntaxError("instance declaration");}
  	  | DEFAULT error		{syntaxError("default declaration");}
***************
*** 611,618 ****
--- 611,630 ----
  						     pair($1,ap(RSIGN,
  								ap($4,$3)))));}
  	  | pat0 rhs			{$$ =3D gc2(ap(PATBIND,pair($1,$2)));}
  	  ;
+ idecls	  : '{' idecls0 end		{$$ =3D gc3($2);}
+ 	  | '{' idecls1 end		{$$ =3D gc3($2);}
+ 	  ;
+ idecls0	  : /* empty */			{$$ =3D gc0(NIL);}
+ 	  | idecls0 ';'			{$$ =3D gc2($1);}
+ 	  | idecls1 ';'			{$$ =3D gc2($1);}
+ 	  ;
+ idecls1	  : idecls0 idecl		{$$ =3D gc2(cons($2,$1));}
+=20
+ idecl	  : qfunlhs rhs			{$$ =3D gc2(ap(FUNBIND,pair($1,$2)));}
+           | qvar rhs                    {$$ =3D =
gc2(ap(PATBIND,pair($1,$2)));}
+ 	  ;
  funlhs	  : funlhs0			{$$ =3D $1;}
  	  | funlhs1			{$$ =3D $1;}
  	  | npk				{$$ =3D $1;}
  	  ;
***************
*** 627,634 ****
--- 639,659 ----
  	  | '(' npk     ')' apat	{$$ =3D gc4(ap($2,$4));}
  	  | var     apat		{$$ =3D gc2(ap($1,$2));}
  	  | funlhs1 apat		{$$ =3D gc2(ap($1,$2));}
  	  ;
+ qfunlhs	  : qfunlhs0			{$$ =3D $1;}
+ 	  | qfunlhs1			{$$ =3D $1;}
+ 	  ;
+ qfunlhs0  : pat10_vI qvarop    pat0	{$$ =3D gc3(ap2($2,$1,$3));}
+ 	  | infixPat qvarop    pat0	{$$ =3D gc3(ap2($2,$1,$3));}
+ 	  | NUMLIT   qvarop    pat0	{$$ =3D gc3(ap2($2,$1,$3));}
+ 	  | var      qvarop_mi pat0	{$$ =3D gc3(ap2($2,$1,$3));}
+ 	  ;
+ qfunlhs1  : '(' qfunlhs0 ')' apat	{$$ =3D gc4(ap($2,$4));}
+ 	  | '(' qfunlhs1 ')' apat	{$$ =3D gc4(ap($2,$4));}
+ 	  | qvar     apat		{$$ =3D gc2(ap($1,$2));}
+ 	  | qfunlhs1 apat		{$$ =3D gc2(ap($1,$2));}
+ 	  ;
  rhs	  : rhs1 wherePart		{$$ =3D gc2(letrec($2,$1));}
  	  | error			{syntaxError("declaration");}
  	  ;
  rhs1	  : '=3D' exp			{$$ =3D gc2(pair($1,$2));}
***************
*** 642,649 ****
--- 667,680 ----
  wherePart : /* empty */			{$$ =3D gc0(NIL);}
  	  | WHERE decls			{$$ =3D gc2($2);}
  	  ;
 =20
+ /* Body of instance decls, differs from wherePart in that
+    qualified names can be bound on the LHS.
+ */
+ iwherePart : /* empty */		{$$ =3D gc0(NIL);}
+ 	   | WHERE idecls		{$$ =3D gc2($2);}
+ 	   ;
  /*- Patterns: =
-------------------------------------------------------------*/
 =20
  pat	  : npk				{$$ =3D $1;}
  	  | pat_npk			{$$ =3D $1;}

*** static.c.~2~	Sat Mar  3 19:43:08 2001
--- static.c	Sat Mar 17 20:41:46 2001
***************
*** 1984,2007 ****
  String where;				/* Check validity of bindings bs   */
  Class  c;				/* for class c (or an inst of c)   */
  List   bs; {				/* sort into approp. member order  */
      List nbs =3D NIL;
 =20
      for (; nonNull(bs); bs=3Dtl(bs)) {
  	Cell b    =3D hd(bs);
  	Cell body =3D snd(snd(b));
  	Name mnm;
 =20
! 	if (!isVar(fst(b))) {		/* Only allow function bindings    */
  	    ERRMSG(rhsLine(snd(body)))
  		"Pattern binding illegal in %s declaration", where
  	    EEND;
  	}
 =20
! 	if (isNull(mnm=3DmemberName(c,textOf(fst(b))))) {
  	    ERRMSG(rhsLine(snd(hd(body))))
  		"No member \"%s\" in class \"%s\"",
! 		textToStr(textOf(fst(b))), textToStr(cclass(c).text)
  	    EEND;
  	}
  	snd(b) =3D body;
  	nbs    =3D numInsert(mfunOf(mnm)-1,b,nbs);
--- 1984,2015 ----
  String where;				/* Check validity of bindings bs   */
  Class  c;				/* for class c (or an inst of c)   */
  List   bs; {				/* sort into approp. member order  */
      List nbs =3D NIL;
+     Text nm;
 =20
      for (; nonNull(bs); bs=3Dtl(bs)) {
  	Cell b    =3D hd(bs);
  	Cell body =3D snd(snd(b));
  	Name mnm;
 =20
! 	if ( !(isVar(fst(b)) || isQVar(fst(b))) ) { /* Only allow function =
bindings    */
  	    ERRMSG(rhsLine(snd(body)))
  		"Pattern binding illegal in %s declaration", where
  	    EEND;
  	}
+ =09
+ 	/* Get at the unqualified name of the method */
+ 	if (isVar(fst(b))) {
+ 	  nm =3D textOf(fst(b));
+ 	} else {
+ 	  nm =3D qtextOf(fst(b));
+ 	}
 =20
! 	if (isNull(mnm=3DmemberName(c,nm))) {
  	    ERRMSG(rhsLine(snd(hd(body))))
  		"No member \"%s\" in class \"%s\"",
! 		textToStr(nm), textToStr(cclass(c).text)
  	    EEND;
  	}
  	snd(b) =3D body;
  	nbs    =3D numInsert(mfunOf(mnm)-1,b,nbs);
***************
*** 5081,5089 ****
  	    Int  line	=3D rhsLine(rhs);
  	    Cell lhs	=3D fst(snd(d));
  	    Cell v	=3D getHead(lhs);
  	    Cell newAlt =3D pair(getArgs(lhs),rhs);
! 	    if (!isVar(v)) {
  		internal("FUNBIND");
  	    }
  	    if (nonNull(lastVar) && textOf(v)=3D=3DtextOf(lastVar)) {
  		if (argCount!=3DlastArity) {
--- 5089,5097 ----
  	    Int  line	=3D rhsLine(rhs);
  	    Cell lhs	=3D fst(snd(d));
  	    Cell v	=3D getHead(lhs);
  	    Cell newAlt =3D pair(getArgs(lhs),rhs);
! 	    if ( !(isVar(v) || isQVar(v)) ) {
  		internal("FUNBIND");
  	    }
  	    if (nonNull(lastVar) && textOf(v)=3D=3DtextOf(lastVar)) {
  		if (argCount!=3DlastArity) {

------=_NextPart_000_0180_01C0AF25.28B73540--