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

Diff for /OpenXM_contrib2/asir2000/parse/eval.c between version 1.46 and 1.47

version 1.46, 2005/09/28 08:08:34 version 1.47, 2005/09/29 08:55:26
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/parse/eval.c,v 1.45 2005/09/27 03:00:21 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.46 2005/09/28 08:08:34 noro Exp $
 */  */
 #include <ctype.h>  #include <ctype.h>
 #include "ca.h"  #include "ca.h"
Line 343  pointer eval(FNODE f)
Line 343  pointer eval(FNODE f)
         return ( val );          return ( val );
 }  }
   
 NODE quote_bin_to_nary_node(NODE);  NODE quote_to_nary_node(NODE);
 NODE quote_nary_to_bin_node(NODE,int);  NODE quote_to_bin_node(NODE,int);
   
 FNODE quote_bin_to_nary(FNODE f)  FNODE quote_to_nary(FNODE f)
 {  {
         FNODE a0,a1,a2;          FNODE a0,a1,a2;
         NODE n,t;          NODE n,t,t0;
         pointer val;          pointer val;
         char *op;          char *op;
   
         if ( !f )          if ( !f )
                 return f;                  return f;
         switch ( f->id ) {          switch ( f->id ) {
                   case I_NARYOP:
                                   n = quote_to_nary_node((NODE)FA1(f));
                                   return mkfnode(2,I_NARYOP,FA0(f),n);
   
                 case I_BOP:                  case I_BOP:
                         a1 = quote_bin_to_nary((FNODE)FA1(f));                          a1 = quote_to_nary((FNODE)FA1(f));
                         a2 = quote_bin_to_nary((FNODE)FA2(f));                          a2 = quote_to_nary((FNODE)FA2(f));
                         op = ((ARF)FA0(f))->name;                          op = ((ARF)FA0(f))->name;
                         if ( !strcmp(op,"+") || !strcmp(op,"*") ) {                          if ( !strcmp(op,"+") || !strcmp(op,"*") ) {
                                 if ( a1->id == I_NARYOP && !strcmp(op,((ARF)FA0(a1))->name) ) {                                  if ( a1->id == I_NARYOP && !strcmp(op,((ARF)FA0(a1))->name) ) {
                                         for ( t = (NODE)FA1(a1); NEXT(t); t = NEXT(t));                                          for ( n = (NODE)FA1(a1); NEXT(n); n = NEXT(n) );
                                         if ( a2->id == I_NARYOP && !strcmp(op,((ARF)FA0(a2))->name) )                                          if ( a2->id == I_NARYOP && !strcmp(op,((ARF)FA0(a2))->name) )
                                                 NEXT(t) = (NODE)FA1(a2);                                                  NEXT(n) = (NODE)FA1(a2);
                                         else                                          else
                                                 MKNODE(NEXT(t),a2,0);                                                  MKNODE(NEXT(n),a2,0);
                                         return a1;                                          return a1;
                                 } else if ( a2->id == I_NARYOP && !strcmp(op,((ARF)FA0(a2))->name) ) {                                  } else if ( a2->id == I_NARYOP && !strcmp(op,((ARF)FA0(a2))->name) ) {
                                         MKNODE(t,a1,(NODE)FA1(a2));                                          MKNODE(t,a1,(NODE)FA1(a2));
                                         FA1(a2) = (pointer)t;                                          return mkfnode(2,I_NARYOP,FA0(f),t);
                                         return a2;  
                                 } else {                                  } else {
                                         t = mknode(2,a1,a2);                                          t = mknode(2,a1,a2);
                                         return mkfnode(2,I_NARYOP,FA0(f),t);                                          return mkfnode(2,I_NARYOP,FA0(f),t);
Line 381  FNODE quote_bin_to_nary(FNODE f)
Line 384  FNODE quote_bin_to_nary(FNODE f)
   
                 case I_NOT: case I_PAREN: case I_MINUS:                  case I_NOT: case I_PAREN: case I_MINUS:
                 case I_CAR: case I_CDR:                  case I_CAR: case I_CDR:
                         a0 = quote_bin_to_nary((FNODE)FA0(f));                          a0 = quote_to_nary((FNODE)FA0(f));
                         return mkfnode(1,f->id,a0);                          return mkfnode(1,f->id,a0);
   
                 case I_COP: case I_LOP:                  case I_COP: case I_LOP:
                         a1 = quote_bin_to_nary((FNODE)FA1(f));                          a1 = quote_to_nary((FNODE)FA1(f));
                         a2 = quote_bin_to_nary((FNODE)FA2(f));                          a2 = quote_to_nary((FNODE)FA2(f));
                         return mkfnode(3,f->id,FA0(f),a1,a2);                          return mkfnode(3,f->id,FA0(f),a1,a2);
   
                 case I_AND: case I_OR:                  case I_AND: case I_OR:
                         a0 = quote_bin_to_nary((FNODE)FA0(f));                          a0 = quote_to_nary((FNODE)FA0(f));
                         a1 = quote_bin_to_nary((FNODE)FA1(f));                          a1 = quote_to_nary((FNODE)FA1(f));
                         return mkfnode(2,f->id,a0,a1);                          return mkfnode(2,f->id,a0,a1);
   
                 /* ternary operators */                  /* ternary operators */
                 case I_CE:                  case I_CE:
                         a0 = quote_bin_to_nary((FNODE)FA0(f));                          a0 = quote_to_nary((FNODE)FA0(f));
                         a1 = quote_bin_to_nary((FNODE)FA1(f));                          a1 = quote_to_nary((FNODE)FA1(f));
                         a2 = quote_bin_to_nary((FNODE)FA2(f));                          a2 = quote_to_nary((FNODE)FA2(f));
                         return mkfnode(3,f->id,a0,a1,a2);                          return mkfnode(3,f->id,a0,a1,a2);
                         break;                          break;
   
                 /* function */                  /* function */
                 case I_FUNC:                  case I_FUNC:
                         a1 = quote_bin_to_nary((FNODE)FA1(f));                          a1 = quote_to_nary((FNODE)FA1(f));
                         return mkfnode(2,f->id,FA0(f),a1);                          return mkfnode(2,f->id,FA0(f),a1);
   
                 case I_LIST: case I_EV:                  case I_LIST: case I_EV:
                         n = quote_bin_to_nary_node((NODE)FA0(f));                          n = quote_to_nary_node((NODE)FA0(f));
                         return mkfnode(1,f->id,n);                          return mkfnode(1,f->id,n);
   
                 case I_STR: case I_FORMULA: case I_PVAR:                  case I_STR: case I_FORMULA: case I_PVAR:
                         return f;                          return f;
   
                 default:                  default:
                         error("quote_bin_to_nary : not implemented yet");                          error("quote_to_nary : not implemented yet");
         }          }
 }  }
   
 FNODE quote_nary_to_bin(FNODE f,int dir)  FNODE quote_to_bin(FNODE f,int dir)
 {  {
         FNODE a0,a1,a2;          FNODE a0,a1,a2;
         NODE n,t;          NODE n,t;
Line 436  FNODE quote_nary_to_bin(FNODE f,int dir)
Line 439  FNODE quote_nary_to_bin(FNODE f,int dir)
                         len = length((NODE)FA1(f));                          len = length((NODE)FA1(f));
                         arg = (FNODE *)ALLOCA(len*sizeof(FNODE));                          arg = (FNODE *)ALLOCA(len*sizeof(FNODE));
                         for ( i = 0, t = (NODE)FA1(f); i < len; i++, t = NEXT(t) )                          for ( i = 0, t = (NODE)FA1(f); i < len; i++, t = NEXT(t) )
                                 arg[i] = quote_nary_to_bin((FNODE)BDY(t),dir);                                  arg[i] = quote_to_bin((FNODE)BDY(t),dir);
                         if ( dir ) {                          if ( dir ) {
                                 a2 = mkfnode(3,I_BOP,fun,arg[len-2],arg[len-1]);                                  a2 = mkfnode(3,I_BOP,fun,arg[len-2],arg[len-1]);
                                 for ( i = len-3; i >= 0; i-- )                                  for ( i = len-3; i >= 0; i-- )
Line 450  FNODE quote_nary_to_bin(FNODE f,int dir)
Line 453  FNODE quote_nary_to_bin(FNODE f,int dir)
   
                 case I_NOT: case I_PAREN: case I_MINUS:                  case I_NOT: case I_PAREN: case I_MINUS:
                 case I_CAR: case I_CDR:                  case I_CAR: case I_CDR:
                         a0 = quote_nary_to_bin((FNODE)FA0(f),dir);                          a0 = quote_to_bin((FNODE)FA0(f),dir);
                         return mkfnode(1,f->id,a0);                          return mkfnode(1,f->id,a0);
   
                 case I_BOP: case I_COP: case I_LOP:                  case I_BOP: case I_COP: case I_LOP:
                         a1 = quote_nary_to_bin((FNODE)FA1(f),dir);                          a1 = quote_to_bin((FNODE)FA1(f),dir);
                         a2 = quote_nary_to_bin((FNODE)FA2(f),dir);                          a2 = quote_to_bin((FNODE)FA2(f),dir);
                         return mkfnode(3,f->id,FA0(f),a1,a2);                          return mkfnode(3,f->id,FA0(f),a1,a2);
   
                 case I_AND: case I_OR:                  case I_AND: case I_OR:
                         a0 = quote_nary_to_bin((FNODE)FA0(f),dir);                          a0 = quote_to_bin((FNODE)FA0(f),dir);
                         a1 = quote_nary_to_bin((FNODE)FA1(f),dir);                          a1 = quote_to_bin((FNODE)FA1(f),dir);
                         return mkfnode(2,f->id,a0,a1);                          return mkfnode(2,f->id,a0,a1);
   
                 /* ternary operators */                  /* ternary operators */
                 case I_CE:                  case I_CE:
                         a0 = quote_nary_to_bin((FNODE)FA0(f),dir);                          a0 = quote_to_bin((FNODE)FA0(f),dir);
                         a1 = quote_nary_to_bin((FNODE)FA1(f),dir);                          a1 = quote_to_bin((FNODE)FA1(f),dir);
                         a2 = quote_nary_to_bin((FNODE)FA2(f),dir);                          a2 = quote_to_bin((FNODE)FA2(f),dir);
                         return mkfnode(3,f->id,a0,a1,a2);                          return mkfnode(3,f->id,a0,a1,a2);
                         break;                          break;
   
                 /* function */                  /* function */
                 case I_FUNC:                  case I_FUNC:
                         a1 = quote_nary_to_bin((FNODE)FA1(f),dir);                          a1 = quote_to_bin((FNODE)FA1(f),dir);
                         return mkfnode(2,f->id,FA0(f),a1);                          return mkfnode(2,f->id,FA0(f),a1);
   
                 case I_LIST: case I_EV:                  case I_LIST: case I_EV:
                         n = quote_nary_to_bin_node((NODE)FA0(f),dir);                          n = quote_to_bin_node((NODE)FA0(f),dir);
                         return mkfnode(1,f->id,n);                          return mkfnode(1,f->id,n);
   
                 case I_STR: case I_FORMULA: case I_PVAR:                  case I_STR: case I_FORMULA: case I_PVAR:
                         return f;                          return f;
   
                 default:                  default:
                         error("quote_nary_to_bin : not implemented yet");                          error("quote_to_bin : not implemented yet");
         }          }
 }  }
   
Line 560  NODE partial_eval_node(NODE n)
Line 563  NODE partial_eval_node(NODE n)
         return r0;          return r0;
 }  }
   
 NODE quote_bin_to_nary_node(NODE n)  NODE quote_to_nary_node(NODE n)
 {  {
         NODE r0,r,t;          NODE r0,r,t;
   
         for ( r0 = 0, t = n; t; t = NEXT(t) ) {          for ( r0 = 0, t = n; t; t = NEXT(t) ) {
                 NEXTNODE(r0,r);                  NEXTNODE(r0,r);
                 BDY(r) = quote_bin_to_nary((FNODE)BDY(t));                  BDY(r) = quote_to_nary((FNODE)BDY(t));
         }          }
         if ( r0 ) NEXT(r) = 0;          if ( r0 ) NEXT(r) = 0;
         return r0;          return r0;
 }  }
   
 NODE quote_nary_to_bin_node(NODE n,int dir)  NODE quote_to_bin_node(NODE n,int dir)
 {  {
         NODE r0,r,t;          NODE r0,r,t;
   
         for ( r0 = 0, t = n; t; t = NEXT(t) ) {          for ( r0 = 0, t = n; t; t = NEXT(t) ) {
                 NEXTNODE(r0,r);                  NEXTNODE(r0,r);
                 BDY(r) = quote_nary_to_bin((FNODE)BDY(t),dir);                  BDY(r) = quote_to_bin((FNODE)BDY(t),dir);
         }          }
         if ( r0 ) NEXT(r) = 0;          if ( r0 ) NEXT(r) = 0;
         return r0;          return r0;

Legend:
Removed from v.1.46  
changed lines
  Added in v.1.47

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