===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/strobj.c,v
retrieving revision 1.96
retrieving revision 1.99
diff -u -p -r1.96 -r1.99
--- OpenXM_contrib2/asir2000/builtin/strobj.c	2005/11/04 07:03:38	1.96
+++ OpenXM_contrib2/asir2000/builtin/strobj.c	2005/11/24 08:16:03	1.99
@@ -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.95 2005/11/03 07:41:22 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.98 2005/11/16 23:42:53 noro Exp $
 */
 #include "ca.h"
 #include "parse.h"
@@ -98,6 +98,9 @@ void Pquote_normalize();
 void Pnquote_comp();
 void Pnquote_match();
 
+void Pquote_to_nbp();
+void Pshuffle_mul_nbp(), Pharmonic_mul_nbp();
+
 void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name();
 void Pquote_match(),Pget_quote_id(),Pquote_match_rewrite();
 void Pquote_to_nary(),Pquote_to_bin();
@@ -139,8 +142,12 @@ struct ftab str_tab[] = {
 	{"quote_normalize",Pquote_normalize,-2},
 	{"quote_match",Pquote_match,2},
 	{"quote_match_rewrite",Pquote_match_rewrite,-4},
+
 	{"nquote_comp",Pnquote_comp,2},
 	{"nquote_match",Pnquote_match,2},
+	{"quote_to_nbp",Pquote_to_nbp,1},
+	{"shuffle_mul_nbp",Pshuffle_mul_nbp,2},
+	{"harmonic_mul_nbp",Pharmonic_mul_nbp,2},
 
 	{"quote_to_nary",Pquote_to_nary,1},
 	{"quote_to_bin",Pquote_to_bin,2},
@@ -2035,20 +2042,90 @@ void Pquote_normalize(NODE arg,QUOTE *rp)
 	if ( !ac ) error("quote_normalize : invalid argument");
 	q = (QUOTE)ARG0(arg);
 	expand = ac==2 && ARG1(arg);
-	if ( !q || OID(q) != O_QUOTE ) {
+	if ( !q || OID(q) != O_QUOTE )
 		*rp = q;
-		return;
-	} else if ( q->normalized && (q->expanded || !expand) )
-		*rp = q;
 	else {
 		f = fnode_normalize(BDY(q),expand);
 		MKQUOTE(r,f);
-		r->normalized = 1;
-		if ( expand ) r->expanded = 1;
 		*rp = r;
 	}
 }
 
