[BACK]Return to strobj.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/strobj.c between version 1.100 and 1.104

version 1.100, 2005/11/25 07:18:31 version 1.104, 2005/11/30 05:08:00
Line 45 
Line 45 
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *   *
  * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.99 2005/11/24 08:16:03 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.103 2005/11/30 04:51:46 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
Line 99  void Pnquote_comp();
Line 99  void Pnquote_comp();
 void Pnquote_match();  void Pnquote_match();
   
 void Pquote_to_nbp();  void Pquote_to_nbp();
 void Pshuffle_mul_nbp(), Pharmonic_mul_nbp();  void Pshuffle_mul(), Pharmonic_mul();
 void Pnbp_hm(), Pnbp_ht(), Pnbp_hc(), Pnbp_rest(), Pnbm_hp(), Pnbm_rest();  void Pnbp_hm(), Pnbp_ht(), Pnbp_hc(), Pnbp_rest();
   void Pnbm_deg();
   void Pnbm_hp_rest();
   void Pnbm_hxky(), Pnbm_xky_rest();
   void Pnbm_hv(), Pnbm_rest();
   
 void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name();  void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name();
 void Pquote_match(),Pget_quote_id(),Pquote_match_rewrite();  void Pquote_match(),Pget_quote_id(),Pquote_match_rewrite();
