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

Diff for /OpenXM_contrib2/asir2018/builtin/strobj.c between version 1.1 and 1.4

version 1.1, 2018/09/19 05:45:06 version 1.4, 2021/03/25 05:06:06
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: OpenXM_contrib2/asir2018/builtin/strobj.c,v 1.3 2020/10/06 06:31:19 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
Line 427  int register_symbol_table(Obj arg)
Line 427  int register_symbol_table(Obj arg)
 int register_dp_vars_origin(Obj arg)  int register_dp_vars_origin(Obj arg)
 {  {
   if ( INT(arg) ) {    if ( INT(arg) ) {
     dp_vars_origin = QTOS((Q)arg);      dp_vars_origin = ZTOS((Q)arg);
     return 1;      return 1;
   } else return 0;    } else return 0;
 }  }
Line 435  int register_dp_vars_origin(Obj arg)
Line 435  int register_dp_vars_origin(Obj arg)
 int register_dp_dvars_origin(Obj arg)  int register_dp_dvars_origin(Obj arg)
 {  {
   if ( INT(arg) ) {    if ( INT(arg) ) {
     dp_dvars_origin = QTOS((Q)arg);      dp_dvars_origin = ZTOS((Q)arg);
     return 1;      return 1;
   } else return 0;    } else return 0;
 }  }
Line 443  int register_dp_dvars_origin(Obj arg)
Line 443  int register_dp_dvars_origin(Obj arg)
 int register_dp_vars_hweyl(Obj arg)  int register_dp_vars_hweyl(Obj arg)
 {  {
   if ( INT(arg) ) {    if ( INT(arg) ) {
     dp_vars_hweyl = QTOS((Q)arg);      dp_vars_hweyl = ZTOS((Q)arg);
     return 1;      return 1;
   } else return 0;    } else return 0;
 }  }
Line 451  int register_dp_vars_hweyl(Obj arg)
Line 451  int register_dp_vars_hweyl(Obj arg)
 int register_show_lt(Obj arg)  int register_show_lt(Obj arg)
 {  {
   if ( INT(arg) ) {    if ( INT(arg) ) {
     show_lt = QTOS((Q)arg);      show_lt = ZTOS((Q)arg);
     return 1;      return 1;
   } else return 0;    } else return 0;
 }  }
Line 459  int register_show_lt(Obj arg)
Line 459  int register_show_lt(Obj arg)
 int register_conv_rule(Obj arg)  int register_conv_rule(Obj arg)
 {  {
   if ( INT(arg) ) {    if ( INT(arg) ) {
     conv_flag = QTOS((Q)arg);      conv_flag = ZTOS((Q)arg);
     convfunc = 0;      convfunc = 0;
     return 1;      return 1;
   } else return 0;    } else return 0;
Line 615  void Pqt_to_bin(NODE arg,QUOTE *rp)
Line 615  void Pqt_to_bin(NODE arg,QUOTE *rp)
   FNODE f;    FNODE f;
   int direction;    int direction;
   
   direction = QTOS((Q)ARG1(arg));    direction = ZTOS((Q)ARG1(arg));
   f = fnode_to_bin(BDY((QUOTE)ARG0(arg)),direction);    f = fnode_to_bin(BDY((QUOTE)ARG0(arg)),direction);
   
   MKQUOTE(*rp,f);    MKQUOTE(*rp,f);
Line 629  void Pqt_is_var(NODE arg,Z *rp)
Line 629  void Pqt_is_var(NODE arg,Z *rp)
   q = (QUOTE)ARG0(arg);    q = (QUOTE)ARG0(arg);
   asir_assert(q,O_QUOTE,"qt_is_var");    asir_assert(q,O_QUOTE,"qt_is_var");
   ret = fnode_is_var(BDY(q));    ret = fnode_is_var(BDY(q));
   STOQ(ret,*rp);    STOZ(ret,*rp);
 }  }
   
 void Pqt_is_coef(NODE arg,Z *rp)  void Pqt_is_coef(NODE arg,Z *rp)
