=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/arith.c,v retrieving revision 1.6 retrieving revision 1.13 diff -u -p -r1.6 -r1.13 --- OpenXM_contrib2/asir2000/parse/arith.c 2001/08/20 09:03:27 1.6 +++ OpenXM_contrib2/asir2000/parse/arith.c 2004/04/14 07:27:42 1.13 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/parse/arith.c,v 1.5 2000/12/11 09:28:03 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/parse/arith.c,v 1.12 2004/03/03 09:25:30 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -84,6 +84,10 @@ struct oAFUNC afunc[] = { /* O_GFMMAT=15 */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef}, /* O_BYTEARRAY=16 */ {notdef,notdef,notdef,notdef,notdef,notdef,compbytearray}, /* O_QUOTE=17 */ {addquote,subquote,mulquote,divquote,pwrquote,chsgnquote,(int(*)())notdef}, +/* O_OPTLIST=18 */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef}, +/* O_SYMBOL=19 */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef}, +/* O_RANGE=20 */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef}, +/* O_TB=21 */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef}, }; void arf_init() { @@ -109,6 +113,8 @@ Obj a,b,*r; (*afunc[OID(a)].add)(vl,a,b,r); else if ( (mid = MAX(OID(a),OID(b))) <= O_R ) (*afunc[mid].add)(vl,a,b,r); + else if ( (mid = MAX(OID(a),OID(b))) == O_DP && MIN(OID(a),OID(b)) <= O_R ) + (*afunc[mid].add)(vl,a,b,r); else notdef(vl,a,b,r); } @@ -138,17 +144,61 @@ void arf_mul(vl,a,b,r) VL vl; Obj a,b,*r; { - int mid; + int mid,aid,bid; - if ( !a || !b ) + if ( !a && !b ) *r = 0; - else if ( OID(a) == OID(b) ) - (*(afunc[OID(a)].mul))(vl,a,b,r); - else if ( (mid = MAX(OID(a),OID(b))) <= O_R || - (mid == O_MAT) || (mid == O_VECT) || (mid == O_DP) ) + else if ( !a || !b ) { + if ( !a ) + a = b; + /* compute a*0 */ + if ( OID(a) == O_MAT || OID(a) == O_VECT ) + (*(afunc[O_MAT].mul))(vl,a,0,r); + else + *r = 0; + } else if ( (aid = OID(a)) == (bid = OID(b)) ) + (*(afunc[aid].mul))(vl,a,b,r); + else if ( (mid = MAX(aid,bid)) <= O_R ) (*afunc[mid].mul)(vl,a,b,r); - else - notdef(vl,a,b,r); + else { + switch ( aid ) { + case O_N: case O_P: + (*afunc[mid].mul)(vl,a,b,r); + break; + case O_R: + /* rat * something; bid > O_R */ + if ( bid == O_VECT || bid == O_MAT ) + (*afunc[mid].mul)(vl,a,b,r); + else + notdef(vl,a,b,r); + break; + case O_MAT: + if ( bid <= O_R || bid == O_VECT || bid == O_DP ) + (*afunc[O_MAT].mul)(vl,a,b,r); + else + notdef(vl,a,b,r); + break; + case O_VECT: + if ( bid <= O_R || bid == O_DP ) + (*afunc[O_VECT].mul)(vl,a,b,r); + else if ( bid == O_MAT ) + (*afunc[O_MAT].mul)(vl,a,b,r); + else + notdef(vl,a,b,r); + break; + case O_DP: + if ( bid <= O_P ) + (*afunc[O_DP].mul)(vl,a,b,r); + else if ( bid == O_MAT || bid == O_VECT ) + (*afunc[bid].mul)(vl,a,b,r); + else + notdef(vl,a,b,r); + break; + default: + notdef(vl,a,b,r); + break; + } + } } void arf_div(vl,a,b,r) @@ -191,12 +241,18 @@ Obj a,e,*r; R t; if ( !a ) - *r = 0; + if ( !e ) + *r = (pointer)ONE; + else + *r = 0; else if ( OID(a) == O_QUOTE ) (*(afunc[O_QUOTE].pwr))(vl,a,e,r); - else if ( !e ) - *r = (pointer)ONE; - else if ( (OID(e) <= O_N) && INT(e) ) { + else if ( !e ) { + if ( OID(a) == O_MAT ) + (*(afunc[O_MAT].pwr))(vl,a,e,r); + else + *r = (pointer)ONE; + } else if ( (OID(e) <= O_N) && INT(e) ) { if ( (OID(a) == O_P) && (SGN((Q)e) < 0) ) { MKRAT((P)a,(P)ONE,1,t); (*(afunc[O_R].pwr))(vl,t,e,r); @@ -238,7 +294,7 @@ int complist(vl,a,b) VL vl; LIST a,b; { - int i,t; + int t; NODE an,bn; if ( !a )