===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/strobj.c,v
retrieving revision 1.70
retrieving revision 1.74
diff -u -p -r1.70 -r1.74
--- OpenXM_contrib2/asir2000/builtin/strobj.c	2005/10/12 03:31:04	1.70
+++ OpenXM_contrib2/asir2000/builtin/strobj.c	2005/10/14 07:49:21	1.74
@@ -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.69 2005/10/05 08:57:25 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.73 2005/10/14 07:39:38 noro Exp $
 */
 #include "ca.h"
 #include "parse.h"
@@ -63,6 +63,8 @@ struct TeXSymbol {
 	char *symbol;
 };
 
+#define OPNAME(f) (((ARF)FA0(f))->name[0])
+
 extern char *parse_strp;
 
 void Psprintf();
@@ -1921,7 +1923,6 @@ void Pfunargs_to_quote(NODE arg,QUOTE *rp)
 
 FNODE fnode_apply(FNODE f,FNODE (*func)());
 FNODE fnode_normalize(FNODE f);
-FNODE fnode_normalize_monomial(FNODE f);
 
 void Pquote_normalize(NODE arg,QUOTE *rp)
 {
@@ -1934,10 +1935,6 @@ void Pquote_normalize(NODE arg,QUOTE *rp)
 		return;
 	} else {
 		f = fnode_normalize(BDY(q));
-		f = flatten_fnode(f,"+");
-		f = flatten_fnode(f,"*");
-		f = fnode_to_nary(f);
-		f = fnode_normalize_monomial(f); 
 		MKQUOTE(r,f);
 		*rp = r;
 	}
@@ -2096,65 +2093,78 @@ int fnode_is_dependent(FNODE f,V v)
 	}
 }
 