Line 640  void Pqt_is_coef(NODE arg,Z *rp)
Line 640  void Pqt_is_coef(NODE arg,Z *rp)
   q = (QUOTE)ARG0(arg);    q = (QUOTE)ARG0(arg);
   asir_assert(q,O_QUOTE,"qt_is_coef");    asir_assert(q,O_QUOTE,"qt_is_coef");
   ret = fnode_is_coef(BDY(q));    ret = fnode_is_coef(BDY(q));
   STOQ(ret,*rp);    STOZ(ret,*rp);
 }  }
   
 void Pqt_is_number(NODE arg,Z *rp)  void Pqt_is_number(NODE arg,Z *rp)
Line 651  void Pqt_is_number(NODE arg,Z *rp)
Line 651  void Pqt_is_number(NODE arg,Z *rp)
   q = (QUOTE)ARG0(arg);    q = (QUOTE)ARG0(arg);
   asir_assert(q,O_QUOTE,"qt_is_number");    asir_assert(q,O_QUOTE,"qt_is_number");
   ret = fnode_is_number(BDY(q));    ret = fnode_is_number(BDY(q));
   STOQ(ret,*rp);    STOZ(ret,*rp);
 }  }
   
 void Pqt_is_rational(NODE arg,Z *rp)  void Pqt_is_rational(NODE arg,Z *rp)
Line 662  void Pqt_is_rational(NODE arg,Z *rp)
Line 662  void Pqt_is_rational(NODE arg,Z *rp)
   q = (QUOTE)ARG0(arg);    q = (QUOTE)ARG0(arg);
   asir_assert(q,O_QUOTE,"qt_is_rational");    asir_assert(q,O_QUOTE,"qt_is_rational");
   ret = fnode_is_rational(BDY(q));    ret = fnode_is_rational(BDY(q));
   STOQ(ret,*rp);    STOZ(ret,*rp);
 }  }
   
 void Pqt_is_integer(NODE arg,Z *rp)  void Pqt_is_integer(NODE arg,Z *rp)
Line 673  void Pqt_is_integer(NODE arg,Z *rp)
Line 673  void Pqt_is_integer(NODE arg,Z *rp)
   q = (QUOTE)ARG0(arg);    q = (QUOTE)ARG0(arg);
   asir_assert(q,O_QUOTE,"qt_is_integer");    asir_assert(q,O_QUOTE,"qt_is_integer");
   ret = fnode_is_integer(BDY(q));    ret = fnode_is_integer(BDY(q));
   STOQ(ret,*rp);    STOZ(ret,*rp);
 }  }
   
 void Pqt_is_function(NODE arg,Z *rp)  void Pqt_is_function(NODE arg,Z *rp)
Line 687  void Pqt_is_function(NODE arg,Z *rp)
Line 687  void Pqt_is_function(NODE arg,Z *rp)
     ret = 1;      ret = 1;
   else    else
     ret = 0;      ret = 0;
   STOQ(ret,*rp);    STOZ(ret,*rp);
 }  }
   
 void Pqt_is_dependent(NODE arg,Z *rp)  void Pqt_is_dependent(NODE arg,Z *rp)
Line 706  void Pqt_is_dependent(NODE arg,Z *rp)
Line 706  void Pqt_is_dependent(NODE arg,Z *rp)
     *rp = 0;      *rp = 0;
   var = VR(x);    var = VR(x);
   ret = fnode_is_dependent(BDY(q),var);    ret = fnode_is_dependent(BDY(q),var);
   STOQ(ret,*rp);    STOZ(ret,*rp);
 }  }
   
   
Line 774  void Pnqt_match_rewrite(NODE arg,Obj *rp)
Line 774  void Pnqt_match_rewrite(NODE arg,Obj *rp)
   if ( OID(cond) == O_QUOTE ) c = BDY((QUOTE)cond);    if ( OID(cond) == O_QUOTE ) c = BDY((QUOTE)cond);
   else c = mkfnode(1,I_FORMULA,ONE);    else c = mkfnode(1,I_FORMULA,ONE);
   
   m = QTOS(mode);    m = ZTOS(mode);
   r = nfnode_match_rewrite(f,p,c,a,m);    r = nfnode_match_rewrite(f,p,c,a,m);
   if ( r ) {    if ( r ) {
     MKQUOTE(q,r);      MKQUOTE(q,r);
Line 880  void fnode_do_assign(NODE arg)
Line 880  void fnode_do_assign(NODE arg)
 }  }
   
 /*  /*
 /* consistency check and merge   * consistency check and merge
  */   */
   
 int merge_matching_node(NODE n,NODE a,NODE *rp)  int merge_matching_node(NODE n,NODE a,NODE *rp)
