===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/strobj.c,v
retrieving revision 1.112
retrieving revision 1.115
diff -u -p -r1.112 -r1.115
--- OpenXM_contrib2/asir2000/builtin/strobj.c	2005/12/18 01:57:21	1.112
+++ OpenXM_contrib2/asir2000/builtin/strobj.c	2006/08/09 05:05:28	1.115
@@ -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/strobj.c,v 1.111 2005/12/18 01:44:16 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.114 2005/12/19 01:31:43 noro Exp $
 */
 #include "ca.h"
 #include "parse.h"
@@ -104,6 +104,7 @@ void Pnqt_match_rewrite();
 void Pqt_to_nbp();
 void Pshuffle_mul(), Pharmonic_mul();
 void Pnbp_hm(), Pnbp_ht(), Pnbp_hc(), Pnbp_rest();
+void Pnbp_tm(), Pnbp_tt(), Pnbp_tc(), Pnbp_trest();
 void Pnbm_deg();
 void Pnbm_hp_rest();
 void Pnbm_hxky(), Pnbm_xky_rest();
@@ -182,6 +183,10 @@ struct ftab str_tab[] = {
 	{"nbp_ht", Pnbp_ht,1},
 	{"nbp_hc", Pnbp_hc,1},
 	{"nbp_rest", Pnbp_rest,1},
+	{"nbp_tm", Pnbp_tm,1},
+	{"nbp_tt", Pnbp_tt,1},
+	{"nbp_tc", Pnbp_tc,1},
+	{"nbp_trest", Pnbp_trest,1},
 	{"nbm_deg", Pnbm_deg,1},
 	{"nbm_hxky", Pnbm_hxky,1},
 	{"nbm_xky_rest", Pnbm_xky_rest,1},
@@ -1538,9 +1543,9 @@ void fnodetotex_tb(FNODE f,TB tb)
 					for ( args = NEXT(args); args; args = NEXT(args) ) {
 						write_tb("+",tb);
 						f1 = (FNODE)BDY(args);
-						if ( fnode_is_var(f1) || IS_MUL(f1) )
+						/* if ( fnode_is_var(f1) || IS_MUL(f1) )
 							fnodetotex_tb(f1,tb);
-						else {
+						else */ {
 							write_tb("(",tb);
 							fnodetotex_tb(f1,tb);
 							write_tb(")",tb);
@@ -2410,13 +2415,13 @@ void Pnbp_ht(NODE arg, NBP *rp)
 	else {
 		m = (NBM)BDY(BDY(p));
 		NEWNBM(m1);
-		m1->d = m->d; m1->c = ONE; m1->b = m->b;
+		m1->d = m->d; m1->c = (P)ONE; m1->b = m->b;
 		MKNODE(n,m1,0);
 		MKNBP(*rp,n);
 	}
 }
 
-void Pnbp_hc(NODE arg, Q *rp)
+void Pnbp_hc(NODE arg, P *rp)
 {
 	NBP p;
 	NBM m;
@@ -2444,6 +2449,76 @@ void Pnbp_rest(NODE arg, NBP *rp)
 	}
 }
 
+void Pnbp_tm(NODE arg, NBP *rp)
+{
+	NBP p;
+	NODE n;
+	NBM m;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) *rp = 0;
+	else {
+		for ( n = BDY(p); NEXT(n); n = NEXT(n) );
+		m = (NBM)BDY(n);
+		MKNODE(n,m,0);
+		MKNBP(*rp,n);
+	}
+}
+	
+void Pnbp_tt(NODE arg, NBP *rp)
+{
+	NBP p;
+	NODE n;
+	NBM m,m1;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) *rp = 0;
+	else {
+		for ( n = BDY(p); NEXT(n); n = NEXT(n) );
+		m = (NBM)BDY(n);
+		NEWNBM(m1);
+		m1->d = m->d; m1->c = (P)ONE; m1->b = m->b;
+		MKNODE(n,m1,0);
+		MKNBP(*rp,n);
+	}
+}
+
+void Pnbp_tc(NODE arg, P *rp)
+{
+	NBP p;
+	NBM m;
+	NODE n;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) *rp = 0;
+	else {
+		for ( n = BDY(p); NEXT(n); n = NEXT(n) );
+		m = (NBM)BDY(n);
+		*rp = m->c;
+	}
+}
+
+void Pnbp_trest(NODE arg, NBP *rp)
+{
+	NBP p;
+	NODE n,r,r0;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) *rp = 0;
+	else {
+		n = BDY(p);
+		for ( r0 = 0; NEXT(n); n = NEXT(n) ) {
+			NEXTNODE(r0,r);
+			BDY(r) = (pointer)BDY(n);
+		}
+		if ( r0 ) {
+			NEXT(r) = 0;
+			MKNBP(*rp,r0);
+		} else
+			*rp = 0;
+	}
+}
+
 void Pnbm_deg(NODE arg, Q *rp)
 {
 	NBP p;
@@ -2479,14 +2554,14 @@ void Pnbm_hp_rest(NODE arg, LIST *rp)
 			for ( i = 1; i < d; i++ )
 				if ( NBM_GET(b,i) != v ) break;
 			NEWNBM(m1); NEWNBMBDY(m1,i); 
-			b1 = m1->b; m1->d = i; m1->c = ONE;
+			b1 = m1->b; m1->d = i; m1->c = (P)ONE;
 			if ( v ) for ( j = 0; j < i; j++ ) NBM_SET(b1,j);
 			else for ( j = 0; j < i; j++ ) NBM_CLR(b1,j);
 			MKNODE(n,m1,0); MKNBP(h,n);
 
 			d1 = d-i;
 			NEWNBM(m1); NEWNBMBDY(m1,d1);
-			b1 = m1->b; m1->d = d1; m1->c = ONE;
+			b1 = m1->b; m1->d = d1; m1->c = (P)ONE;
 			for ( j = 0, k = i; j < d1; j++, k++ )
 				if ( NBM_GET(b,k) ) NBM_SET(b1,j);
 				else NBM_CLR(b1,j);
@@ -2554,10 +2629,10 @@ NBP fnode_to_nbp(FNODE f)
 		r = eval(f);
 		NEWNBM(m);
 		if ( OID(r) == O_N ) {
-			m->d = 0; m->c = (Q)r; m->b = 0;
+			m->d = 0; m->c = (P)r; m->b = 0;
 		} else {
 			v = VR((P)r);
-			m->d = 1; m->c = ONE; NEWNBMBDY(m,1);
+			m->d = 1; m->c = (P)ONE; NEWNBMBDY(m,1);
 			if ( !strcmp(NAME(v),"x") ) NBM_SET(m->b,0);
 			else NBM_CLR(m->b,0);
 		}
@@ -3017,14 +3092,24 @@ FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)
 	m = (FNODE *)ALLOCA(l*sizeof(FNODE));
 	for ( r = n1, i = 0; i < l1; r = NEXT(r), i++ ) m[i] = BDY(r);
 	for ( r = n2; r; r = NEXT(r) ) {
-		if ( i == 0 || (expand == 2) )
+		if ( i == 0 )
 			m[i++] = BDY(r);
 		else {
 			fnode_base_exp(m[i-1],&b1,&e1); fnode_base_exp(BDY(r),&b2,&e2);
 			if ( compfnode(b1,b2) ) break;
 			arf_add(CO,eval(e1),eval(e2),&e);
 			if ( !e ) i--;
-			else if ( UNIQ(e) )
+			else if ( expand == 2 ) {
+				if ( INT(e) && SGN((Q)e) < 0 ) {
+					t1 = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,e));
+					/* r=(r0|rest)->(r0,t1|rest) */
+					t = BDY(r);
+					MKNODE(r1,t1,NEXT(r));
+					MKNODE(r,t,r1);
+					i--;
+				} else
+					m[i++] = BDY(r);
+			} else if ( UNIQ(e) )
 				m[i-1] = b1;
 			else
 				m[i-1] = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,e));
