===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/subst.c,v
retrieving revision 1.2
retrieving revision 1.9
diff -u -p -r1.2 -r1.9
--- OpenXM_contrib2/asir2000/builtin/subst.c	2000/08/21 08:31:21	1.2
+++ OpenXM_contrib2/asir2000/builtin/subst.c	2010/01/31 03:25:54	1.9
@@ -23,7 +23,7 @@
  * shall be made on your publication or presentation in any form of the
  * results obtained by use of the SOFTWARE.
  * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
- * e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification
+ * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
  * for such modification or the source code of the modified part of the
  * SOFTWARE.
  * 
@@ -45,20 +45,85 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.1.1.1 1999/12/03 07:39:07 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.8 2010/01/28 08:56:26 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
 
-void Psubst(), Ppsubst(), Psubstf();
+void Psubst(), Ppsubst(), Psubstf(), Psubst_quote();
+void Psubstr2np();
 
 struct ftab subst_tab[] = {
 	{"subst",Psubst,-99999999},
+	{"substr2np",Psubstr2np,2},
+	{"subst_quote",Psubst_quote,-99999999},
 	{"psubst",Ppsubst,-99999999},
 	{"substf",Psubstf,-99999999},
 	{0,0,0},
 };
 
+extern Obj VOIDobj;
+
+void Psubstr2np(NODE arg,Obj *rp)
+{
+	Obj a;
+	P nm,dn,p;
+	R r;
+	VL vl,tvl;
+	int nv,i;
+	NODE slist,t,ps;
+	P s;
+	P *svect;
+	V v;
+	V *vvect;
+
+	a = (Obj)ARG0(arg);
+	if ( !a || NUM(a) ) {
+		*rp = a;
+		return;
+	}
+	asir_assert(ARG0(arg),O_R,"substr2np");
+	asir_assert(ARG1(arg),O_LIST,"substr2np");
+	get_vars(a,&vl);
+	for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ );
+	nv = i;
+	vvect = (V *)MALLOC(nv*sizeof(V));
+	for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ ) vvect[i] = tvl->v;
+	svect = (P *)MALLOC(nv*sizeof(P));
+	slist = BDY((LIST)ARG1(arg));
+	for ( i = 0; i < nv; i++ ) svect[i] = (P)VOIDobj;
+	for ( t = slist; t; t = NEXT(t) ) {
+		ps = BDY((LIST)BDY(t)); p = (P)BDY(ps); s = (P)BDY(NEXT(ps));	
+		asir_assert(p,O_P,"substr2np"); asir_assert(s,O_N,"substr2np");
+		v = VR(p);
+		for ( i = 0; i < nv; i++ ) if ( vvect[i] == v ) break;
+		svect[i] = s;
+	}
+	
+	switch ( OID(a) ) {
+		case O_P:
+			substpp(vl,(P)a,vvect,svect,nv,&nm); *rp = (Obj)nm;
+			return;
+		case O_R:
+			substpp(vl,(P)NM((R)a),vvect,svect,nv,&nm);
+			substpp(vl,(P)DN((R)a),vvect,svect,nv,&dn);
+			if ( !dn )
+				error("substr2np: division by 0");
+			else if ( !nm )
+				*rp = 0;
+			else if ( NUM(dn) ) {
+				divsp(vl,nm,dn,&p);
+				*rp = (Obj)p;
+			} else {
+				MKRAT(nm,dn,0,r);
+				*rp = (Obj)r;
+			}
+			return;
+		default:
+			error("substr2np: invalid argument");
+	}
+}
+
 void Psubst(arg,rp)
 NODE arg;
 Obj *rp;
@@ -66,27 +131,137 @@ Obj *rp;
 	Obj a,b,t;
 	LIST l;
 	V v;
+	int row,col,len;
+	VECT vect;
+	MAT mat;
+	int i,j;
+	NODE n0,n,nd;
+	struct oNODE arg0;
+	MP m,mp,mp0;
+	DP d;
 
 	if ( !arg ) {
 		*rp = 0; return;
 	}