Line 953  int qt_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp) {
Line 953  int qt_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp) {
   }    }
   /* matching of the rest */    /* matching of the rest */
   MKLIST(list,tf);    MKLIST(list,tf);
   STOQ(I_LIST,id); a = mknode(2,id,list);    STOZ(I_LIST,id); a = mknode(2,id,list);
   MKLIST(alist,a);    MKLIST(alist,a);
   arg = mknode(1,alist);    arg = mknode(1,alist);
   Pfunargs_to_quote(arg,&q);    Pfunargs_to_quote(arg,&q);
Line 971  void get_quote_id_arg(QUOTE f,int *id,NODE *r)
Line 971  void get_quote_id_arg(QUOTE f,int *id,NODE *r)
   NODE arg,fab;    NODE arg,fab;
   
   arg = mknode(1,f); Pquote_to_funargs(arg,&fa); fab = BDY((LIST)fa);    arg = mknode(1,f); Pquote_to_funargs(arg,&fa); fab = BDY((LIST)fa);
   *id = QTOS((Q)BDY(fab)); *r = NEXT(fab);    *id = ZTOS((Q)BDY(fab)); *r = NEXT(fab);
 }  }
   
 /* *rp : [[quote(A),quote(1)],...] */  /* *rp : [[quote(A),quote(1)],...] */
Line 1080  int qt_match(Obj f, Obj pat, NODE *rp)
Line 1080  int qt_match(Obj f, Obj pat, NODE *rp)
         return qt_match_node(farg,parg,rp);          return qt_match_node(farg,parg,rp);
     }      }
   }    }
     /* XXX */
     return 0;
 }  }
   
 void Pquotetotex(NODE arg,STRING *rp)  void Pquotetotex(NODE arg,STRING *rp)
Line 1170  Z *rp;
Line 1172  Z *rp;
     for ( r = i = 0; i < tb->next; i++ )      for ( r = i = 0; i < tb->next; i++ )
       r += strlen(tb->body[i]);        r += strlen(tb->body[i]);
   }    }
   STOQ(r,*rp);    STOZ(r,*rp);
 }  }
   
 void Pstr_chr(arg,rp)  void Pstr_chr(arg,rp)
Line 1189  Z *rp;
Line 1191  Z *rp;
   asir_assert(start,O_N,"str_chr");    asir_assert(start,O_N,"str_chr");
   asir_assert(terminator,O_STR,"str_chr");    asir_assert(terminator,O_STR,"str_chr");
   p = BDY(str);    p = BDY(str);
   spos = QTOS(start);    spos = ZTOS(start);
   chr = BDY(terminator)[0];    chr = BDY(terminator)[0];
   if ( spos > (int)strlen(p) )    if ( spos > (int)strlen(p) )
     r = -1;      r = -1;
Line 1200  Z *rp;
Line 1202  Z *rp;
     else      else
       r = -1;        r = -1;
   }    }
   STOQ(r,*rp);    STOZ(r,*rp);
 }  }
   
 void Psub_str(arg,rp)  void Psub_str(arg,rp)
