[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.67 and 1.68

version 1.67, 2005/10/03 00:06:40 version 1.68, 2005/10/05 07:38:08
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.66 2005/09/30 02:20:06 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.67 2005/10/03 00:06:40 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
Line 78  void Pquotetotex();
Line 78  void Pquotetotex();
 void Pquotetotex_env();  void Pquotetotex_env();
 void Pflatten_quote();  void Pflatten_quote();
 void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name();  void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name();
 void Pquote_unify(),Pget_quote_id();  void Pquote_unify(),Pget_quote_id(),Pquote_match_rewrite();
 void Pquote_to_nary(),Pquote_to_bin();  void Pquote_to_nary(),Pquote_to_bin();
 void do_assign(NODE arg);  void do_assign(NODE arg);
 void fnodetotex_tb(FNODE f,TB tb);  void fnodetotex_tb(FNODE f,TB tb);
Line 115  struct ftab str_tab[] = {
Line 115  struct ftab str_tab[] = {
         {"flatten_quote",Pflatten_quote,-2},          {"flatten_quote",Pflatten_quote,-2},
         {"quote_to_funargs",Pquote_to_funargs,1},          {"quote_to_funargs",Pquote_to_funargs,1},
         {"quote_unify",Pquote_unify,2},          {"quote_unify",Pquote_unify,2},
           {"quote_match_rewrite",Pquote_match_rewrite,-4},
         {"funargs_to_quote",Pfunargs_to_quote,1},          {"funargs_to_quote",Pfunargs_to_quote,1},
         {"get_function_name",Pget_function_name,1},          {"get_function_name",Pget_function_name,1},
         {0,0,0},          {0,0,0},
Line 554  void Pquote_unify(NODE arg,Q *rp)
Line 555  void Pquote_unify(NODE arg,Q *rp)
                 *rp = ONE;                  *rp = ONE;
         } else          } else
                 *rp = 0;                  *rp = 0;
   }
   
   FNODE rewrite_fnode(FNODE,NODE);
   
   extern Obj VOIDobj;
   
   void Pquote_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 = quote_unify(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 = mkfnode(1,I_FORMULA,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);
                                   *rp = eval(h);
                                   break;
                           case 4:
                                   c = rewrite_fnode(BDY((QUOTE)ARG2(arg)),s0);
                                   if ( eval(c) ) {
                                           h = rewrite_fnode(BDY((QUOTE)ARG3(arg)),s0);
                                           *rp = eval(h);
                                   } else
                                           *rp = VOIDobj;
                                   break;
                           default:
                                   error("quote_match_rewrite : invalid argument");
                   }
           } else
                   *rp = VOIDobj;
 }  }
   
 void do_assign(NODE arg)  void do_assign(NODE arg)
Legend:
Removed from v.1.67  
changed lines
  Added in v.1.68
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>