-	asir_assert(ARG0(arg),O_R,"subst");
-	reductr(CO,(Obj)ARG0(arg),&a);
-/*	a = (Obj)ARG0(arg); */
-	arg = NEXT(arg);
+	a = (Obj)ARG0(arg);
+	if ( !a ) {
+		*rp = 0;
+		return;
+	}
+	switch ( OID(a) ) {
+		case O_N: case O_P: case O_R:
+			reductr(CO,(Obj)ARG0(arg),&a);
+			arg = NEXT(arg);
+			if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
+				arg = BDY(l);
+			while ( arg ) {
+				if ( !BDY(arg) || OID((Obj)BDY(arg)) != O_P )
+					error("subst : invalid argument");
+				v = VR((P)BDY(arg)); arg = NEXT(arg);
+				if ( !arg )
+					error("subst : invalid argument");
+				asir_assert(ARG0(arg),O_R,"subst");
+				reductr(CO,(Obj)BDY(arg),&b); arg = NEXT(arg);
+		/*		b = (Obj)BDY(arg); arg = NEXT(arg); */
+				substr(CO,0,a,v,b,&t); a = t;
+			}
+			*rp = a;
+			break;
+		case O_LIST:
+			n0 = 0;
+			for ( nd = BDY((LIST)a); nd; nd = NEXT(nd) ) {
+				NEXTNODE(n0,n);
+				arg0.body = (pointer)BDY(nd);
+				arg0.next = NEXT(arg);
+				Psubst(&arg0,&b);
+				BDY(n) = (pointer)b;
+			}
+			if ( n0 )
+				NEXT(n) = 0;
+			MKLIST(l,n0);
+			*rp = (Obj)l;
+			break;
+		case O_VECT:
+			len = ((VECT)a)->len;
+			MKVECT(vect,len);
+			for ( i = 0; i < len; i++ ) {
+				arg0.body = (pointer)BDY((VECT)a)[i];
+				arg0.next = NEXT(arg);
+				Psubst(&arg0,&b);
+				BDY(vect)[i] = (pointer)b;
+			}
+			*rp = (Obj)vect;
+			break;
+		case O_MAT:
+			row = ((MAT)a)->row;
+			col = ((MAT)a)->col;
+			MKMAT(mat,row,col);
+			for ( i = 0; i < row; i++ )
+				for ( j = 0; j < col; j++ ) {
+					arg0.body = (pointer)BDY((MAT)a)[i][j];
+					arg0.next = NEXT(arg);
+					Psubst(&arg0,&b);
+					BDY(mat)[i][j] = (pointer)b;
+				}
+			*rp = (Obj)mat;
+			break;
+		case O_DP:
+			mp0 = 0;
+			for ( m = BDY((DP)a); m; m = NEXT(m) ) {
+				arg0.body = (pointer)C(m);
+				arg0.next = NEXT(arg);
+				Psubst(&arg0,&b);
+				if ( b ) {
+					NEXTMP(mp0,mp);
+					C(mp) = (P)b;
+					mp->dl = m->dl;
+				}
+			}
+			if ( mp0 ) {
+				MKDP(NV((DP)a),mp0,d);
+				d->sugar = ((DP)a)->sugar;
+				*rp = (Obj)d;
+			} else
+				*rp = 0;
+
+			break;
+		default:
+			error("subst : invalid argument");
+	}
+}
+
+FNODE subst_in_fnode();
+
+void Psubst_quote(arg,rp)
+NODE arg;
+QUOTE *rp;
+{
+	QUOTE h;
+	FNODE fn;
+	Obj g;
+	LIST l;
+	V v;
+
+	if ( !arg ) {
+		*rp = 0; return;
+	}
+	asir_assert(ARG0(arg),O_QUOTE,"subst_quote");
+	fn = BDY((QUOTE)ARG0(arg)); arg = NEXT(arg);
 	if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
 		arg = BDY(l);
 	while ( arg ) {
-		asir_assert(BDY(arg),O_P,"subst");
+		asir_assert(BDY(arg),O_P,"subst_quote");
 		v = VR((P)BDY(arg)); arg = NEXT(arg);
 		if ( !arg )
-			error("subst : invalid argument");
-		asir_assert(ARG0(arg),O_R,"subst");
-		reductr(CO,(Obj)BDY(arg),&b); arg = NEXT(arg);
-/*		b = (Obj)BDY(arg); arg = NEXT(arg); */
-		substr(CO,0,a,v,b,&t); a = t;
+			error("subst_quote : invalid argument");
+		g = (Obj)ARG0(arg); arg = NEXT(arg);
+		if ( !g || OID(g) != O_QUOTE )
+			objtoquote(g,&h);
+		else
+			h = (QUOTE)g;
+		fn = subst_in_fnode(fn,v,BDY(h));
 	}
-	*rp = a;
+	MKQUOTE(*rp,fn);
 }
 
 void Ppsubst(arg,rp)