Line 1219  STRING *rp;
Line 1221  STRING *rp;
   asir_assert(head,O_N,"sub_str");    asir_assert(head,O_N,"sub_str");
   asir_assert(tail,O_N,"sub_str");    asir_assert(tail,O_N,"sub_str");
   p = BDY(str);    p = BDY(str);
   spos = QTOS(head);    spos = ZTOS(head);
   epos = QTOS(tail);    epos = ZTOS(tail);
   len = strlen(p);    len = strlen(p);
   if ( (spos >= len) || (epos < spos) ) {    if ( (spos >= len) || (epos < spos) ) {
     *rp = 0; return;      *rp = 0; return;
Line 1239  NODE arg;
Line 1241  NODE arg;
 LIST *rp;  LIST *rp;
 {  {
   STRING str;    STRING str;
   unsigned char *p;    char *p;
   int len,i;    int len,i;
   NODE n,n1;    NODE n,n1;
   Z q;    Z q;
Line 1249  LIST *rp;
Line 1251  LIST *rp;
   p = BDY(str);    p = BDY(str);
   len = strlen(p);    len = strlen(p);
   for ( i = len-1, n = 0; i >= 0; i-- ) {    for ( i = len-1, n = 0; i >= 0; i-- ) {
     UTOQ((unsigned int)p[i],q);      UTOZ((unsigned int)p[i],q);
     MKNODE(n1,q,n);      MKNODE(n1,q,n);
     n = n1;      n = n1;
   }    }
Line 1274  STRING *rp;
Line 1276  STRING *rp;
   for ( i = 0; i < len; i++, n = NEXT(n) ) {    for ( i = 0; i < len; i++, n = NEXT(n) ) {
     q = (Z)BDY(n);      q = (Z)BDY(n);
     asir_assert(q,O_N,"asciitostr");      asir_assert(q,O_N,"asciitostr");
     j = QTOS(q);      j = ZTOS(q);
     if ( j >= 256 || j <= 0 )      if ( j >= 256 || j <= 0 )
       error("asciitostr : argument out of range");        error("asciitostr : argument out of range");
     p[i] = j;      p[i] = j;
Line 1677  void fnodetotex_tb(FNODE f,TB tb)
Line 1679  void fnodetotex_tb(FNODE f,TB tb)
           fnodetotex_tb((FNODE)FA1(f),tb);            fnodetotex_tb((FNODE)FA1(f),tb);
           write_tb(")",tb);            write_tb(")",tb);
           return;            return;
           default:
             return;
       }        }
       break;        break;
   
Line 1829  void fnodetotex_tb(FNODE f,TB tb)
Line 1833  void fnodetotex_tb(FNODE f,TB tb)
   
     default:      default:
       error("fnodetotex_tb : not implemented yet");        error("fnodetotex_tb : not implemented yet");
         return;
   }    }
 }  }
   
