===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/strobj.c,v
retrieving revision 1.97
retrieving revision 1.100
diff -u -p -r1.97 -r1.100
--- OpenXM_contrib2/asir2000/builtin/strobj.c	2005/11/06 01:27:28	1.97
+++ OpenXM_contrib2/asir2000/builtin/strobj.c	2005/11/25 07:18:31	1.100
@@ -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.96 2005/11/04 07:03:38 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.99 2005/11/24 08:16:03 noro Exp $
 */
 #include "ca.h"
 #include "parse.h"
@@ -98,6 +98,10 @@ void Pquote_normalize();
 void Pnquote_comp();
 void Pnquote_match();
 
+void Pquote_to_nbp();
+void Pshuffle_mul_nbp(), Pharmonic_mul_nbp();
+void Pnbp_hm(), Pnbp_ht(), Pnbp_hc(), Pnbp_rest(), Pnbm_hp(), Pnbm_rest();
+
 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,9 +143,20 @@ 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},
 
+	{"nbp_hm", Pnbp_hm,1},
+	{"nbp_ht", Pnbp_ht,1},
+	{"nbp_hc", Pnbp_hc,1},
+	{"nbp_rest", Pnbp_rest,1},
+	{"nbm_hp", Pnbm_hp,1},
+	{"nbm_rest", Pnbm_rest,1},
+
 	{"quote_to_nary",Pquote_to_nary,1},
 	{"quote_to_bin",Pquote_to_bin,2},
 
@@ -2041,6 +2056,205 @@ void Pquote_normalize(NODE arg,QUOTE *rp)
 		f = fnode_normalize(BDY(q),expand);
 		MKQUOTE(r,f);
 		*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);
+}
+
+void Pnbp_hm(NODE arg, NBP *rp)
+{
+	NBP p;
+	NODE n;
+	NBM m;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) *rp = 0;
+	else {
+		m = (NBM)BDY(BDY(p));
+		MKNODE(n,m,0);
+		MKNBP(*rp,n);
+	}
+}
+	
+void Pnbp_ht(NODE arg, NBP *rp)
+{
+	NBP p;
+	NODE n;
+	NBM m,m1;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) *rp = 0;
+	else {
+		m = (NBM)BDY(BDY(p));
+		NEWNBM(m1);
+		m1->d = m->d; m1->c = ONE; m1->b = m->b;
+		MKNODE(n,m1,0);
+		MKNBP(*rp,n);
+	}
+}
+
+void Pnbp_hc(NODE arg, Q *rp)
+{
+	NBP p;
+	NBM m;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) *rp = 0;
+	else {
+		m = (NBM)BDY(BDY(p));
+		*rp = m->c;
+	}
+}
+
+void Pnbp_rest(NODE arg, NBP *rp)
+{
+	NBP p;
+	NODE n;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) *rp = 0;
+	else {
+		n = BDY(p);
+		if ( !NEXT(n) ) *rp = 0;
+		else
+			MKNBP(*rp,NEXT(n));
+	}
+}
+
+void Pnbm_hp(NODE arg, LIST *rp)
+{
+	NBP p;
+	NBM m;
+	int d,i,xy;
+	int *b;
+	Q qxy,qi;
+	NODE n;
+
+	p = (NBP)ARG0(arg);
+	if ( !p ) {
+		MKLIST(*rp,0);
+	} else {
+		m = (NBM)BDY(BDY(p));
+		b = m->b;
+		d = m->d;
+		if ( !d )
+			MKLIST(*rp,0);
+		else {
+			xy = NBM_GET(b,0);
+			for ( i = 1; i < d; i++ )
+				if ( NBM_GET(b,i) != xy ) break;
+			STOQ(xy,qxy);
+			STOQ(i,qi);
+			n = mknode(2,qxy,qi);	
+			MKLIST(*rp,n);
+		}
+	}
+}
+
+void Pnbm_rest(NODE arg,NBP *rp)
+{
+	NBP p;
+	NBM m,m1;
+	int d,xy,i,d1,i1;
+	int *b,*b1;
+	NODE n;
+
+	p = (NBP)ARG0(arg);
+	if ( !p )
+		*rp = 0;
+	else {
+		m = (NBM)BDY(BDY(p));
+		b = m->b;
+		d = m->d;
+		if ( !d )
+			*rp = p;
+		else {
+			xy = NBM_GET(b,0);
+			for ( i = 1; i < d; i++ )
+				if ( NBM_GET(b,i) != xy ) break;
+			d1 = d-i;
+			NEWNBM(m1);
+			m1->d = d1; m1->c = m->c;
+			NEWNBMBDY(m1,d1);
+			b1 = m1->b;
+			for ( i1 = 0; i < d; i++, i1++ )
+				if ( NBM_GET(b,i) ) NBM_SET(b1,i1);
+				else NBM_CLR(b1,i1);
+			MKNODE(n,m1,0);
+			MKNBP(*rp,n);
+		}
+	}
+}
+
+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;
 	}
 }