[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.106 and 1.107

version 1.106, 2005/12/10 14:14:15 version 1.107, 2005/12/11 05:27:30
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.105 2005/12/09 08:10:44 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.106 2005/12/10 14:14:15 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
Line 109  void Pnbm_hxky(), Pnbm_xky_rest();
Line 109  void Pnbm_hxky(), Pnbm_xky_rest();
 void Pnbm_hv(), Pnbm_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 Pqt_match(),Pget_quote_id(),Pqt_match_rewrite();  void Pqt_match(),Pget_quote_id();
 void Pqt_to_nary(),Pqt_to_bin();  void Pqt_to_nary(),Pqt_to_bin();
 void fnode_do_assign(NODE arg);  void fnode_do_assign(NODE arg);
 void do_assign(NODE arg);  void do_assign(NODE arg);
Line 137  void fnode_coef_body(FNODE f,Num *cp,FNODE *bp);
Line 137  void fnode_coef_body(FNODE f,Num *cp,FNODE *bp);
 FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNODE a,int mode);  FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNODE a,int mode);
 FNODE fnode_apply(FNODE f,FNODE (*func)(),int expand);  FNODE fnode_apply(FNODE f,FNODE (*func)(),int expand);
 FNODE fnode_normalize(FNODE f,int expand);  FNODE fnode_normalize(FNODE f,int expand);
   FNODE rewrite_fnode(FNODE f,NODE arg,int qarg);
   
 struct ftab str_tab[] = {  struct ftab str_tab[] = {
         {"sprintf",Psprintf,-99999999},          {"sprintf",Psprintf,-99999999},
Line 163  struct ftab str_tab[] = {
Line 164  struct ftab str_tab[] = {
         {"qt_set_ord",Pqt_set_ord,-1},          {"qt_set_ord",Pqt_set_ord,-1},
         {"qt_normalize",Pqt_normalize,-2},          {"qt_normalize",Pqt_normalize,-2},
         {"qt_match",Pqt_match,2},          {"qt_match",Pqt_match,2},
         {"qt_match_rewrite",Pqt_match_rewrite,-4},  
         {"nqt_match_rewrite",Pnqt_match_rewrite,3},          {"nqt_match_rewrite",Pnqt_match_rewrite,3},
   
         {"nqt_comp",Pnqt_comp,2},          {"nqt_comp",Pnqt_comp,2},
Line 710  void Pnqt_match(NODE arg,Q *rp)
Line 710  void Pnqt_match(NODE arg,Q *rp)
                 *rp = 0;                  *rp = 0;
 }  }
   
   
 FNODE rewrite_fnode(FNODE,NODE,int);  
   
 extern Obj VOIDobj;  
   
 void Pqt_match_rewrite(NODE arg,Obj *rp)  
 {  
         FNODE f,g,h,c,value;  
         Obj obj;  
         QUOTE q;  
         NODE r,t,s,s0,pair;  
         int ret,ind,ac;  
   
         obj = (Obj)ARG0(arg);  
         ret = qt_match(obj,(Obj)ARG1(arg),&r);  
         if ( ret ) {  
                 for ( t = r, s0 = 0; t; t = NEXT(t) ) {  
                         NEXTNODE(s0,s);  
                         pair = BDY((LIST)BDY(t));  
                         ind = (int)FA0((FNODE)BDY((QUOTE)BDY(pair)));  
                         value = BDY((QUOTE)(BDY(NEXT(pair))));  
                         BDY(s) = mknode(2,ind,value);  
                 }  
                 if ( s0 ) NEXT(s) = 0;  
                 switch ( ac = argc(arg) ) {  
                         case 3:  
                                 h = rewrite_fnode(BDY((QUOTE)ARG2(arg)),s0,0);  
                                 MKQUOTE(q,h); *rp = (Obj)q;  
                                 break;  
                         case 4:  
                                 c = rewrite_fnode(BDY((QUOTE)ARG2(arg)),s0,0);  
                                 if ( eval(c) ) {  
                                         h = rewrite_fnode(BDY((QUOTE)ARG3(arg)),s0,0);  
                                         MKQUOTE(q,h); *rp = (Obj)q;  
                                 } else  
                                         *rp = VOIDobj;  
                                 break;  
                         default:  
                                 error("qt_match_rewrite : invalid argument");  
                 }  
         } else  
                 *rp = VOIDobj;  
 }  
   
 void Pnqt_match_rewrite(NODE arg,Obj *rp)  void Pnqt_match_rewrite(NODE arg,Obj *rp)
 {  {
         FNODE f,p,c,a,r;          FNODE f,p,c,a,r;
Line 800  FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNO
Line 756  FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNO
         ARF op;          ARF op;
         NODE arg,h0,t,h,valuen;          NODE arg,h0,t,h,valuen;
         NODE r,s0,s,pair;          NODE r,s0,s,pair;
         FNODE any,pany,head,tail,a1;          FNODE any,pany,head,tail,a1,a2;
         QUOTE q;          QUOTE q;
         int ret;          int ret;
         FNODE value;          FNODE value;
Line 841  FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNO
Line 797  FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNO
                 ret = nfnode_match(f,p,&r) && eval(rewrite_fnode(c,r,1));                  ret = nfnode_match(f,p,&r) && eval(rewrite_fnode(c,r,1));
   
         if ( ret ) {          if ( ret ) {
                 a1 = rewrite_fnode(a,r,1);                  a1 = rewrite_fnode(a,r,0);
                 return fnode_normalize(partial_eval(a1),mode);                  a2 = partial_eval(a1);
                   return fnode_normalize(a2,mode);
         } else          } else
                 return 0;                  return 0;
 }  }

Legend:
Removed from v.1.106  
changed lines
  Added in v.1.107

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>