Line 1962  void Psprintf(NODE arg,STRING *rp)
Line 1967  void Psprintf(NODE arg,STRING *rp)
     if (argc < n) {      if (argc < n) {
         error("sprintf: invalid argument");          error("sprintf: invalid argument");
     }      }
     r = (char *)MALLOC_ATOMIC(len);      r = (char *)MALLOC_ATOMIC(len+1);
     for(node = NEXT(arg), t = r; *s; s++) {      for(node = NEXT(arg), t = r; *s; s++) {
         if (*s=='%' && *(s+1)=='a') {          if (*s=='%' && *(s+1)=='a') {
             strcpy(t,objtostr(BDY(node)));              strcpy(t,objtostr(BDY(node)));
Line 2098  void Pget_quote_id(NODE arg,Z *rp)
Line 2103  void Pget_quote_id(NODE arg,Z *rp)
   if ( !q || OID(q) != O_QUOTE )    if ( !q || OID(q) != O_QUOTE )
     error("get_quote_id : invalid argument");      error("get_quote_id : invalid argument");
   f = BDY(q);    f = BDY(q);
   STOQ((long)f->id,*rp);    STOZ((long)f->id,*rp);
 }  }
   
 void Pquote_to_funargs(NODE arg,LIST *rp)  void Pquote_to_funargs(NODE arg,LIST *rp)
Line 2126  void Pquote_to_funargs(NODE arg,LIST *rp)
Line 2131  void Pquote_to_funargs(NODE arg,LIST *rp)
   if ( !spec )    if ( !spec )
     error("quote_to_funargs : not supported yet");      error("quote_to_funargs : not supported yet");
   t0 = 0;    t0 = 0;
   STOQ((int)f->id,id);    STOZ((int)f->id,id);
   NEXTNODE(t0,t);    NEXTNODE(t0,t);
   BDY(t) = (pointer)id;    BDY(t) = (pointer)id;
   for ( i = 0; spec->type[i] != A_end; i++ ) {    for ( i = 0; spec->type[i] != A_end; i++ ) {
Line 2137  void Pquote_to_funargs(NODE arg,LIST *rp)
Line 2142  void Pquote_to_funargs(NODE arg,LIST *rp)
         BDY(t) = (pointer)r;          BDY(t) = (pointer)r;
         break;          break;
       case A_int:        case A_int:
         STOQ((long)f->arg[i],a);          STOZ((long)f->arg[i],a);
         BDY(t) = (pointer)a;          BDY(t) = (pointer)a;
         break;          break;
       case A_str:        case A_str:
Line 2186  void Pfunargs_to_quote(NODE arg,QUOTE *rp)
Line 2191  void Pfunargs_to_quote(NODE arg,QUOTE *rp)
   if ( !l || OID(l) != O_LIST || !(t=BDY(l)) )    if ( !l || OID(l) != O_LIST || !(t=BDY(l)) )
     error("funargs_to_quote : invalid argument");      error("funargs_to_quote : invalid argument");
   t = BDY(l);    t = BDY(l);
   id = (fid)QTOS((Q)BDY(t)); t = NEXT(t);    id = (fid)ZTOS((Q)BDY(t)); t = NEXT(t);
   get_fid_spec(id,&spec);    get_fid_spec(id,&spec);
   if ( !spec )    if ( !spec )
     error("funargs_to_quote : not supported yet");      error("funargs_to_quote : not supported yet");
Line 2206  void Pfunargs_to_quote(NODE arg,QUOTE *rp)
Line 2211  void Pfunargs_to_quote(NODE arg,QUOTE *rp)
       case A_int:        case A_int:
         if ( !INT(a) )          if ( !INT(a) )
           error("funargs_to_quote : invalid argument");            error("funargs_to_quote : invalid argument");
         f->arg[i] = (pointer)QTOS((Q)a);          f->arg[i] = (pointer)ZTOS((Q)a);
         break;          break;
       case A_str:        case A_str:
         if ( !a || OID(a) != O_STR )          if ( !a || OID(a) != O_STR )
Line 2319  void Pqt_set_weight(NODE arg,LIST *rp)
Line 2324  void Pqt_set_weight(NODE arg,LIST *rp)
     for ( i = 0; i < l; i++, n = NEXT(n) ) {      for ( i = 0; i < l; i++, n = NEXT(n) ) {
       pair = BDY((LIST)BDY(n));        pair = BDY((LIST)BDY(n));
       tab[i].v = VR((P)ARG0(pair));        tab[i].v = VR((P)ARG0(pair));
       tab[i].w = QTOS((Q)ARG1(pair));        tab[i].w = ZTOS((Q)ARG1(pair));
     }      }
     tab[i].v = 0;      tab[i].v = 0;
     qt_current_weight_obj = (LIST)ARG0(arg);      qt_current_weight_obj = (LIST)ARG0(arg);
Line 2364  void Pqt_normalize(NODE arg,QUOTE *rp)
Line 2369  void Pqt_normalize(NODE arg,QUOTE *rp)
   if ( !ac ) error("qt_normalize : invalid argument");    if ( !ac ) error("qt_normalize : invalid argument");
   q = (QUOTE)ARG0(arg);    q = (QUOTE)ARG0(arg);
   if ( ac == 2 )    if ( ac == 2 )
     expand = QTOS((Q)ARG1(arg));      expand = ZTOS((Q)ARG1(arg));
   if ( !q || OID(q) != O_QUOTE )    if ( !q || OID(q) != O_QUOTE )
     *rp = q;      *rp = q;
   else {    else {
Line 2541  void Pnbm_deg(NODE arg, Z *rp)
Line 2546  void Pnbm_deg(NODE arg, Z *rp)
   
   p = (NBP)ARG0(arg);    p = (NBP)ARG0(arg);
   if ( !p )    if ( !p )
     STOQ(-1,*rp);      STOZ(-1,*rp);
   else {    else {
     m = (NBM)BDY(BDY(p));      m = (NBM)BDY(BDY(p));
     STOQ(m->d,*rp);      STOZ(m->d,*rp);
   }    }
 }  }
   
Line 2557  void Pnbm_index(NODE arg, Z *rp)
Line 2562  void Pnbm_index(NODE arg, Z *rp)
   
   p = (NBP)ARG0(arg);    p = (NBP)ARG0(arg);
   if ( !p )    if ( !p )
     STOQ(0,*rp);      STOZ(0,*rp);
   else {    else {
     m = (NBM)BDY(BDY(p));      m = (NBM)BDY(BDY(p));
     d = m->d;      d = m->d;
Line 2566  void Pnbm_index(NODE arg, Z *rp)
Line 2571  void Pnbm_index(NODE arg, Z *rp)
     b = m->b;      b = m->b;
     for ( r = 0, i = d-2; i > 0; i-- )      for ( r = 0, i = d-2; i > 0; i-- )
       if ( !NBM_GET(b,i) ) r |= (1<<(d-2-i));        if ( !NBM_GET(b,i) ) r |= (1<<(d-2-i));
     STOQ(r,*rp);      STOZ(r,*rp);
   }    }
 }  }
   
Line 2583  void Pnbm_hp_rest(NODE arg, LIST *rp)
Line 2588  void Pnbm_hp_rest(NODE arg, LIST *rp)
     MKLIST(*rp,0);      MKLIST(*rp,0);
   else {    else {
     m = (NBM)BDY(BDY(p));      m = (NBM)BDY(BDY(p));
     b = m->b; d = m->d;      b = (int *)m->b; d = m->d;
     if ( !d )      if ( !d )
       MKLIST(*rp,0);        MKLIST(*rp,0);
     else {      else {
Line 2591  void Pnbm_hp_rest(NODE arg, LIST *rp)
Line 2596  void Pnbm_hp_rest(NODE arg, LIST *rp)
       for ( i = 1; i < d; i++ )        for ( i = 1; i < d; i++ )
         if ( NBM_GET(b,i) != v ) break;          if ( NBM_GET(b,i) != v ) break;
       NEWNBM(m1); NEWNBMBDY(m1,i);        NEWNBM(m1); NEWNBMBDY(m1,i);
       b1 = m1->b; m1->d = i; m1->c = (P)ONE;        b1 = (int *)m1->b; m1->d = i; m1->c = (P)ONE;
       if ( v ) for ( j = 0; j < i; j++ ) NBM_SET(b1,j);        if ( v ) for ( j = 0; j < i; j++ ) NBM_SET(b1,j);
       else for ( j = 0; j < i; j++ ) NBM_CLR(b1,j);        else for ( j = 0; j < i; j++ ) NBM_CLR(b1,j);
       MKNODE(n,m1,0); MKNBP(h,n);        MKNODE(n,m1,0); MKNBP(h,n);
   
       d1 = d-i;        d1 = d-i;
       NEWNBM(m1); NEWNBMBDY(m1,d1);        NEWNBM(m1); NEWNBMBDY(m1,d1);
       b1 = m1->b; m1->d = d1; m1->c = (P)ONE;        b1 = (int *)m1->b; m1->d = d1; m1->c = (P)ONE;
       for ( j = 0, k = i; j < d1; j++, k++ )        for ( j = 0, k = i; j < d1; j++, k++ )
         if ( NBM_GET(b,k) ) NBM_SET(b1,j);          if ( NBM_GET(b,k) ) NBM_SET(b1,j);
         else NBM_CLR(b1,j);          else NBM_CLR(b1,j);
Line 2717  NBP fnode_to_nbp(FNODE f)
Line 2722  NBP fnode_to_nbp(FNODE f)
     pwrnbp(CO,u,r,&u1);      pwrnbp(CO,u,r,&u1);
     return u1;      return u1;
   }    }
     /* XXX */
     return 0;
 }  }
   
 void Pnqt_weight(NODE arg,Z *rp)  void Pnqt_weight(NODE arg,Z *rp)
Line 2728  void Pnqt_weight(NODE arg,Z *rp)
Line 2735  void Pnqt_weight(NODE arg,Z *rp)
   q = (QUOTE)ARG0(arg); f = (FNODE)BDY(q);    q = (QUOTE)ARG0(arg); f = (FNODE)BDY(q);
   f = fnode_normalize(f,0);    f = fnode_normalize(f,0);
   w = nfnode_weight(qt_weight_tab,f);    w = nfnode_weight(qt_weight_tab,f);
   STOQ(w,*rp);    STOZ(w,*rp);
 }  }
   
 void Pnqt_comp(NODE arg,Z *rp)  void Pnqt_comp(NODE arg,Z *rp)