+NBP fnode_to_nbp(FNODE f);
+
+void Pquote_to_nbp(NODE arg,NBP *rp)
+{
+	QUOTE q;
+	FNODE f;
+
+	q = (QUOTE)ARG0(arg); f = (FNODE)BDY(q);
+	f = fnode_normalize(f,0);
+	*rp = fnode_to_nbp(f);
+}
+
+void Pshuffle_mul_nbp(NODE arg,NBP *rp)
+{
+	NBP p1,p2;
+
+	p1 = (NBP)ARG0(arg);
+	p2 = (NBP)ARG1(arg);
+	shuffle_mulnbp(CO,p1,p2,rp);
+}
+
+void Pharmonic_mul_nbp(NODE arg,NBP *rp)
+{
+	NBP p1,p2;
+
+	p1 = (NBP)ARG0(arg);
+	p2 = (NBP)ARG1(arg);
+	harmonic_mulnbp(CO,p1,p2,rp);
+}
+
+
+NBP fnode_to_nbp(FNODE f)
+{
+	Q r;
+	int n,i;
+	NBM m;
+	V v;
+	NBP u,u1,u2;
+	NODE t,b;
+
+	if ( f->id == I_FORMULA ) {
+		r = eval(f);
+		NEWNBM(m);
+		if ( OID(r) == O_N ) {
+			m->d = 0; m->c = (Q)r; m->b = 0;
+		} else {
+			v = VR((P)r);
+			m->d = 1; m->c = ONE; NEWNBMBDY(m,1);
+			if ( !strcmp(NAME(v),"x") ) NBM_SET(m->b,0);
+			else NBM_CLR(m->b,0);
+		}
+		MKNODE(b,m,0); MKNBP(u,b);
+		return u;
+	} else if ( IS_NARYADD(f) ) {
+		t = (NODE)FA1(f); u = fnode_to_nbp((FNODE)BDY(t));
+		for ( t = NEXT(t); t; t = NEXT(t) ) {
+			u1 = fnode_to_nbp((FNODE)BDY(t));
+			addnbp(CO,u,u1,&u2); u = u2;
+		}
+		return u;
+	} else if ( IS_NARYMUL(f) ) {
+		t = (NODE)FA1(f); u = fnode_to_nbp((FNODE)BDY(t));
+		for ( t = NEXT(t); t; t = NEXT(t) ) {
+			u1 = fnode_to_nbp((FNODE)BDY(t));
+			mulnbp(CO,u,u1,&u2); u = u2;
+		}
+		return u;
+	} else if ( IS_BINARYPWR(f) ) {
+		u = fnode_to_nbp((FNODE)FA1(f));
+		r = eval((FNODE)FA2(f));
+		pwrnbp(CO,u,r,&u1);
+		return u1;
+	}
+}
+
 void Pnquote_comp(NODE arg,Q *rp)
 {
 	QUOTE q1,q2;
@@ -2057,8 +2134,8 @@ void Pnquote_comp(NODE arg,Q *rp)
 
 	q1 = (QUOTE)ARG0(arg); f1 = (FNODE)BDY(q1);
 	q2 = (QUOTE)ARG1(arg); f2 = (FNODE)BDY(q2);
-	if ( !q1->normalized ) f1 = fnode_normalize(f1,0);
-	if ( !q2->normalized ) f2 = fnode_normalize(f2,0);
+	f1 = fnode_normalize(f1,0);
+	f2 = fnode_normalize(f2,0);
 	r = nfnode_comp(f1,f2);
 	STOQ(r,*rp);
 }
@@ -2798,6 +2875,14 @@ int nfnode_match(FNODE f,FNODE pat,NODE *rp)
 	FUNC ff,pf;
 	int r;
 
+	if ( !pat )
+		if ( !f ) {
+			*rp = 0;
+			return 1;
+		} else
+			return 0;
+	else if ( !f )
+		return 0;
 	switch ( pat->id ) {
 		case I_PVAR:
 			/* [[pat,f]] */
@@ -2901,7 +2986,7 @@ FNODE fnode_left_narymul(FNODE p,int i)
 	a = (NODE)FA1(p);
 	l = length(a);
 	if ( i < 0 || i >= l ) error("fnode_left_narymul : invalid index");
-	if ( i == 0 ) return mkfnode(1,I_FORMULA,ONE);
+	if ( i == 0 ) return 0;
 	else if ( i == 1 ) return (FNODE)BDY(a);
 	else {
 		for ( r0 = 0, k = 0, t = a; k < i; k++, t = NEXT(t) ) {
@@ -2922,7 +3007,7 @@ FNODE fnode_right_narymul(FNODE p,int i)
 	a = (NODE)FA1(p);
 	l = length(a);
 	if ( i < 0 || i >= l ) error("fnode_right_narymul : invalid index");
-	if ( i == l-1 ) return mkfnode(1,I_FORMULA,ONE);
+	if ( i == l-1 ) return 0;
 	else {
 		for ( k = 0, t = a; k <= i; k++, t = NEXT(t) );
 		return fnode_node_to_narymul(t);
@@ -3019,6 +3104,7 @@ int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)
 			pright = fnode_right_narymul(p,pi);
 			/* XXX : incomplete */
 			for ( s = fa, fi = 0; s; s = NEXT(s), fi++ ) {
+				if ( fi < pi ) continue;
 				if ( nfnode_match(BDY(s),pivot,&m) ) {
 					fleft = fnode_left_narymul(f,fi);
 					pleft1 = rewrite_fnode(pleft,m);