+FNODE fnode_normalize_add(FNODE a1,FNODE a2);
+FNODE fnode_normalize_mul(FNODE a1,FNODE a2);
+FNODE fnode_normalize_pwr(FNODE a1,FNODE a2);
+FNODE to_narymul(FNODE f);
+FNODE to_naryadd(FNODE f);
+FNODE fnode_normalize_mul_coef(Num c,FNODE f);
+void fnode_base_exp(FNODE f,FNODE *bp,FNODE *ep);
+void fnode_coef_body(FNODE f,Num *cp,FNODE *bp);
+
+
 FNODE fnode_normalize(FNODE f)
 {
-	FNODE a2,mone;
-	Q q;
+	FNODE a1,a2,mone,r,b2;
 	NODE n;
+	Num invc2,c2;
+	Q q;
 
-	f = fnode_apply(f,fnode_normalize);
+	STOQ(-1,q);
+	mone = mkfnode(1,I_FORMULA,q);
 	switch ( f->id ) {
 		case I_PAREN:
-			return FA0(f);
-				
+			return fnode_normalize(FA0(f));
+		
+		case I_MINUS:
+			return fnode_normalize_mul_coef((Num)q,fnode_normalize(FA0(f)));
+
 		case I_BOP:
 			/* arf fnode fnode */
-			switch ( ((ARF)FA0(f))->name[0] ) {
+			a1 = fnode_normalize(FA1(f));
+			a2 = fnode_normalize(FA2(f));
+			switch ( OPNAME(f) ) {
+				case '+':
+					return fnode_normalize_add(a1,a2);
 				case '-':
-					a2 = mkfnode(1,I_MINUS,FA2(f));
-					return mkfnode(3,I_BOP,addfs,FA1(f),a2);
+					a2 = fnode_normalize_mul_coef((Num)q,a2);
+					return fnode_normalize_add(a1,a2);
+				case '*':
+					return fnode_normalize_mul(a1,a2);
 				case '/':
-					STOQ(-1,q);
-					mone = mkfnode(1,I_FORMULA,q);
-					a2 = mkfnode(3,I_BOP,pwrfs,FA2(f),mone);
-					return mkfnode(3,I_BOP,mulfs,FA1(f),a2);
+					a2 = fnode_normalize_pwr(a2,mone);
+					return fnode_normalize_mul(a1,a2);
+				case '^':
+					return fnode_normalize_pwr(a1,a2);
 				default:
-					return f;
+					return mkfnode(3,I_BOP,FA0(f),a1,a2);
 			}
 			break;
-	
-		default:
-			return f;
-	}
-}
 
-NODE fnode_simplify_monomial(NODE n);
-
-FNODE fnode_normalize_monomial(FNODE f)
-{
-	NODE n;
-
-	f = fnode_apply(f,fnode_normalize_monomial);
-	switch ( f->id ) {
-		case I_PAREN:
-			return FA0(f);
-				
 		case I_NARYOP:
-			switch ( ((ARF)FA0(f))->name[0] ) {
+			switch ( OPNAME(f) ) {
+				case '+':
+					n = (NODE)FA1(f);
+					r = fnode_normalize(BDY(n)); n = NEXT(n);
+					for ( ; n; n = NEXT(n) ) {
+						a1 = fnode_normalize(BDY(n));
+						r = fnode_normalize_add(r,a1);
+					}
+					return r;
 				case '*':
-					n = fnode_simplify_monomial((NODE)FA1(f));
-					if ( !n )
-						return mkfnode(1,I_FORMULA,0);
-					else
-						return mkfnode(2,I_NARYOP,FA0(f),n);
+					n = (NODE)FA1(f);
+					r = fnode_normalize(BDY(n)); n = NEXT(n);
+					for ( ; n; n = NEXT(n) ) {
+						a1 = fnode_normalize(BDY(n));
+						r = fnode_normalize_mul(r,a1);
+					}
+					return r;
 				default:
-					return f;
+					error("fnode_normallize : cannot happen");
 			}
-			break;
-	
+
 		default:
-			return f;
-			break;
+			return fnode_apply(f,fnode_normalize);
 	}
 }
 
@@ -2190,66 +2200,266 @@ FNODE fnode_apply(FNODE f,FNODE (*func)())
 	return r;
 }
 
-NODE fnode_simplify_monomial(NODE n)
+FNODE fnode_normalize_add(FNODE f1,FNODE f2)
 {
-	int l,i,j;
-	FNODE *b;
-	Obj *e;
-	NODE t,r,r1;
-	FNODE f,base;
-	QUOTE q;
-	Obj exp,exp1;
-	Num c,c1;
+	NODE n1,n2,r0,r;
+	FNODE b1,b2;
+	int s;
+	Num c1,c2,c;
 
-	for ( l = 0, t = n; t; t = NEXT(t), l++ );
-	b = (FNODE *)MALLOC(l*sizeof(FNODE));
-	e = (Obj *)MALLOC(l*sizeof(Obj));
-	c = (Num)ONE;
-	for ( i = 0, t = n; t; t = NEXT(t) ) {
-		f = (FNODE)BDY(t);
-		if ( fnode_is_number(f) ) {
-			if ( fnode_is_zero(f) ) return 0;
-			else {
-				mulnum(0,c,(Num)eval(f),&c1); c = c1;
+	if ( fnode_is_zero(f1) ) return f2;
+	else if ( fnode_is_zero(f2) ) return f1;
+	if ( f1->id != I_NARYOP || OPNAME(f1) != '+' ) f1 = to_naryadd(f1);
+	if ( f2->id != I_NARYOP || OPNAME(f2) != '+' ) f2 = to_naryadd(f2);
+	n1 = (NODE)FA1(f1);
+	n2 = (NODE)FA1(f2);
+	r0 = 0;
+	while ( n1 && n2 ) {
+		fnode_coef_body(BDY(n1),&c1,&b1);
+		fnode_coef_body(BDY(n2),&c2,&b2);
+		s = compfnode(b1,b2);
+		if ( s > 0 ) {
+			NEXTNODE(r0,r); BDY(r) = BDY(n1); n1 = NEXT(n1);
+		} else if ( s < 0 ) {
+			NEXTNODE(r0,r); BDY(r) = BDY(n2); n2 = NEXT(n2);
+		} else {
+			addnum(0,c1,c2,&c);
+			if ( c ) {
+				NEXTNODE(r0,r);
+				BDY(r) = UNIQ(c) ? b1 : fnode_normalize_mul_coef(c,b1);
 			}
+			n1 = NEXT(n1); n2 = NEXT(n2);
+		}
+	}
+	if ( n1 )
+		if ( r0 ) NEXT(r) = n1;
+		else r0 = n1;
+	else if ( n2 )
+		if ( r0 ) NEXT(r) = n2;
+		else r0 = n2;
+	else if ( r0 )
+		NEXT(r) = 0;
+
+	if ( !r0 )
+		return mkfnode(1,I_FORMULA,0);
+	else if ( !NEXT(r0) )
+		return BDY(r0);
+	else
+		return mkfnode(2,I_NARYOP,addfs,r0);
+}
+
+FNODE fnode_normalize_mul(FNODE f1,FNODE f2)
+{
+	NODE n1,n2,r0,r,r1;
+	FNODE b1,b2,e1,e2,cc;
+	FNODE *m;
+	int s;
+	Num c1,c2,c,e;
+	int l1,l2,l,i,j;
+
+	if ( fnode_is_zero(f1) || fnode_is_zero(f2) ) return 0;
+
+	if ( f1->id != I_NARYOP || OPNAME(f1) != '*' ) f1 = to_narymul(f1);
+	if ( f2->id != I_NARYOP || OPNAME(f2) != '*' ) f2 = to_narymul(f2);
+	n1 = (NODE)FA1(f1);
+	n2 = (NODE)FA1(f2);
+	if ( fnode_is_number(BDY(n1)) )
+		if ( fnode_is_number(BDY(n2)) ) {
+			mulnum(0,eval(BDY(n1)),eval(BDY(n2)),&c);
+			n1 = NEXT(n1); n2 = NEXT(n2);
 		} else {
-			if ( f->id == I_BOP && ((ARF)FA0(f))->name[0] == '^' ) {
-				base = FA1(f); 
-				exp = (Obj)eval(FA2(f));
+			c = eval(BDY(n1)); n1 = NEXT(n1);
+		}
+	else if ( fnode_is_number(BDY(n2)) ) {
+		c = eval(BDY(n2)); n2 = NEXT(n2);
+	} else
+		c = (Num)ONE;
+	if ( !c ) return mkfnode(1,I_FORMULA,0);
+
+	l1 = length(n1);
+	l2 = length(n2);
+	l = l1+l2;
+	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 )
+			m[i++] = BDY(r);
+		else {
+			fnode_base_exp(m[i-1],&b1,&e1);
+			fnode_base_exp(BDY(r),&b2,&e2);
+			if ( compfnode(b1,b2) ) {
+				for ( j = i-1; j >= 0; j-- ) {
+					MKNODE(r1,m[j],r); r = r1;
+				}
+				cc = mkfnode(1,I_FORMULA,c);
+				MKNODE(r1,cc,r); r = r1;
+				return mkfnode(2,I_NARYOP,mulfs,r);
 			} else {
-				base = f; exp = (Obj)ONE;
-			}
-			if ( i > 0 && !compfnode(b[i-1],base) ) {
-				arf_add(CO,e[i-1],exp,&exp1);
-				if ( !exp1 )
-					i--;
+				addnum(0,eval(e1),eval(e2),&e);
+				if ( !e ) i--;
+				else if ( UNIQ(e) )
+					m[i-1] = b1;
 				else
-					e[i-1] = exp1;
-			} else {
-				b[i] = base;
-				e[i] = exp;
-				i++;
+					m[i-1] = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,e));
 			}
 		}
 	}
-	if ( !i ) {
-		/* coeff only */
-		MKNODE(r,c,0);
-		return r;
-	} else {
+	if ( !i ) return mkfnode(1,I_FORMULA,c);
+	else {
 		r = 0;
 		for ( j = i-1; j >= 0; j-- ) {
-			if ( UNIQ(e[j]) )
-				f = b[j];
+			MKNODE(r1,m[j],r); r = r1;
+		}
+		cc = mkfnode(1,I_FORMULA,c);
+		MKNODE(r1,cc,r); 
+		r = r1;
+		return mkfnode(2,I_NARYOP,mulfs,r);
+	}
+}
+
+FNODE fnode_normalize_pwr(FNODE f1,FNODE f2)
+{
+	FNODE b,b1,e1,e,cc,r;
+	Num c,c1;
+	NODE arg,n;
+
+	if ( fnode_is_zero(f2) ) return mkfnode(1,I_FORMULA,ONE);
+	else if ( fnode_is_zero(f1) ) return mkfnode(1,I_FORMULA,0);
+	else if ( fnode_is_one(f2) ) return f1;
+	else if ( fnode_is_number(f1) )
+		if ( fnode_is_integer(f2) ) {
+			pwrnum(0,(Num)eval(f1),(Num)eval(f2),&c);
+			return mkfnode(1,I_FORMULA,c);
+		} else
+			return mkfnode(3,I_BOP,pwrfs,f1,f2);
+	else if ( f1->id == I_BOP && OPNAME(f1) == '^' ) {
+		b1 = FA1(f1); e1 = FA2(f1);
+		e = fnode_normalize_mul(e1,f2);
+		if ( fnode_is_one(e) )
+			return b1;
+		else
+			return mkfnode(3,I_BOP,FA0(f1),b1,e);
+	} else if ( f1->id == I_NARYOP && OPNAME(f1) == '*' ) {
+		fnode_coef_body(f1,&c1,&b1);
+		if ( fnode_is_integer(f2) ) {
+			pwrnum(0,(Num)c1,(Num)eval(f2),&c);
+			cc = mkfnode(1,I_FORMULA,c);
+			b = fnode_normalize_pwr(b1,f2);
+			if ( fnode_is_one(cc) )
+				return b;
 			else {
-				objtoquote(e[j],&q);
-				f = mkfnode(3,I_BOP,pwrfs,b[j],BDY(q));
+				NEWFNODE(r,2);
+				r->id = I_NARYOP; FA0(r) = mulfs; FA1(r) = mknode(2,cc,b);
+				return r;
 			}
-			MKNODE(r1,f,r); r = r1;
+		} else
+			return mkfnode(3,I_BOP,pwrfs,f1,f2);
+	} else
+		return mkfnode(3,I_BOP,pwrfs,f1,f2);
+}
+
+/* f = b^e */
+void fnode_base_exp(FNODE f,FNODE *bp,FNODE *ep)
+{
+	if ( f->id == I_BOP && OPNAME(f) == '^' ) {
+		*bp = FA1(f); *ep = FA2(f);
+	} else {
+		*bp = f; *ep = mkfnode(1,I_FORMULA,ONE);		
+	}
+}
+
+FNODE to_naryadd(FNODE f)
+{
+	FNODE r;
+	NODE n;
+
+	NEWFNODE(r,2);
+	r->id = I_NARYOP;
+	FA0(r) = addfs;
+	MKNODE(n,f,0);
+	FA1(r) = n;
+	return r;
+}
+
+FNODE to_narymul(FNODE f)
+{
+	FNODE r;
+	NODE n;
+
+	NEWFNODE(r,2);
+	r->id = I_NARYOP;
+	FA0(r) = mulfs;
+	MKNODE(n,f,0);
+	FA1(r) = n;
+	return r;
+}
+
+FNODE fnode_normalize_mul_coef(Num c,FNODE f)
+{
+	FNODE cc;
+	Num c1,c2;
+	NODE n,r0,r;
+
+	if ( !c )
+		return mkfnode(I_FORMULA,0);
+	else if ( UNIQ(c) )
+		return f;
+	else if ( fnode_is_number(f) ) {
+		mulnum(0,c,eval(f),&c1); return mkfnode(1,I_FORMULA,c1);
+	} else if ( f->id == I_NARYOP && OPNAME(f) == '*' ) {
+		cc = (FNODE)BDY((NODE)FA1(f));
+		if ( fnode_is_number(cc) ) {
+			mulnum(0,c,eval(cc),&c2);
+			if ( UNIQ(c2) )
+				n = NEXT((NODE)FA1(f));
+			else {
+				cc = mkfnode(1,I_FORMULA,c2);
+				MKNODE(n,cc,NEXT((NODE)FA1(f)));
+			}
+		} else { 
+			cc = mkfnode(1,I_FORMULA,c);
+			MKNODE(n,cc,(NODE)FA1(f));
 		}
-		f = mkfnode(1,I_FORMULA,c);
-		MKNODE(r1,f,r); r = r1;
-		return r;
+		if ( NEXT(n) )
+			return mkfnode(2,I_NARYOP,FA0(f),n);
+		else
+			return (FNODE)BDY(n);
+	} else if ( f->id == I_NARYOP && OPNAME(f) == '+' ) {
+		for ( r0 = 0, n = (NODE)FA1(f); n; n = NEXT(n) ) {
+			NEXTNODE(r0,r);
+			BDY(r) = fnode_normalize_mul_coef(c,BDY(n));
+		}
+		if ( r0 ) NEXT(r) = 0;
+		return mkfnode(2,I_NARYOP,FA0(f),r0);
+	} else {
+		cc = mkfnode(1,I_FORMULA,c);
+		n = mknode(2,cc,f);
+		return mkfnode(2,I_NARYOP,mulfs,n);
 	}
 }
 
+void fnode_coef_body(FNODE f,Num *cp,FNODE *bp)
+{
+	FNODE c;
+	NODE n;
+
+	if ( fnode_is_number(f) ) {
+		*cp = eval(f); *bp = mkfnode(1,I_FORMULA,ONE);
+	} else if ( f->id == I_NARYOP && OPNAME(f) == '*' ) {
+		c = (FNODE)BDY((NODE)FA1(f));
+		if ( fnode_is_number(c) ) {
+			*cp = eval(c);
+			n = NEXT((NODE)FA1(f));
+			if ( !n )
+				*bp = mkfnode(1,I_FORMULA,ONE);
+			else if ( !NEXT(n) )
+				*bp = BDY(n);
+			else
+				*bp = mkfnode(2,I_NARYOP,FA0(f),n);
+		} else {
+			*cp = (Num)ONE; *bp = f;
+		}
+	} else {
+		*cp = (Num)ONE; *bp = f;
+	}
+}