Line 145  struct ftab str_tab[] = {
Line 149  struct ftab str_tab[] = {
         {"quote_match_rewrite",Pquote_match_rewrite,-4},          {"quote_match_rewrite",Pquote_match_rewrite,-4},
   
         {"nquote_comp",Pnquote_comp,2},          {"nquote_comp",Pnquote_comp,2},
         {"nquote_match",Pnquote_match,2},          {"nquote_match",Pnquote_match,-3},
         {"quote_to_nbp",Pquote_to_nbp,1},          {"quote_to_nbp",Pquote_to_nbp,1},
         {"shuffle_mul_nbp",Pshuffle_mul_nbp,2},          {"shuffle_mul",Pshuffle_mul,2},
         {"harmonic_mul_nbp",Pharmonic_mul_nbp,2},          {"harmonic_mul",Pharmonic_mul,2},
   
         {"nbp_hm", Pnbp_hm,1},          {"nbp_hm", Pnbp_hm,1},
         {"nbp_ht", Pnbp_ht,1},          {"nbp_ht", Pnbp_ht,1},
         {"nbp_hc", Pnbp_hc,1},          {"nbp_hc", Pnbp_hc,1},
         {"nbp_rest", Pnbp_rest,1},          {"nbp_rest", Pnbp_rest,1},
         {"nbm_hp", Pnbm_hp,1},          {"nbm_deg", Pnbm_deg,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_rest", Pnbm_rest,1},          {"nbm_rest", Pnbm_rest,1},
   
         {"quote_to_nary",Pquote_to_nary,1},          {"quote_to_nary",Pquote_to_nary,1},
Line 678  void Pnquote_match(NODE arg,Q *rp)
Line 686  void Pnquote_match(NODE arg,Q *rp)
         QUOTE fq,pq;          QUOTE fq,pq;
         FNODE f,p;          FNODE f,p;
         int ret;          int ret;
           Q mode;
         NODE r;          NODE r;
   
         fq = (QUOTE)ARG0(arg); Pquote_normalize(mknode(2,fq,0),&fq); f = (FNODE)BDY(fq);          mode = argc(arg)==3 ? (Q)ARG2(arg) : 0;
         pq = (QUOTE)ARG1(arg); Pquote_normalize(mknode(2,pq,0),&pq); p = (FNODE)BDY(pq);          fq = (QUOTE)ARG0(arg); Pquote_normalize(mknode(2,fq,mode),&fq); f = (FNODE)BDY(fq);
           pq = (QUOTE)ARG1(arg); Pquote_normalize(mknode(2,pq,mode),&pq); p = (FNODE)BDY(pq);
         ret = nfnode_match(f,p,&r);          ret = nfnode_match(f,p,&r);
         if ( ret ) {          if ( ret ) {
                 fnode_do_assign(r);                  fnode_do_assign(r);
Line 690  void Pnquote_match(NODE arg,Q *rp)
Line 700  void Pnquote_match(NODE arg,Q *rp)
                 *rp = 0;                  *rp = 0;
 }  }
   
   
 FNODE rewrite_fnode(FNODE,NODE);  FNODE rewrite_fnode(FNODE,NODE);
   
 extern Obj VOIDobj;  extern Obj VOIDobj;
Line 2049  void Pquote_normalize(NODE arg,QUOTE *rp)
Line 2060  void Pquote_normalize(NODE arg,QUOTE *rp)
         ac = argc(arg);          ac = argc(arg);
         if ( !ac ) error("quote_normalize : invalid argument");          if ( !ac ) error("quote_normalize : invalid argument");
         q = (QUOTE)ARG0(arg);          q = (QUOTE)ARG0(arg);
         expand = ac==2 && ARG1(arg);          if ( ac == 2 )
                   expand = QTOS((Q)ARG1(arg));
         if ( !q || OID(q) != O_QUOTE )          if ( !q || OID(q) != O_QUOTE )
                 *rp = q;                  *rp = q;
         else {          else {
Line 2071  void Pquote_to_nbp(NODE arg,NBP *rp)
Line 2083  void Pquote_to_nbp(NODE arg,NBP *rp)
         *rp = fnode_to_nbp(f);          *rp = fnode_to_nbp(f);
 }  }
   
 void Pshuffle_mul_nbp(NODE arg,NBP *rp)  void Pshuffle_mul(NODE arg,NBP *rp)
 {  {
         NBP p1,p2;          NBP p1,p2;
   
Line 2080  void Pshuffle_mul_nbp(NODE arg,NBP *rp)
Line 2092  void Pshuffle_mul_nbp(NODE arg,NBP *rp)
         shuffle_mulnbp(CO,p1,p2,rp);          shuffle_mulnbp(CO,p1,p2,rp);
 }  }
   
 void Pharmonic_mul_nbp(NODE arg,NBP *rp)  void Pharmonic_mul(NODE arg,NBP *rp)
 {  {
         NBP p1,p2;          NBP p1,p2;
   
Line 2149  void Pnbp_rest(NODE arg, NBP *rp)
Line 2161  void Pnbp_rest(NODE arg, NBP *rp)
         }          }
 }  }
   
 void Pnbm_hp(NODE arg, LIST *rp)  void Pnbm_deg(NODE arg, Q *rp)
 {  {
         NBP p;          NBP p;
         NBM m;          NBM m;
         int d,i,xy;  
         int *b;          p = (NBP)ARG0(arg);
         Q qxy,qi;          if ( !p )
                   STOQ(-1,*rp);
           else {
                   m = (NBM)BDY(BDY(p));
                   STOQ(m->d,*rp);
           }
   }
   
   void Pnbm_hp_rest(NODE arg, LIST *rp)
   {
           NBP p,h,r;
           NBM m,m1;
         NODE n;          NODE n;
           int *b,*b1;
           int d,d1,v,i,j,k;
   
         p = (NBP)ARG0(arg);          p = (NBP)ARG0(arg);
         if ( !p ) {          if ( !p )
                 MKLIST(*rp,0);                  MKLIST(*rp,0);
         } else {          else {
                 m = (NBM)BDY(BDY(p));                  m = (NBM)BDY(BDY(p));
                 b = m->b;                  b = m->b; d = m->d;
                 d = m->d;  
                 if ( !d )                  if ( !d )
                         MKLIST(*rp,0);                          MKLIST(*rp,0);
                 else {                  else {
                         xy = NBM_GET(b,0);                          v = NBM_GET(b,0);
                         for ( i = 1; i < d; i++ )                          for ( i = 1; i < d; i++ )
                                 if ( NBM_GET(b,i) != xy ) break;                                  if ( NBM_GET(b,i) != v ) break;
                         STOQ(xy,qxy);                          NEWNBM(m1); NEWNBMBDY(m1,i);
                         STOQ(i,qi);                          b1 = m1->b; m1->d = i; m1->c = ONE;
                         n = mknode(2,qxy,qi);                          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;
                           for ( j = 0, k = i; j < d1; j++, k++ )
                                   if ( NBM_GET(b,k) ) NBM_SET(b1,j);
                                   else NBM_CLR(b1,j);
                           MKNODE(n,m1,0); MKNBP(r,n);
                           n = mknode(2,h,r);
                         MKLIST(*rp,n);                          MKLIST(*rp,n);
                 }                  }
         }          }
 }  }
   
 void Pnbm_rest(NODE arg,NBP *rp)  void Pnbm_hxky(NODE arg, LIST *rp)
 {  {
         NBP p;          NBP p;
         NBM m,m1;  
         int d,xy,i,d1,i1;  
         int *b,*b1;  
         NODE n;  
   
         p = (NBP)ARG0(arg);          p = (NBP)ARG0(arg);
         if ( !p )          if ( !p )
                 *rp = 0;                  *rp = 0;
         else {          else
                 m = (NBM)BDY(BDY(p));                  separate_xky_nbm((NBM)BDY(BDY(p)),0,rp,0);
                 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);  
                 }  
         }  
 }  }
   
   void Pnbm_xky_rest(NODE arg,NBP *rp)
   {
           NBP p;
   
           p = (NBP)ARG0(arg);
           if ( !p )
                   *rp = 0;
           else
                   separate_xky_nbm((NBM)BDY(BDY(p)),0,0,rp);
   }
   
   void Pnbm_hv(NODE arg, NBP *rp)
   {
           NBP p;
   
           p = (NBP)ARG0(arg);
           if ( !p )
                   *rp = 0;
           else
                   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);
   }
   
 NBP fnode_to_nbp(FNODE f)  NBP fnode_to_nbp(FNODE f)
 {  {
         Q r;          Q r;
Line 2420  FNODE nfnode_add(FNODE a1,FNODE a2,int expand);
Line 2464  FNODE nfnode_add(FNODE a1,FNODE a2,int expand);
 FNODE nfnode_mul(FNODE a1,FNODE a2,int expand);  FNODE nfnode_mul(FNODE a1,FNODE a2,int expand);
 FNODE nfnode_pwr(FNODE a1,FNODE a2,int expand);  FNODE nfnode_pwr(FNODE a1,FNODE a2,int expand);
 FNODE nfnode_mul_coef(Num c,FNODE f,int expand);  FNODE nfnode_mul_coef(Num c,FNODE f,int expand);
 FNODE fnode_expand_pwr(FNODE f,int n);  FNODE fnode_expand_pwr(FNODE f,int n,int expand);
 FNODE to_narymul(FNODE f);  FNODE to_narymul(FNODE f);
 FNODE to_naryadd(FNODE f);  FNODE to_naryadd(FNODE f);
 FNODE fnode_node_to_naryadd(NODE n);  FNODE fnode_node_to_naryadd(NODE n);
Line 2435  FNODE fnode_normalize(FNODE f,int expand)
Line 2479  FNODE fnode_normalize(FNODE f,int expand)
         NODE n;          NODE n;
         Q q;          Q q;
   
         if ( f->normalized && (f->expanded || !expand) ) return f;          if ( f->normalized && (f->expanded == expand) ) return f;
         STOQ(-1,q);          STOQ(-1,q);
         mone = mkfnode(1,I_FORMULA,q);          mone = mkfnode(1,I_FORMULA,q);
         switch ( f->id ) {          switch ( f->id ) {
Line 2633  FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)
Line 2677  FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)
         m = (FNODE *)ALLOCA(l*sizeof(FNODE));          m = (FNODE *)ALLOCA(l*sizeof(FNODE));
         for ( r = n1, i = 0; i < l1; r = NEXT(r), i++ ) m[i] = BDY(r);          for ( r = n1, i = 0; i < l1; r = NEXT(r), i++ ) m[i] = BDY(r);
         for ( r = n2; r; r = NEXT(r) ) {          for ( r = n2; r; r = NEXT(r) ) {
                 if ( i == 0 )                  if ( i == 0 || (expand == 2) )
                         m[i++] = BDY(r);                          m[i++] = BDY(r);
                 else {                  else {
                         fnode_base_exp(m[i-1],&b1,&e1); fnode_base_exp(BDY(r),&b2,&e2);                          fnode_base_exp(m[i-1],&b1,&e1); fnode_base_exp(BDY(r),&b2,&e2);
Line 2689  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
Line 2733  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
                 ee = QTOS((Q)nf2);                  ee = QTOS((Q)nf2);
                 cc = mkfnode(1,I_FORMULA,c);                  cc = mkfnode(1,I_FORMULA,c);
                 if ( fnode_is_nonnegative_integer(f2) )                  if ( fnode_is_nonnegative_integer(f2) )
                         b = fnode_expand_pwr(b1,ee);                          b = fnode_expand_pwr(b1,ee,expand);
                 else {                  else {
                         STOQ(-1,q);                          STOQ(-1,q);
                         mone = mkfnode(1,I_FORMULA,q);                          mone = mkfnode(1,I_FORMULA,q);
Line 2699  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
Line 2743  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
                                 MKNODE(t1,inv,t0); t0 = t1;                                  MKNODE(t1,inv,t0); t0 = t1;
                         }                          }
                         b1 = fnode_node_to_narymul(t0);                          b1 = fnode_node_to_narymul(t0);
                         b = fnode_expand_pwr(b1,-ee);                          b = fnode_expand_pwr(b1,-ee,expand);
                 }                  }
                 if ( fnode_is_one(cc) )                  if ( fnode_is_one(cc) )
                         return b;                          return b;
Line 2709  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
Line 2753  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
                         && fnode_is_nonnegative_integer(f2) ) {                          && fnode_is_nonnegative_integer(f2) ) {
                 q = (Q)eval(f2);                  q = (Q)eval(f2);
                 if ( PL(NM(q)) > 1 ) error("nfnode_pwr : exponent too large");                  if ( PL(NM(q)) > 1 ) error("nfnode_pwr : exponent too large");
                 return fnode_expand_pwr(f1,QTOS(q));                  return fnode_expand_pwr(f1,QTOS(q),expand);
         } else          } else
                 return mkfnode(3,I_BOP,pwrfs,f1,f2);                  return mkfnode(3,I_BOP,pwrfs,f1,f2);
 }  }
   
 FNODE fnode_expand_pwr(FNODE f,int n)  FNODE fnode_expand_pwr(FNODE f,int n,int expand)
 {  {
         int n1;          int n1,i;
         FNODE f1,f2;          FNODE f1,f2,fn;
           Q q;
   
         if ( !n ) return mkfnode(1,I_FORMULA,ONE);          if ( !n ) return mkfnode(1,I_FORMULA,ONE);
         else if ( IS_ZERO(f) ) return mkfnode(1,I_FORMULA,0);          else if ( IS_ZERO(f) ) return mkfnode(1,I_FORMULA,0);
         else if ( n == 1 ) return f;          else if ( n == 1 ) return f;
         else {          else {
                 n1 = n/2;                  switch ( expand ) {
                 f1 = fnode_expand_pwr(f,n1);                          case 1:
                 f2 = nfnode_mul(f1,f1,1);                                  n1 = n/2;
                 if ( n%2 ) f2 = nfnode_mul(f2,f,1);                                  f1 = fnode_expand_pwr(f,n1,expand);
                 return f2;                                  f2 = nfnode_mul(f1,f1,expand);
                                   if ( n%2 ) f2 = nfnode_mul(f2,f,1);
                                   return f2;
                           case 2:
                                   for ( i = 1, f1 = f; i < n; i++ )
                                           f1 = nfnode_mul(f1,f,expand);
                                   return f1;
                           case 0: default:
                                   STOQ(n,q);
                                   fn = mkfnode(1,I_FORMULA,q);
                                   return mkfnode(3,I_BOP,pwrfs,f,fn);
                   }
         }          }
 }  }
   
Line 3018  int nfnode_match(FNODE f,FNODE pat,NODE *rp)
Line 3074  int nfnode_match(FNODE f,FNODE pat,NODE *rp)
         switch ( pat->id ) {          switch ( pat->id ) {
                 case I_PVAR:                  case I_PVAR:
                         /* [[pat,f]] */                          /* [[pat,f]] */
                         *rp = mknode(1,mknode(2,(int)FA0(pat),f),0);                          *rp = mknode(1,mknode(2,(int)FA0(pat),f));
                         return 1;                          return 1;
   
                 case I_FORMULA:                  case I_FORMULA:
Legend:
Removed from v.1.100  
changed lines
  Added in v.1.104
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>