===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/reduct.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- OpenXM_contrib2/asir2000/builtin/reduct.c	2000/08/22 05:03:59	1.3
+++ OpenXM_contrib2/asir2000/builtin/reduct.c	2017/08/31 02:36:20	1.4
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/builtin/reduct.c,v 1.2 2000/08/21 08:31:21 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/reduct.c,v 1.3 2000/08/22 05:03:59 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
@@ -59,26 +59,100 @@ struct ftab reduct_tab[] = {
 	{0,0,0},
 };
 
-void Pred(arg,rp)
-NODE arg;
-Obj *rp;
+void Pred(NODE arg,Obj *rp)
 {
-	asir_assert(ARG0(arg),O_R,"red");
-	reductr(CO,(Obj)ARG0(arg),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;
+
+	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),rp);
+			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 = 0;
+				Pred(&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 = 0;
+				Pred(&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 = 0;
+					Pred(&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 = 0;
+				Pred(&arg0,&b);
+				if ( b ) {
+					NEXTMP(mp0,mp);
+					C(mp) = 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("red : invalid argument");
+	}
 }
 
-void Predc(arg,rp)
-NODE arg;
-P *rp;
+void Predc(NODE arg,P *rp)
 {
 	asir_assert(ARG0(arg),O_P,"redc");
 	asir_assert(ARG1(arg),O_P,"redc");
 	remsdcp(CO,(P)ARG0(arg),(P)ARG1(arg),rp);
 }
 
-void Pprim(arg,rp)
-NODE arg;
-P *rp;
+void Pprim(NODE arg,P *rp)
 {
 	P t,p,p1,r;
 	V v;