version 1.120, 2010/04/23 06:53:30 |
version 1.124, 2015/08/14 13:51:54 |
|
|
* 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.119 2008/09/04 01:42:25 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.123 2015/08/06 10:01:52 fujimoto Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
Line 60 extern jmp_buf environnement; |
|
Line 60 extern jmp_buf environnement; |
|
|
|
#if defined(__GNUC__) |
#if defined(__GNUC__) |
#define INLINE inline |
#define INLINE inline |
#elif defined(VISUAL) |
#elif defined(VISUAL) || defined(__MINGW32__) |
#define INLINE __inline |
#define INLINE __inline |
#else |
#else |
#define INLINE |
#define INLINE |
Line 1436 char *symbol_name(char *name) |
|
Line 1436 char *symbol_name(char *name) |
|
|
|
void Pget_function_name(NODE arg,STRING *rp) |
void Pget_function_name(NODE arg,STRING *rp) |
{ |
{ |
QUOTEARG qa; |
QUOTEARG qa; |
ARF f; |
|
char *opname; |
|
|
|
qa = (QUOTEARG)BDY(arg); |
qa = (QUOTEARG)BDY(arg); |
if ( !qa || OID(qa) != O_QUOTEARG || qa->type != A_arf ) |
if ( !qa || OID(qa) != O_QUOTEARG ) { |
|
*rp = 0; return; |
|
} |
|
switch ( qa->type ) { |
|
case A_arf: |
|
MKSTR(*rp,((ARF)BDY(qa))->name); |
|
break; |
|
case A_func: |
|
MKSTR(*rp,((FUNC)BDY(qa))->name); |
|
break; |
|
default: |
*rp = 0; |
*rp = 0; |
else { |
break; |
f = (ARF)BDY(qa); |
} |
opname = f->name; |
|
MKSTR(*rp,opname); |
|
} |
|
} |
} |
|
|
FNODE strip_paren(FNODE); |
FNODE strip_paren(FNODE); |
Line 3101 FNODE fnode_node_to_nary(ARF op,NODE n) |
|
Line 3106 FNODE fnode_node_to_nary(ARF op,NODE n) |
|
{ |
{ |
if ( !n ) { |
if ( !n ) { |
if ( op->name[0] == '+' ) |
if ( op->name[0] == '+' ) |
return mkfnode(1,I_FORMULA,0); |
return mkfnode(1,I_FORMULA,NULLP); |
else |
else |
return mkfnode(1,I_FORMULA,ONE); |
return mkfnode(1,I_FORMULA,ONE); |
} else if ( !NEXT(n) ) return BDY(n); |
} else if ( !NEXT(n) ) return BDY(n); |
Line 3117 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand) |
|
Line 3122 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand) |
|
Obj c1,c2,c,e; |
Obj c1,c2,c,e; |
int l1,l,i,j; |
int l1,l,i,j; |
|
|
if ( IS_ZERO(f1) || IS_ZERO(f2) ) return mkfnode(1,I_FORMULA,0); |
if ( IS_ZERO(f1) || IS_ZERO(f2) ) return mkfnode(1,I_FORMULA,NULLP); |
else if ( fnode_is_coef(f1) ) |
else if ( fnode_is_coef(f1) ) |
return nfnode_mul_coef((Obj)eval(f1),f2,expand); |
return nfnode_mul_coef((Obj)eval(f1),f2,expand); |
else if ( fnode_is_coef(f2) ) |
else if ( fnode_is_coef(f2) ) |
return nfnode_mul_coef((Obj)eval(f2),f1,expand); |
return nfnode_mul_coef((Obj)eval(f2),f1,expand); |
|
|
if ( expand && IS_NARYADD(f1) ) { |
if ( expand && IS_NARYADD(f1) ) { |
t = mkfnode(1,I_FORMULA,0); |
t = mkfnode(1,I_FORMULA,NULLP); |
for ( n1 = (NODE)FA1(f1); n1; n1 = NEXT(n1) ) { |
for ( n1 = (NODE)FA1(f1); n1; n1 = NEXT(n1) ) { |
t1 = nfnode_mul(BDY(n1),f2,expand); |
t1 = nfnode_mul(BDY(n1),f2,expand); |
t = nfnode_add(t,t1,expand); |
t = nfnode_add(t,t1,expand); |
Line 3132 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand) |
|
Line 3137 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand) |
|
return t; |
return t; |
} |
} |
if ( expand && IS_NARYADD(f2) ) { |
if ( expand && IS_NARYADD(f2) ) { |
t = mkfnode(1,I_FORMULA,0); |
t = mkfnode(1,I_FORMULA,NULLP); |
for ( n2 = (NODE)FA1(f2); n2; n2 = NEXT(n2) ) { |
for ( n2 = (NODE)FA1(f2); n2; n2 = NEXT(n2) ) { |
t1 = nfnode_mul(f1,BDY(n2),expand); |
t1 = nfnode_mul(f1,BDY(n2),expand); |
t = nfnode_add(t,t1,expand); |
t = nfnode_add(t,t1,expand); |
Line 3142 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand) |
|
Line 3147 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand) |
|
|
|
fnode_coef_body(f1,&c1,&b1); fnode_coef_body(f2,&c2,&b2); |
fnode_coef_body(f1,&c1,&b1); fnode_coef_body(f2,&c2,&b2); |
arf_mul(CO,c1,c2,&c); |
arf_mul(CO,c1,c2,&c); |
if ( !c ) return mkfnode(1,I_FORMULA,0); |
if ( !c ) return mkfnode(1,I_FORMULA,NULLP); |
|
|
|
|
n1 = (NODE)FA1(to_narymul(b1)); n2 = (NODE)FA1(to_narymul(b2)); |
n1 = (NODE)FA1(to_narymul(b1)); n2 = (NODE)FA1(to_narymul(b2)); |
Line 3192 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand) |
|
Line 3197 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand) |
|
Q q; |
Q q; |
|
|
if ( IS_ZERO(f2) ) return mkfnode(1,I_FORMULA,ONE); |
if ( IS_ZERO(f2) ) return mkfnode(1,I_FORMULA,ONE); |
else if ( IS_ZERO(f1) ) return mkfnode(1,I_FORMULA,0); |
else if ( IS_ZERO(f1) ) return mkfnode(1,I_FORMULA,NULLP); |
else if ( fnode_is_coef(f1) ) { |
else if ( fnode_is_coef(f1) ) { |
if ( fnode_is_integer(f2) ) { |
if ( fnode_is_integer(f2) ) { |
if ( fnode_is_one(f2) ) return f1; |
if ( fnode_is_one(f2) ) return f1; |
Line 3251 FNODE fnode_expand_pwr(FNODE f,int n,int expand) |
|
Line 3256 FNODE fnode_expand_pwr(FNODE f,int n,int expand) |
|
Q q; |
Q q; |
|
|
if ( !n ) return mkfnode(1,I_FORMULA,ONE); |
if ( !n ) return mkfnode(1,I_FORMULA,ONE); |
else if ( IS_ZERO(f) ) return mkfnode(1,I_FORMULA,0); |
else if ( IS_ZERO(f) ) return mkfnode(1,I_FORMULA,NULLP); |
else if ( n == 1 ) return f; |
else if ( n == 1 ) return f; |
else { |
else { |
switch ( expand ) { |
switch ( expand ) { |
Line 3314 FNODE nfnode_mul_coef(Obj c,FNODE f,int expand) |
|
Line 3319 FNODE nfnode_mul_coef(Obj c,FNODE f,int expand) |
|
NODE n,r,r0; |
NODE n,r,r0; |
|
|
if ( !c ) |
if ( !c ) |
return mkfnode(I_FORMULA,0); |
return mkfnode(1,I_FORMULA,NULLP); |
else { |
else { |
fnode_coef_body(f,&c1,&b1); |
fnode_coef_body(f,&c1,&b1); |
arf_mul(CO,c,c1,&c2); |
arf_mul(CO,c,c1,&c2); |
Line 3447 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
Line 3452 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
if ( r ) return r; |
if ( r ) return r; |
} |
} |
if ( !n1 && !n2 ) return 0; |
if ( !n1 && !n2 ) return 0; |
h1 = n1 ? (FNODE)BDY(n1) : mkfnode(1,I_FORMULA,0); |
h1 = n1 ? (FNODE)BDY(n1) : mkfnode(1,I_FORMULA,NULLP); |
h2 = n2 ? (FNODE)BDY(n2) : mkfnode(1,I_FORMULA,0); |
h2 = n2 ? (FNODE)BDY(n2) : mkfnode(1,I_FORMULA,NULLP); |
return nfnode_comp_lex(h1,h2); |
return nfnode_comp_lex(h1,h2); |
} |
} |
if ( IS_NARYMUL(f1) || IS_NARYMUL(f2) ) { |
if ( IS_NARYMUL(f1) || IS_NARYMUL(f2) ) { |
Line 3471 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
Line 3476 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
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) ) { |
if ( r > 0 ) |
if ( r > 0 ) |
return nfnode_comp_lex(e1,mkfnode(1,I_FORMULA,0)); |
return nfnode_comp_lex(e1,mkfnode(1,I_FORMULA,NULLP)); |
else if ( r < 0 ) |
else if ( r < 0 ) |
return nfnode_comp_lex(mkfnode(1,I_FORMULA,0),e2); |
return nfnode_comp_lex(mkfnode(1,I_FORMULA,NULLP),e2); |
} else return nfnode_comp_lex(e1,e2); |
} else return nfnode_comp_lex(e1,e2); |
} |
} |
|
|
Line 3632 int nfnode_match(FNODE f,FNODE pat,NODE *rp) |
|
Line 3637 int nfnode_match(FNODE f,FNODE pat,NODE *rp) |
|
} else { |
} else { |
/* XXX : I_FUNC_HEAD is a dummy id to pass FUNC */ |
/* XXX : I_FUNC_HEAD is a dummy id to pass FUNC */ |
fh = mkfnode(1,I_FUNC_HEAD,FA0(f)); |
fh = mkfnode(1,I_FUNC_HEAD,FA0(f)); |
m = mknode(1,mknode(2,FA0((FNODE)FA0(pat)),fh),0); |
m = mknode(1,mknode(2,FA0((FNODE)FA0(pat)),fh),NULLP); |
} |
} |
/* FA1(f) and FA1(pat) are I_LIST */ |
/* FA1(f) and FA1(pat) are I_LIST */ |
fa = (NODE)FA0((FNODE)FA1(f)); |
fa = (NODE)FA0((FNODE)FA1(f)); |