Line 2742  void Pnqt_comp(NODE arg,Z *rp)
Line 2749  void Pnqt_comp(NODE arg,Z *rp)
   f1 = fnode_normalize(f1,0);    f1 = fnode_normalize(f1,0);
   f2 = fnode_normalize(f2,0);    f2 = fnode_normalize(f2,0);
   r = nfnode_comp(f1,f2);    r = nfnode_comp(f1,f2);
   STOQ(r,*rp);    STOZ(r,*rp);
 }  }
   
 int fnode_is_var(FNODE f)  int fnode_is_var(FNODE f)
Line 2957  FNODE fnode_normalize(FNODE f,int expand)
Line 2964  FNODE fnode_normalize(FNODE f,int expand)
   Z q;    Z q;
   
   if ( f->normalized && (f->expanded == expand) ) return f;    if ( f->normalized && (f->expanded == expand) ) return f;
   STOQ(-1,q);    STOZ(-1,q);
   mone = mkfnode(1,I_FORMULA,q);    mone = mkfnode(1,I_FORMULA,q);
   switch ( f->id ) {    switch ( f->id ) {
     case I_PAREN:      case I_PAREN:
Line 3217  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
Line 3224  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
     fnode_coef_body(f1,&c1,&b1);      fnode_coef_body(f1,&c1,&b1);
     nf2 = (Num)eval(f2);      nf2 = (Num)eval(f2);
     arf_pwr(CO,c1,(Obj)nf2,&c);      arf_pwr(CO,c1,(Obj)nf2,&c);
     ee = QTOS((Q)nf2);      ee = ZTOS((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,expand);        b = fnode_expand_pwr(b1,ee,expand);
     else {      else {
       STOQ(-1,q);        STOZ(-1,q);
       mone = mkfnode(1,I_FORMULA,q);        mone = mkfnode(1,I_FORMULA,q);
       b1 = to_narymul(b1);        b1 = to_narymul(b1);
       for ( t0 = 0, n = (NODE)FA1(b1); n; n = NEXT(n) ) {        for ( t0 = 0, n = (NODE)FA1(b1); n; n = NEXT(n) ) {
Line 3240  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
Line 3247  FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)
       && fnode_is_nonnegative_integer(f2) ) {        && fnode_is_nonnegative_integer(f2) ) {
     q = (Z)eval(f2);      q = (Z)eval(f2);
     if ( !smallz(q) ) error("nfnode_pwr : exponent too large");      if ( !smallz(q) ) error("nfnode_pwr : exponent too large");
     return fnode_expand_pwr(f1,QTOS(q),expand);      return fnode_expand_pwr(f1,ZTOS(q),expand);
   } else    } else
     return mkfnode(3,I_BOP,pwrfs,f1,f2);      return mkfnode(3,I_BOP,pwrfs,f1,f2);
 }  }
Line 3267  FNODE fnode_expand_pwr(FNODE f,int n,int expand)
Line 3274  FNODE fnode_expand_pwr(FNODE f,int n,int expand)
           f1 = nfnode_mul(f1,f,expand);            f1 = nfnode_mul(f1,f,expand);
         return f1;          return f1;
       case 0: default:        case 0: default:
         STOQ(n,q);          STOZ(n,q);
         fn = mkfnode(1,I_FORMULA,q);          fn = mkfnode(1,I_FORMULA,q);
         return mkfnode(3,I_BOP,pwrfs,f,fn);          return mkfnode(3,I_BOP,pwrfs,f,fn);
     }      }
