=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/strobj.c,v retrieving revision 1.116 retrieving revision 1.119 diff -u -p -r1.116 -r1.119 --- OpenXM_contrib2/asir2000/builtin/strobj.c 2006/08/19 05:35:07 1.116 +++ OpenXM_contrib2/asir2000/builtin/strobj.c 2008/09/04 01:42:25 1.119 @@ -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.115 2006/08/09 05:05:28 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.118 2007/04/15 11:01:01 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -105,10 +105,10 @@ 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_deg(), Pnbm_index(); void Pnbm_hp_rest(); void Pnbm_hxky(), Pnbm_xky_rest(); -void Pnbm_hv(), Pnbm_tv(), Pnbm_rest(); +void Pnbm_hv(), Pnbm_tv(), Pnbm_rest(),Pnbm_trest(); void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name(); void Pqt_match(),Pget_quote_id(); @@ -188,12 +188,14 @@ struct ftab str_tab[] = { {"nbp_tc", Pnbp_tc,1}, {"nbp_trest", Pnbp_trest,1}, {"nbm_deg", Pnbm_deg,1}, + {"nbm_index", Pnbm_index,1}, {"nbm_hxky", Pnbm_hxky,1}, {"nbm_xky_rest", Pnbm_xky_rest,1}, {"nbm_hp_rest", Pnbm_hp_rest,1}, {"nbm_hv", Pnbm_hv,1}, {"nbm_tv", Pnbm_tv,1}, {"nbm_rest", Pnbm_rest,1}, + {"nbm_trest", Pnbm_trest,1}, {"qt_to_nary",Pqt_to_nary,1}, {"qt_to_bin",Pqt_to_bin,2}, @@ -468,7 +470,7 @@ int register_conv_func(Obj arg) if ( !arg ) { convfunc = 0; return 1; - } else if ( OID(arg) == O_P && (int)(VR((P)arg))->attr == V_SR ) { + } else if ( OID(arg) == O_P && (long)(VR((P)arg))->attr == V_SR ) { convfunc = (FUNC)(VR((P)arg)->priv); /* f must be a function which takes single argument */ return 1; @@ -847,7 +849,7 @@ void do_assign(NODE arg) for ( t = arg; t; t = NEXT(t) ) { pair = BDY((LIST)BDY(t)); - pv = (int)FA0((FNODE)BDY((QUOTE)BDY(pair))); + pv = (long)FA0((FNODE)BDY((QUOTE)BDY(pair))); value = (QUOTE)(BDY(NEXT(pair))); ASSPV(pv,value); } @@ -1286,6 +1288,7 @@ NODE arg; Obj *rp; { FNODE fnode; + SNODE snode; char *cmd; #if defined(PARI) void recover(int); @@ -1299,8 +1302,13 @@ Obj *rp; # endif #endif cmd = BDY((STRING)ARG0(arg)); +#if 0 exprparse_create_var(0,cmd,&fnode); *rp = eval(fnode); +#else + exprparse_create_var(0,cmd,&snode); + *rp = evalstat(snode); +#endif } void Prtostr(arg,rp) @@ -2534,6 +2542,28 @@ void Pnbm_deg(NODE arg, Q *rp) } } +void Pnbm_index(NODE arg, Q *rp) +{ + NBP p; + NBM m; + unsigned int *b; + int d,i,r; + + p = (NBP)ARG0(arg); + if ( !p ) + STOQ(0,*rp); + else { + m = (NBM)BDY(BDY(p)); + d = m->d; + if ( d > 32 ) + error("nbm_index : weight too large"); + b = m->b; + for ( r = 0, i = d-2; i > 0; i-- ) + if ( !NBM_GET(b,i) ) r |= (1<<(d-2-i)); + STOQ(r,*rp); + } +} + void Pnbm_hp_rest(NODE arg, LIST *rp) { NBP p,h,r; @@ -2606,27 +2636,29 @@ void Pnbm_hv(NODE arg, NBP *rp) separate_nbm((NBM)BDY(BDY(p)),0,rp,0); } +void Pnbm_rest(NODE arg, NBP *rp) +{ + NBP p; + + p = (NBP)ARG0(arg); + if ( !p ) + *rp = 0; + else + separate_nbm((NBM)BDY(BDY(p)),0,0,rp); +} + void Pnbm_tv(NODE arg, NBP *rp) { NBP p; - NBM m,t; - int d; p = (NBP)ARG0(arg); if ( !p ) *rp = 0; - else { - m = (NBM)BDY(BDY(p)); - d = m->d; - if ( !d ) error("nbm_tv : invalid argument"); - NEWNBM(t); NEWNBMBDY(t,1); t->d = 1; t->c = (P)ONE; - if ( NBM_GET(m->b,d-1) ) NBM_SET(t->b,0); - else NBM_CLR(t->b,0); - *rp = (NBP)nbmtonbp(t); - } + else + separate_tail_nbm((NBM)BDY(BDY(p)),0,0,rp); } -void Pnbm_rest(NODE arg, NBP *rp) +void Pnbm_trest(NODE arg, NBP *rp) { NBP p; @@ -2634,7 +2666,7 @@ void Pnbm_rest(NODE arg, NBP *rp) if ( !p ) *rp = 0; else - separate_nbm((NBM)BDY(BDY(p)),0,0,rp); + separate_tail_nbm((NBM)BDY(BDY(p)),0,rp,0); } NBP fnode_to_nbp(FNODE f)