@@ -3230,11 +3315,11 @@ int nfnode_weight(struct wtab *tab,FNODE f)
 		case I_FORMULA:
 			if ( fnode_is_coef(f) ) return 0;
 			else if ( fnode_is_var(f) ) {
-				if ( !tab ) return 1;
+				if ( !tab ) return 0;
 				v = VR((P)FA0(f));
 				for ( i = 0; tab[i].v; i++ )
 					if ( v == tab[i].v ) return tab[i].w;
-				return 1;
+				return 0;
 			} else return 0;
 
 		/* XXX */
@@ -3291,7 +3376,7 @@ int nfnode_comp_lex(FNODE f1,FNODE f2)
 	NODE n1,n2;
 	int r,i1,i2,ret;
 	char *nm1,*nm2;
-	FNODE b1,b2,e1,e2,g,a1,a2,fn1,fn2;
+	FNODE b1,b2,e1,e2,g,a1,a2,fn1,fn2,h1,h2;
 	Num ee,ee1;
 	Obj c1,c2;
 	int w1,w2;
@@ -3299,12 +3384,14 @@ int nfnode_comp_lex(FNODE f1,FNODE f2)
 	if ( IS_NARYADD(f1) || IS_NARYADD(f2) ) {
 		f1 = to_naryadd(f1); f2 = to_naryadd(f2);
 		n1 = (NODE)FA1(f1); n2 = (NODE)FA1(f2);
-		while ( n1 && n2 )
-			if ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) return r;
-			else {
-				n1 = NEXT(n1); n2 = NEXT(n2);
-			}
-		return n1?1:(n2?-1:0);
+		for ( ; n1 && n2; n1 = NEXT(n1), n2 = NEXT(n2) ) {
+			r = nfnode_comp_lex(BDY(n1),BDY(n2));
+			if ( r ) return r;
+		}
+		if ( !n1 && !n2 ) return 0;
+		h1 = n1 ? (FNODE)BDY(n1) : mkfnode(1,I_FORMULA,0);
+		h2 = n2 ? (FNODE)BDY(n2) : mkfnode(1,I_FORMULA,0);
+		return nfnode_comp_lex(h1,h2);
 	}
 	if ( IS_NARYMUL(f1) || IS_NARYMUL(f2) ) {
 		fnode_coef_body(f1,&c1,&b1);
@@ -3312,42 +3399,14 @@ int nfnode_comp_lex(FNODE f1,FNODE f2)
 		if ( !compfnode(b1,b2) ) return arf_comp(CO,c1,c2);
 		b1 = to_narymul(b1); b2 = to_narymul(b2);
 		n1 = (NODE)FA1(b1); n2 = (NODE)FA1(b2);
-		while ( 1 ) {
-			while ( n1 && n2 && !compfnode(BDY(n1),BDY(n2)) ) {
-				n1 = NEXT(n1); n2 = NEXT(n2);
-			}
-			if ( !n1 || !n2 ) {
-				return n1?1:(n2?-1:0);
-			}
-			fnode_base_exp(BDY(n1),&b1,&e1);
-			fnode_base_exp(BDY(n2),&b2,&e2);
-
-			if ( r = nfnode_comp_lex(b1,b2) ) {
-				if ( r > 0 )
-					return nfnode_comp_lex(e1,mkfnode(1,I_FORMULA,0));
-				else if ( r < 0 )
-					return nfnode_comp_lex(mkfnode(1,I_FORMULA,0),e2);
-			} else {
-				n1 = NEXT(n1); n2 = NEXT(n2);
-				if ( fnode_is_number(e1) && fnode_is_number(e2) ) {
-					/* f1 = t b^e1 ... , f2 = t b^e2 ... */
-					subnum(0,eval(e1),eval(e2),&ee);
-					r = compnum(0,ee,0);
-					if ( r > 0 ) {
-						g = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,ee));
-						MKNODE(n1,g,n1);
-					} else if ( r < 0 ) {
-						chsgnnum(ee,&ee1);
-						g = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,ee1));
-						MKNODE(n2,g,n2);
-					}
-				} else {
-					r = nfnode_comp_lex(e1,e2);
-					if ( r > 0 ) return 1;
-					else if ( r < 0 ) return -1;
-				}
-			}
+		for ( ; n1 && n2; n1 = NEXT(n1), n2 = NEXT(n2) ) {
+			r = nfnode_comp_lex(BDY(n1),BDY(n2));
+			if ( r ) return r;
 		}
+		if ( !n1 && !n2 ) return 0;
+		h1 = n1 ? (FNODE)BDY(n1) : mkfnode(1,I_FORMULA,ONE);
+		h2 = n2 ? (FNODE)BDY(n2) : mkfnode(1,I_FORMULA,ONE);
+		return nfnode_comp_lex(h1,h2);
 	}
 	if ( IS_BINARYPWR(f1) || IS_BINARYPWR(f2) ) {
 		fnode_base_exp(f1,&b1,&e1);