Line 3341  FNODE nfnode_mul_coef(Obj c,FNODE f,int expand)
Line 3348  FNODE nfnode_mul_coef(Obj c,FNODE f,int expand)
         return fnode_node_to_nary(mulfs,mknode(2,cc,b1));          return fnode_node_to_nary(mulfs,mknode(2,cc,b1));
     }      }
   }    }
     /* XXX */
     return 0;
 }  }
   
 void fnode_coef_body(FNODE f,Obj *cp,FNODE *bp)  void fnode_coef_body(FNODE f,Obj *cp,FNODE *bp)
Line 3408  int nfnode_weight(struct wtab *tab,FNODE f)
Line 3417  int nfnode_weight(struct wtab *tab,FNODE f)
       /* XXX w(2^x)=0 ? */        /* XXX w(2^x)=0 ? */
       if ( fnode_is_rational(FA2(f)) ) {        if ( fnode_is_rational(FA2(f)) ) {
         a2 = (Q)eval(FA2(f));          a2 = (Q)eval(FA2(f));
         w = QTOS(a2);          w = ZTOS(a2);
       } else        } else
         w = nfnode_weight(tab,FA2(f));          w = nfnode_weight(tab,FA2(f));
       return nfnode_weight(tab,FA1(f))*w;        return nfnode_weight(tab,FA1(f))*w;
     default:      default:
       error("nfnode_weight : not_implemented");        error("nfnode_weight : not_implemented");
         return 0;
   }    }
 }  }
   
