[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.95 and 1.101

version 1.95, 2005/11/03 07:41:22 version 1.101, 2005/11/26 01:28:11
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.94 2005/11/02 10:02:32 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.100 2005/11/25 07:18:31 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
Line 98  void Pquote_normalize();
Line 98  void Pquote_normalize();
 void Pnquote_comp();  void Pnquote_comp();
 void Pnquote_match();  void Pnquote_match();
   
   void Pquote_to_nbp();
   void Pshuffle_mul(), Pharmonic_mul();
   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_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();
 void Pquote_to_nary(),Pquote_to_bin();  void Pquote_to_nary(),Pquote_to_bin();
Line 139  struct ftab str_tab[] = {
Line 143  struct ftab str_tab[] = {
         {"quote_normalize",Pquote_normalize,-2},          {"quote_normalize",Pquote_normalize,-2},
         {"quote_match",Pquote_match,2},          {"quote_match",Pquote_match,2},
         {"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,2},
           {"quote_to_nbp",Pquote_to_nbp,1},
           {"shuffle_mul",Pshuffle_mul,2},
           {"harmonic_mul",Pharmonic_mul,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_nary",Pquote_to_nary,1},
         {"quote_to_bin",Pquote_to_bin,2},          {"quote_to_bin",Pquote_to_bin,2},
   
Line 747  void fnode_do_assign(NODE arg)
Line 762  void fnode_do_assign(NODE arg)
                 pair = (NODE)BDY(t);                  pair = (NODE)BDY(t);
                 pv = (int)BDY(pair);                  pv = (int)BDY(pair);
                 f = (FNODE)(BDY(NEXT(pair)));                  f = (FNODE)(BDY(NEXT(pair)));
                 if ( f->id == I_FUNC ) {                  if ( f->id == I_FUNC_HEAD ) {
                         /* XXX : used for wrapping A_func */                          /* XXX : I_FUNC_HEAD is a dummy id to pass FUNC */
                         MKQUOTEARG(qa,A_func,FA0(f));                          MKQUOTEARG(qa,A_func,FA0(f));
                         value = (QUOTE)qa;                          value = (QUOTE)qa;
                 } else                  } else
Line 2035  void Pquote_normalize(NODE arg,QUOTE *rp)
Line 2050  void Pquote_normalize(NODE arg,QUOTE *rp)
         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);          expand = ac==2 && ARG1(arg);
         if ( !q || OID(q) != O_QUOTE ) {          if ( !q || OID(q) != O_QUOTE )
                 *rp = q;                  *rp = q;
                 return;  
         } else if ( q->normalized && (q->expanded || !expand) )  
                 *rp = q;  
         else {          else {
                 f = fnode_normalize(BDY(q),expand);                  f = fnode_normalize(BDY(q),expand);
                 MKQUOTE(r,f);                  MKQUOTE(r,f);
                 r->normalized = 1;  
                 if ( expand ) r->expanded = 1;  
                 *rp = r;                  *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(NODE arg,NBP *rp)
   {
           NBP p1,p2;
   
           p1 = (NBP)ARG0(arg);
           p2 = (NBP)ARG1(arg);
           shuffle_mulnbp(CO,p1,p2,rp);
   }
   
   void Pharmonic_mul(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;
           }
   }
   
 void Pnquote_comp(NODE arg,Q *rp)  void Pnquote_comp(NODE arg,Q *rp)
 {  {
         QUOTE q1,q2;          QUOTE q1,q2;
Line 2057  void Pnquote_comp(NODE arg,Q *rp)
Line 2266  void Pnquote_comp(NODE arg,Q *rp)
   
         q1 = (QUOTE)ARG0(arg); f1 = (FNODE)BDY(q1);          q1 = (QUOTE)ARG0(arg); f1 = (FNODE)BDY(q1);
         q2 = (QUOTE)ARG1(arg); f2 = (FNODE)BDY(q2);          q2 = (QUOTE)ARG1(arg); f2 = (FNODE)BDY(q2);
         if ( !q1->normalized ) f1 = fnode_normalize(f1,0);          f1 = fnode_normalize(f1,0);
         if ( !q2->normalized ) f2 = fnode_normalize(f2,0);          f2 = fnode_normalize(f2,0);
         r = nfnode_comp(f1,f2);          r = nfnode_comp(f1,f2);
         STOQ(r,*rp);          STOQ(r,*rp);
 }  }
Line 2794  int nfnode_match(FNODE f,FNODE pat,NODE *rp)
Line 3003  int nfnode_match(FNODE f,FNODE pat,NODE *rp)
         NODE m,m1,m2,base,exp,fa,pa,n;          NODE m,m1,m2,base,exp,fa,pa,n;
         LIST l;          LIST l;
         QUOTE qp,qf;          QUOTE qp,qf;
         FNODE fbase,fexp,a;          FNODE fbase,fexp,a,fh;
         FUNC ff,pf;          FUNC ff,pf;
         int r;          int r;
   
           if ( !pat )
                   if ( !f ) {
                           *rp = 0;
                           return 1;
                   } else
                           return 0;
           else if ( !f )
                   return 0;
         switch ( pat->id ) {          switch ( pat->id ) {
                 case I_PVAR:                  case I_PVAR:
                         /* [[pat,f]] */                          /* [[pat,f]] */
Line 2836  int nfnode_match(FNODE f,FNODE pat,NODE *rp)
Line 3053  int nfnode_match(FNODE f,FNODE pat,NODE *rp)
                                 if ( strcmp(ff->fullname,pf->fullname) ) return 0;                                  if ( strcmp(ff->fullname,pf->fullname) ) return 0;
                                 m = 0;                                  m = 0;
                         } else {                          } else {
                                 /* XXX only FA0(f) is used */                                  /* XXX : I_FUNC_HEAD is a dummy id to pass FUNC */
                                 m = mknode(1,mknode(2,FA0((FNODE)FA0(pat)),f),0);                                  fh = mkfnode(1,I_FUNC_HEAD,FA0(f));
                                   m = mknode(1,mknode(2,FA0((FNODE)FA0(pat)),fh),0);
                         }                          }
                         /* FA1(f) and FA1(pat) are I_LIST */                          /* FA1(f) and FA1(pat) are I_LIST */
                         fa = (NODE)FA0((FNODE)FA1(f));                          fa = (NODE)FA0((FNODE)FA1(f));
Line 2900  FNODE fnode_left_narymul(FNODE p,int i)
Line 3118  FNODE fnode_left_narymul(FNODE p,int i)
         a = (NODE)FA1(p);          a = (NODE)FA1(p);
         l = length(a);          l = length(a);
         if ( i < 0 || i >= l ) error("fnode_left_narymul : invalid index");          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 if ( i == 1 ) return (FNODE)BDY(a);
         else {          else {
                 for ( r0 = 0, k = 0, t = a; k < i; k++, t = NEXT(t) ) {                  for ( r0 = 0, k = 0, t = a; k < i; k++, t = NEXT(t) ) {
Line 2921  FNODE fnode_right_narymul(FNODE p,int i)
Line 3139  FNODE fnode_right_narymul(FNODE p,int i)
         a = (NODE)FA1(p);          a = (NODE)FA1(p);
         l = length(a);          l = length(a);
         if ( i < 0 || i >= l ) error("fnode_right_narymul : invalid index");          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 {          else {
                 for ( k = 0, t = a; k <= i; k++, t = NEXT(t) );                  for ( k = 0, t = a; k <= i; k++, t = NEXT(t) );
                 return fnode_node_to_narymul(t);                  return fnode_node_to_narymul(t);
Line 3018  int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)
Line 3236  int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)
                         pright = fnode_right_narymul(p,pi);                          pright = fnode_right_narymul(p,pi);
                         /* XXX : incomplete */                          /* XXX : incomplete */
                         for ( s = fa, fi = 0; s; s = NEXT(s), fi++ ) {                          for ( s = fa, fi = 0; s; s = NEXT(s), fi++ ) {
                                   if ( fi < pi ) continue;
                                 if ( nfnode_match(BDY(s),pivot,&m) ) {                                  if ( nfnode_match(BDY(s),pivot,&m) ) {
                                         fleft = fnode_left_narymul(f,fi);                                          fleft = fnode_left_narymul(f,fi);
                                         pleft1 = rewrite_fnode(pleft,m);                                          pleft1 = rewrite_fnode(pleft,m);
Legend:
Removed from v.1.95  
changed lines
  Added in v.1.101
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>