Line 3470  int nfnode_comp_lex(FNODE f1,FNODE f2)
Line 3480  int nfnode_comp_lex(FNODE f1,FNODE f2)
   if ( IS_BINARYPWR(f1) || IS_BINARYPWR(f2) ) {    if ( IS_BINARYPWR(f1) || IS_BINARYPWR(f2) ) {
     fnode_base_exp(f1,&b1,&e1);      fnode_base_exp(f1,&b1,&e1);
     fnode_base_exp(f2,&b2,&e2);      fnode_base_exp(f2,&b2,&e2);
     if ( r = nfnode_comp_lex(b1,b2) ) {      if ( ( r = nfnode_comp_lex(b1,b2) ) != 0 ) {
       if ( r > 0 )        if ( r > 0 )
         return nfnode_comp_lex(e1,mkfnode(1,I_FORMULA,NULLP));          return nfnode_comp_lex(e1,mkfnode(1,I_FORMULA,NULLP));
       else if ( r < 0 )        else if ( r < 0 )
Line 3506  int nfnode_comp_lex(FNODE f1,FNODE f2)
Line 3516  int nfnode_comp_lex(FNODE f1,FNODE f2)
             /* compare args */              /* compare args */
             n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2));              n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2));
             while ( n1 && n2 )              while ( n1 && n2 )
               if ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) return r;                if ( ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) != 0 ) return r;
               else {                else {
                 n1 = NEXT(n1); n2 = NEXT(n2);                  n1 = NEXT(n1); n2 = NEXT(n2);
               }                }
Line 3544  int nfnode_comp_lex(FNODE f1,FNODE f2)
Line 3554  int nfnode_comp_lex(FNODE f1,FNODE f2)
             /* compare args */              /* compare args */
             n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2));              n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2));
             while ( n1 && n2 )              while ( n1 && n2 )
               if ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) return r;                if ( ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) != 0 ) return r;
               else {                else {
                 n1 = NEXT(n1); n2 = NEXT(n2);                  n1 = NEXT(n1); n2 = NEXT(n2);
               }                }
Line 3554  int nfnode_comp_lex(FNODE f1,FNODE f2)
Line 3564  int nfnode_comp_lex(FNODE f1,FNODE f2)
   
         default:          default:
           error("nfnode_comp_lex : undefined");            error("nfnode_comp_lex : undefined");
             return 0;
       }        }
       break;        break;
     default:      default:
       error("nfnode_comp_lex : undefined");        error("nfnode_comp_lex : undefined");
         return 0;
   }    }
     return 0;
 }  }
   
 NODE append_node(NODE a1,NODE a2)  NODE append_node(NODE a1,NODE a2)
Line 3661  int nfnode_match(FNODE f,FNODE pat,NODE *rp)
Line 3674  int nfnode_match(FNODE f,FNODE pat,NODE *rp)
   
     default:      default:
       error("nfnode_match : invalid pattern");        error("nfnode_match : invalid pattern");
         return 0;
   }    }
     return 0;
 }  }
   
 /* remove i-th element */  /* remove i-th element */
Line 3684  FNODE fnode_removeith_naryadd(FNODE p,int i)
Line 3699  FNODE fnode_removeith_naryadd(FNODE p,int i)
     NEXT(r) = NEXT(t);      NEXT(r) = NEXT(t);
     return fnode_node_to_nary(addfs,r0);      return fnode_node_to_nary(addfs,r0);
   }    }
     /* XXX */
     return 0;
 }  }
   
 /* a0,...,a(i-1) */  /* a0,...,a(i-1) */
Line 3883  NODE nfnode_pvars(FNODE pat,NODE found)
Line 3899  NODE nfnode_pvars(FNODE pat,NODE found)
   
     default:      default:
       error("nfnode_match : invalid pattern");        error("nfnode_match : invalid pattern");
         return 0;
   }    }
 }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>