version 1.1, 2018/09/19 05:45:06 |
version 1.4, 2021/03/25 05:06:06 |
|
|
* 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: OpenXM_contrib2/asir2018/builtin/strobj.c,v 1.3 2020/10/06 06:31:19 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
Line 427 int register_symbol_table(Obj arg) |
|
Line 427 int register_symbol_table(Obj arg) |
|
int register_dp_vars_origin(Obj arg) |
int register_dp_vars_origin(Obj arg) |
{ |
{ |
if ( INT(arg) ) { |
if ( INT(arg) ) { |
dp_vars_origin = QTOS((Q)arg); |
dp_vars_origin = ZTOS((Q)arg); |
return 1; |
return 1; |
} else return 0; |
} else return 0; |
} |
} |
Line 435 int register_dp_vars_origin(Obj arg) |
|
Line 435 int register_dp_vars_origin(Obj arg) |
|
int register_dp_dvars_origin(Obj arg) |
int register_dp_dvars_origin(Obj arg) |
{ |
{ |
if ( INT(arg) ) { |
if ( INT(arg) ) { |
dp_dvars_origin = QTOS((Q)arg); |
dp_dvars_origin = ZTOS((Q)arg); |
return 1; |
return 1; |
} else return 0; |
} else return 0; |
} |
} |
Line 443 int register_dp_dvars_origin(Obj arg) |
|
Line 443 int register_dp_dvars_origin(Obj arg) |
|
int register_dp_vars_hweyl(Obj arg) |
int register_dp_vars_hweyl(Obj arg) |
{ |
{ |
if ( INT(arg) ) { |
if ( INT(arg) ) { |
dp_vars_hweyl = QTOS((Q)arg); |
dp_vars_hweyl = ZTOS((Q)arg); |
return 1; |
return 1; |
} else return 0; |
} else return 0; |
} |
} |
Line 451 int register_dp_vars_hweyl(Obj arg) |
|
Line 451 int register_dp_vars_hweyl(Obj arg) |
|
int register_show_lt(Obj arg) |
int register_show_lt(Obj arg) |
{ |
{ |
if ( INT(arg) ) { |
if ( INT(arg) ) { |
show_lt = QTOS((Q)arg); |
show_lt = ZTOS((Q)arg); |
return 1; |
return 1; |
} else return 0; |
} else return 0; |
} |
} |
Line 459 int register_show_lt(Obj arg) |
|
Line 459 int register_show_lt(Obj arg) |
|
int register_conv_rule(Obj arg) |
int register_conv_rule(Obj arg) |
{ |
{ |
if ( INT(arg) ) { |
if ( INT(arg) ) { |
conv_flag = QTOS((Q)arg); |
conv_flag = ZTOS((Q)arg); |
convfunc = 0; |
convfunc = 0; |
return 1; |
return 1; |
} else return 0; |
} else return 0; |
Line 615 void Pqt_to_bin(NODE arg,QUOTE *rp) |
|
Line 615 void Pqt_to_bin(NODE arg,QUOTE *rp) |
|
FNODE f; |
FNODE f; |
int direction; |
int direction; |
|
|
direction = QTOS((Q)ARG1(arg)); |
direction = ZTOS((Q)ARG1(arg)); |
f = fnode_to_bin(BDY((QUOTE)ARG0(arg)),direction); |
f = fnode_to_bin(BDY((QUOTE)ARG0(arg)),direction); |
|
|
MKQUOTE(*rp,f); |
MKQUOTE(*rp,f); |
Line 629 void Pqt_is_var(NODE arg,Z *rp) |
|
Line 629 void Pqt_is_var(NODE arg,Z *rp) |
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"qt_is_var"); |
asir_assert(q,O_QUOTE,"qt_is_var"); |
ret = fnode_is_var(BDY(q)); |
ret = fnode_is_var(BDY(q)); |
STOQ(ret,*rp); |
STOZ(ret,*rp); |
} |
} |
|
|
void Pqt_is_coef(NODE arg,Z *rp) |
void Pqt_is_coef(NODE arg,Z *rp) |
Line 640 void Pqt_is_coef(NODE arg,Z *rp) |
|
Line 640 void Pqt_is_coef(NODE arg,Z *rp) |
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"qt_is_coef"); |
asir_assert(q,O_QUOTE,"qt_is_coef"); |
ret = fnode_is_coef(BDY(q)); |
ret = fnode_is_coef(BDY(q)); |
STOQ(ret,*rp); |
STOZ(ret,*rp); |
} |
} |
|
|
void Pqt_is_number(NODE arg,Z *rp) |
void Pqt_is_number(NODE arg,Z *rp) |
Line 651 void Pqt_is_number(NODE arg,Z *rp) |
|
Line 651 void Pqt_is_number(NODE arg,Z *rp) |
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"qt_is_number"); |
asir_assert(q,O_QUOTE,"qt_is_number"); |
ret = fnode_is_number(BDY(q)); |
ret = fnode_is_number(BDY(q)); |
STOQ(ret,*rp); |
STOZ(ret,*rp); |
} |
} |
|
|
void Pqt_is_rational(NODE arg,Z *rp) |
void Pqt_is_rational(NODE arg,Z *rp) |
Line 662 void Pqt_is_rational(NODE arg,Z *rp) |
|
Line 662 void Pqt_is_rational(NODE arg,Z *rp) |
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"qt_is_rational"); |
asir_assert(q,O_QUOTE,"qt_is_rational"); |
ret = fnode_is_rational(BDY(q)); |
ret = fnode_is_rational(BDY(q)); |
STOQ(ret,*rp); |
STOZ(ret,*rp); |
} |
} |
|
|
void Pqt_is_integer(NODE arg,Z *rp) |
void Pqt_is_integer(NODE arg,Z *rp) |
Line 673 void Pqt_is_integer(NODE arg,Z *rp) |
|
Line 673 void Pqt_is_integer(NODE arg,Z *rp) |
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"qt_is_integer"); |
asir_assert(q,O_QUOTE,"qt_is_integer"); |
ret = fnode_is_integer(BDY(q)); |
ret = fnode_is_integer(BDY(q)); |
STOQ(ret,*rp); |
STOZ(ret,*rp); |
} |
} |
|
|
void Pqt_is_function(NODE arg,Z *rp) |
void Pqt_is_function(NODE arg,Z *rp) |
Line 687 void Pqt_is_function(NODE arg,Z *rp) |
|
Line 687 void Pqt_is_function(NODE arg,Z *rp) |
|
ret = 1; |
ret = 1; |
else |
else |
ret = 0; |
ret = 0; |
STOQ(ret,*rp); |
STOZ(ret,*rp); |
} |
} |
|
|
void Pqt_is_dependent(NODE arg,Z *rp) |
void Pqt_is_dependent(NODE arg,Z *rp) |
Line 706 void Pqt_is_dependent(NODE arg,Z *rp) |
|
Line 706 void Pqt_is_dependent(NODE arg,Z *rp) |
|
*rp = 0; |
*rp = 0; |
var = VR(x); |
var = VR(x); |
ret = fnode_is_dependent(BDY(q),var); |
ret = fnode_is_dependent(BDY(q),var); |
STOQ(ret,*rp); |
STOZ(ret,*rp); |
} |
} |
|
|
|
|
Line 774 void Pnqt_match_rewrite(NODE arg,Obj *rp) |
|
Line 774 void Pnqt_match_rewrite(NODE arg,Obj *rp) |
|
if ( OID(cond) == O_QUOTE ) c = BDY((QUOTE)cond); |
if ( OID(cond) == O_QUOTE ) c = BDY((QUOTE)cond); |
else c = mkfnode(1,I_FORMULA,ONE); |
else c = mkfnode(1,I_FORMULA,ONE); |
|
|
m = QTOS(mode); |
m = ZTOS(mode); |
r = nfnode_match_rewrite(f,p,c,a,m); |
r = nfnode_match_rewrite(f,p,c,a,m); |
if ( r ) { |
if ( r ) { |
MKQUOTE(q,r); |
MKQUOTE(q,r); |
Line 880 void fnode_do_assign(NODE arg) |
|
Line 880 void fnode_do_assign(NODE arg) |
|
} |
} |
|
|
/* |
/* |
/* consistency check and merge |
* consistency check and merge |
*/ |
*/ |
|
|
int merge_matching_node(NODE n,NODE a,NODE *rp) |
int merge_matching_node(NODE n,NODE a,NODE *rp) |
Line 953 int qt_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp) { |
|
Line 953 int qt_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp) { |
|
} |
} |
/* matching of the rest */ |
/* matching of the rest */ |
MKLIST(list,tf); |
MKLIST(list,tf); |
STOQ(I_LIST,id); a = mknode(2,id,list); |
STOZ(I_LIST,id); a = mknode(2,id,list); |
MKLIST(alist,a); |
MKLIST(alist,a); |
arg = mknode(1,alist); |
arg = mknode(1,alist); |
Pfunargs_to_quote(arg,&q); |
Pfunargs_to_quote(arg,&q); |
Line 971 void get_quote_id_arg(QUOTE f,int *id,NODE *r) |
|
Line 971 void get_quote_id_arg(QUOTE f,int *id,NODE *r) |
|
NODE arg,fab; |
NODE arg,fab; |
|
|
arg = mknode(1,f); Pquote_to_funargs(arg,&fa); fab = BDY((LIST)fa); |
arg = mknode(1,f); Pquote_to_funargs(arg,&fa); fab = BDY((LIST)fa); |
*id = QTOS((Q)BDY(fab)); *r = NEXT(fab); |
*id = ZTOS((Q)BDY(fab)); *r = NEXT(fab); |
} |
} |
|
|
/* *rp : [[quote(A),quote(1)],...] */ |
/* *rp : [[quote(A),quote(1)],...] */ |
Line 1080 int qt_match(Obj f, Obj pat, NODE *rp) |
|
Line 1080 int qt_match(Obj f, Obj pat, NODE *rp) |
|
return qt_match_node(farg,parg,rp); |
return qt_match_node(farg,parg,rp); |
} |
} |
} |
} |
|
/* XXX */ |
|
return 0; |
} |
} |
|
|
void Pquotetotex(NODE arg,STRING *rp) |
void Pquotetotex(NODE arg,STRING *rp) |
|
|
for ( r = i = 0; i < tb->next; i++ ) |
for ( r = i = 0; i < tb->next; i++ ) |
r += strlen(tb->body[i]); |
r += strlen(tb->body[i]); |
} |
} |
STOQ(r,*rp); |
STOZ(r,*rp); |
} |
} |
|
|
void Pstr_chr(arg,rp) |
void Pstr_chr(arg,rp) |
|
|
asir_assert(start,O_N,"str_chr"); |
asir_assert(start,O_N,"str_chr"); |
asir_assert(terminator,O_STR,"str_chr"); |
asir_assert(terminator,O_STR,"str_chr"); |
p = BDY(str); |
p = BDY(str); |
spos = QTOS(start); |
spos = ZTOS(start); |
chr = BDY(terminator)[0]; |
chr = BDY(terminator)[0]; |
if ( spos > (int)strlen(p) ) |
if ( spos > (int)strlen(p) ) |
r = -1; |
r = -1; |
|
|
else |
else |
r = -1; |
r = -1; |
} |
} |
STOQ(r,*rp); |
STOZ(r,*rp); |
} |
} |
|
|
void Psub_str(arg,rp) |
void Psub_str(arg,rp) |
|
|
asir_assert(head,O_N,"sub_str"); |
asir_assert(head,O_N,"sub_str"); |
asir_assert(tail,O_N,"sub_str"); |
asir_assert(tail,O_N,"sub_str"); |
p = BDY(str); |
p = BDY(str); |
spos = QTOS(head); |
spos = ZTOS(head); |
epos = QTOS(tail); |
epos = ZTOS(tail); |
len = strlen(p); |
len = strlen(p); |
if ( (spos >= len) || (epos < spos) ) { |
if ( (spos >= len) || (epos < spos) ) { |
*rp = 0; return; |
*rp = 0; return; |
|
|
LIST *rp; |
LIST *rp; |
{ |
{ |
STRING str; |
STRING str; |
unsigned char *p; |
char *p; |
int len,i; |
int len,i; |
NODE n,n1; |
NODE n,n1; |
Z q; |
Z q; |
|
|
p = BDY(str); |
p = BDY(str); |
len = strlen(p); |
len = strlen(p); |
for ( i = len-1, n = 0; i >= 0; i-- ) { |
for ( i = len-1, n = 0; i >= 0; i-- ) { |
UTOQ((unsigned int)p[i],q); |
UTOZ((unsigned int)p[i],q); |
MKNODE(n1,q,n); |
MKNODE(n1,q,n); |
n = n1; |
n = n1; |
} |
} |
|
|
for ( i = 0; i < len; i++, n = NEXT(n) ) { |
for ( i = 0; i < len; i++, n = NEXT(n) ) { |
q = (Z)BDY(n); |
q = (Z)BDY(n); |
asir_assert(q,O_N,"asciitostr"); |
asir_assert(q,O_N,"asciitostr"); |
j = QTOS(q); |
j = ZTOS(q); |
if ( j >= 256 || j <= 0 ) |
if ( j >= 256 || j <= 0 ) |
error("asciitostr : argument out of range"); |
error("asciitostr : argument out of range"); |
p[i] = j; |
p[i] = j; |
Line 1677 void fnodetotex_tb(FNODE f,TB tb) |
|
Line 1679 void fnodetotex_tb(FNODE f,TB tb) |
|
fnodetotex_tb((FNODE)FA1(f),tb); |
fnodetotex_tb((FNODE)FA1(f),tb); |
write_tb(")",tb); |
write_tb(")",tb); |
return; |
return; |
|
default: |
|
return; |
} |
} |
break; |
break; |
|
|
Line 1829 void fnodetotex_tb(FNODE f,TB tb) |
|
Line 1833 void fnodetotex_tb(FNODE f,TB tb) |
|
|
|
default: |
default: |
error("fnodetotex_tb : not implemented yet"); |
error("fnodetotex_tb : not implemented yet"); |
|
return; |
} |
} |
} |
} |
|
|
Line 1962 void Psprintf(NODE arg,STRING *rp) |
|
Line 1967 void Psprintf(NODE arg,STRING *rp) |
|
if (argc < n) { |
if (argc < n) { |
error("sprintf: invalid argument"); |
error("sprintf: invalid argument"); |
} |
} |
r = (char *)MALLOC_ATOMIC(len); |
r = (char *)MALLOC_ATOMIC(len+1); |
for(node = NEXT(arg), t = r; *s; s++) { |
for(node = NEXT(arg), t = r; *s; s++) { |
if (*s=='%' && *(s+1)=='a') { |
if (*s=='%' && *(s+1)=='a') { |
strcpy(t,objtostr(BDY(node))); |
strcpy(t,objtostr(BDY(node))); |
Line 2098 void Pget_quote_id(NODE arg,Z *rp) |
|
Line 2103 void Pget_quote_id(NODE arg,Z *rp) |
|
if ( !q || OID(q) != O_QUOTE ) |
if ( !q || OID(q) != O_QUOTE ) |
error("get_quote_id : invalid argument"); |
error("get_quote_id : invalid argument"); |
f = BDY(q); |
f = BDY(q); |
STOQ((long)f->id,*rp); |
STOZ((long)f->id,*rp); |
} |
} |
|
|
void Pquote_to_funargs(NODE arg,LIST *rp) |
void Pquote_to_funargs(NODE arg,LIST *rp) |
Line 2126 void Pquote_to_funargs(NODE arg,LIST *rp) |
|
Line 2131 void Pquote_to_funargs(NODE arg,LIST *rp) |
|
if ( !spec ) |
if ( !spec ) |
error("quote_to_funargs : not supported yet"); |
error("quote_to_funargs : not supported yet"); |
t0 = 0; |
t0 = 0; |
STOQ((int)f->id,id); |
STOZ((int)f->id,id); |
NEXTNODE(t0,t); |
NEXTNODE(t0,t); |
BDY(t) = (pointer)id; |
BDY(t) = (pointer)id; |
for ( i = 0; spec->type[i] != A_end; i++ ) { |
for ( i = 0; spec->type[i] != A_end; i++ ) { |
Line 2137 void Pquote_to_funargs(NODE arg,LIST *rp) |
|
Line 2142 void Pquote_to_funargs(NODE arg,LIST *rp) |
|
BDY(t) = (pointer)r; |
BDY(t) = (pointer)r; |
break; |
break; |
case A_int: |
case A_int: |
STOQ((long)f->arg[i],a); |
STOZ((long)f->arg[i],a); |
BDY(t) = (pointer)a; |
BDY(t) = (pointer)a; |
break; |
break; |
case A_str: |
case A_str: |
Line 2186 void Pfunargs_to_quote(NODE arg,QUOTE *rp) |
|
Line 2191 void Pfunargs_to_quote(NODE arg,QUOTE *rp) |
|
if ( !l || OID(l) != O_LIST || !(t=BDY(l)) ) |
if ( !l || OID(l) != O_LIST || !(t=BDY(l)) ) |
error("funargs_to_quote : invalid argument"); |
error("funargs_to_quote : invalid argument"); |
t = BDY(l); |
t = BDY(l); |
id = (fid)QTOS((Q)BDY(t)); t = NEXT(t); |
id = (fid)ZTOS((Q)BDY(t)); t = NEXT(t); |
get_fid_spec(id,&spec); |
get_fid_spec(id,&spec); |
if ( !spec ) |
if ( !spec ) |
error("funargs_to_quote : not supported yet"); |
error("funargs_to_quote : not supported yet"); |
Line 2206 void Pfunargs_to_quote(NODE arg,QUOTE *rp) |
|
Line 2211 void Pfunargs_to_quote(NODE arg,QUOTE *rp) |
|
case A_int: |
case A_int: |
if ( !INT(a) ) |
if ( !INT(a) ) |
error("funargs_to_quote : invalid argument"); |
error("funargs_to_quote : invalid argument"); |
f->arg[i] = (pointer)QTOS((Q)a); |
f->arg[i] = (pointer)ZTOS((Q)a); |
break; |
break; |
case A_str: |
case A_str: |
if ( !a || OID(a) != O_STR ) |
if ( !a || OID(a) != O_STR ) |
Line 2319 void Pqt_set_weight(NODE arg,LIST *rp) |
|
Line 2324 void Pqt_set_weight(NODE arg,LIST *rp) |
|
for ( i = 0; i < l; i++, n = NEXT(n) ) { |
for ( i = 0; i < l; i++, n = NEXT(n) ) { |
pair = BDY((LIST)BDY(n)); |
pair = BDY((LIST)BDY(n)); |
tab[i].v = VR((P)ARG0(pair)); |
tab[i].v = VR((P)ARG0(pair)); |
tab[i].w = QTOS((Q)ARG1(pair)); |
tab[i].w = ZTOS((Q)ARG1(pair)); |
} |
} |
tab[i].v = 0; |
tab[i].v = 0; |
qt_current_weight_obj = (LIST)ARG0(arg); |
qt_current_weight_obj = (LIST)ARG0(arg); |
Line 2364 void Pqt_normalize(NODE arg,QUOTE *rp) |
|
Line 2369 void Pqt_normalize(NODE arg,QUOTE *rp) |
|
if ( !ac ) error("qt_normalize : invalid argument"); |
if ( !ac ) error("qt_normalize : invalid argument"); |
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
if ( ac == 2 ) |
if ( ac == 2 ) |
expand = QTOS((Q)ARG1(arg)); |
expand = ZTOS((Q)ARG1(arg)); |
if ( !q || OID(q) != O_QUOTE ) |
if ( !q || OID(q) != O_QUOTE ) |
*rp = q; |
*rp = q; |
else { |
else { |
Line 2541 void Pnbm_deg(NODE arg, Z *rp) |
|
Line 2546 void Pnbm_deg(NODE arg, Z *rp) |
|
|
|
p = (NBP)ARG0(arg); |
p = (NBP)ARG0(arg); |
if ( !p ) |
if ( !p ) |
STOQ(-1,*rp); |
STOZ(-1,*rp); |
else { |
else { |
m = (NBM)BDY(BDY(p)); |
m = (NBM)BDY(BDY(p)); |
STOQ(m->d,*rp); |
STOZ(m->d,*rp); |
} |
} |
} |
} |
|
|
Line 2557 void Pnbm_index(NODE arg, Z *rp) |
|
Line 2562 void Pnbm_index(NODE arg, Z *rp) |
|
|
|
p = (NBP)ARG0(arg); |
p = (NBP)ARG0(arg); |
if ( !p ) |
if ( !p ) |
STOQ(0,*rp); |
STOZ(0,*rp); |
else { |
else { |
m = (NBM)BDY(BDY(p)); |
m = (NBM)BDY(BDY(p)); |
d = m->d; |
d = m->d; |
Line 2566 void Pnbm_index(NODE arg, Z *rp) |
|
Line 2571 void Pnbm_index(NODE arg, Z *rp) |
|
b = m->b; |
b = m->b; |
for ( r = 0, i = d-2; i > 0; i-- ) |
for ( r = 0, i = d-2; i > 0; i-- ) |
if ( !NBM_GET(b,i) ) r |= (1<<(d-2-i)); |
if ( !NBM_GET(b,i) ) r |= (1<<(d-2-i)); |
STOQ(r,*rp); |
STOZ(r,*rp); |
} |
} |
} |
} |
|
|
Line 2583 void Pnbm_hp_rest(NODE arg, LIST *rp) |
|
Line 2588 void Pnbm_hp_rest(NODE arg, LIST *rp) |
|
MKLIST(*rp,0); |
MKLIST(*rp,0); |
else { |
else { |
m = (NBM)BDY(BDY(p)); |
m = (NBM)BDY(BDY(p)); |
b = m->b; d = m->d; |
b = (int *)m->b; d = m->d; |
if ( !d ) |
if ( !d ) |
MKLIST(*rp,0); |
MKLIST(*rp,0); |
else { |
else { |
Line 2591 void Pnbm_hp_rest(NODE arg, LIST *rp) |
|
Line 2596 void Pnbm_hp_rest(NODE arg, LIST *rp) |
|
for ( i = 1; i < d; i++ ) |
for ( i = 1; i < d; i++ ) |
if ( NBM_GET(b,i) != v ) break; |
if ( NBM_GET(b,i) != v ) break; |
NEWNBM(m1); NEWNBMBDY(m1,i); |
NEWNBM(m1); NEWNBMBDY(m1,i); |
b1 = m1->b; m1->d = i; m1->c = (P)ONE; |
b1 = (int *)m1->b; m1->d = i; m1->c = (P)ONE; |
if ( v ) for ( j = 0; j < i; j++ ) NBM_SET(b1,j); |
if ( v ) for ( j = 0; j < i; j++ ) NBM_SET(b1,j); |
else for ( j = 0; j < i; j++ ) NBM_CLR(b1,j); |
else for ( j = 0; j < i; j++ ) NBM_CLR(b1,j); |
MKNODE(n,m1,0); MKNBP(h,n); |
MKNODE(n,m1,0); MKNBP(h,n); |
|
|
d1 = d-i; |
d1 = d-i; |
NEWNBM(m1); NEWNBMBDY(m1,d1); |
NEWNBM(m1); NEWNBMBDY(m1,d1); |
b1 = m1->b; m1->d = d1; m1->c = (P)ONE; |
b1 = (int *)m1->b; m1->d = d1; m1->c = (P)ONE; |
for ( j = 0, k = i; j < d1; j++, k++ ) |
for ( j = 0, k = i; j < d1; j++, k++ ) |
if ( NBM_GET(b,k) ) NBM_SET(b1,j); |
if ( NBM_GET(b,k) ) NBM_SET(b1,j); |
else NBM_CLR(b1,j); |
else NBM_CLR(b1,j); |
Line 2717 NBP fnode_to_nbp(FNODE f) |
|
Line 2722 NBP fnode_to_nbp(FNODE f) |
|
pwrnbp(CO,u,r,&u1); |
pwrnbp(CO,u,r,&u1); |
return u1; |
return u1; |
} |
} |
|
/* XXX */ |
|
return 0; |
} |
} |
|
|
void Pnqt_weight(NODE arg,Z *rp) |
void Pnqt_weight(NODE arg,Z *rp) |
Line 2728 void Pnqt_weight(NODE arg,Z *rp) |
|
Line 2735 void Pnqt_weight(NODE arg,Z *rp) |
|
q = (QUOTE)ARG0(arg); f = (FNODE)BDY(q); |
q = (QUOTE)ARG0(arg); f = (FNODE)BDY(q); |
f = fnode_normalize(f,0); |
f = fnode_normalize(f,0); |
w = nfnode_weight(qt_weight_tab,f); |
w = nfnode_weight(qt_weight_tab,f); |
STOQ(w,*rp); |
STOZ(w,*rp); |
} |
} |
|
|
void Pnqt_comp(NODE arg,Z *rp) |
void Pnqt_comp(NODE arg,Z *rp) |
Line 2742 void Pnqt_comp(NODE arg,Z *rp) |
|
Line 2749 void Pnqt_comp(NODE arg,Z *rp) |
|
f1 = fnode_normalize(f1,0); |
f1 = fnode_normalize(f1,0); |
f2 = fnode_normalize(f2,0); |
f2 = fnode_normalize(f2,0); |
r = nfnode_comp(f1,f2); |
r = nfnode_comp(f1,f2); |
STOQ(r,*rp); |
STOZ(r,*rp); |
} |
} |
|
|
int fnode_is_var(FNODE f) |
int fnode_is_var(FNODE f) |
Line 2957 FNODE fnode_normalize(FNODE f,int expand) |
|
Line 2964 FNODE fnode_normalize(FNODE f,int expand) |
|
Z q; |
Z q; |
|
|
if ( f->normalized && (f->expanded == expand) ) return f; |
if ( f->normalized && (f->expanded == expand) ) return f; |
STOQ(-1,q); |
STOZ(-1,q); |
mone = mkfnode(1,I_FORMULA,q); |
mone = mkfnode(1,I_FORMULA,q); |
switch ( f->id ) { |
switch ( f->id ) { |
case I_PAREN: |
case I_PAREN: |
Line 3217 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand) |
|
Line 3224 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand) |
|
fnode_coef_body(f1,&c1,&b1); |
fnode_coef_body(f1,&c1,&b1); |
nf2 = (Num)eval(f2); |
nf2 = (Num)eval(f2); |
arf_pwr(CO,c1,(Obj)nf2,&c); |
arf_pwr(CO,c1,(Obj)nf2,&c); |
ee = QTOS((Q)nf2); |
ee = ZTOS((Q)nf2); |
cc = mkfnode(1,I_FORMULA,c); |
cc = mkfnode(1,I_FORMULA,c); |
if ( fnode_is_nonnegative_integer(f2) ) |
if ( fnode_is_nonnegative_integer(f2) ) |
b = fnode_expand_pwr(b1,ee,expand); |
b = fnode_expand_pwr(b1,ee,expand); |
else { |
else { |
STOQ(-1,q); |
STOZ(-1,q); |
mone = mkfnode(1,I_FORMULA,q); |
mone = mkfnode(1,I_FORMULA,q); |
b1 = to_narymul(b1); |
b1 = to_narymul(b1); |
for ( t0 = 0, n = (NODE)FA1(b1); n; n = NEXT(n) ) { |
for ( t0 = 0, n = (NODE)FA1(b1); n; n = NEXT(n) ) { |
Line 3240 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand) |
|
Line 3247 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand) |
|
&& fnode_is_nonnegative_integer(f2) ) { |
&& fnode_is_nonnegative_integer(f2) ) { |
q = (Z)eval(f2); |
q = (Z)eval(f2); |
if ( !smallz(q) ) error("nfnode_pwr : exponent too large"); |
if ( !smallz(q) ) error("nfnode_pwr : exponent too large"); |
return fnode_expand_pwr(f1,QTOS(q),expand); |
return fnode_expand_pwr(f1,ZTOS(q),expand); |
} else |
} else |
return mkfnode(3,I_BOP,pwrfs,f1,f2); |
return mkfnode(3,I_BOP,pwrfs,f1,f2); |
} |
} |
Line 3267 FNODE fnode_expand_pwr(FNODE f,int n,int expand) |
|
Line 3274 FNODE fnode_expand_pwr(FNODE f,int n,int expand) |
|
f1 = nfnode_mul(f1,f,expand); |
f1 = nfnode_mul(f1,f,expand); |
return f1; |
return f1; |
case 0: default: |
case 0: default: |
STOQ(n,q); |
STOZ(n,q); |
fn = mkfnode(1,I_FORMULA,q); |
fn = mkfnode(1,I_FORMULA,q); |
return mkfnode(3,I_BOP,pwrfs,f,fn); |
return mkfnode(3,I_BOP,pwrfs,f,fn); |
} |
} |
Line 3341 FNODE nfnode_mul_coef(Obj c,FNODE f,int expand) |
|
Line 3348 FNODE nfnode_mul_coef(Obj c,FNODE f,int expand) |
|
return fnode_node_to_nary(mulfs,mknode(2,cc,b1)); |
return fnode_node_to_nary(mulfs,mknode(2,cc,b1)); |
} |
} |
} |
} |
|
/* XXX */ |
|
return 0; |
} |
} |
|
|
void fnode_coef_body(FNODE f,Obj *cp,FNODE *bp) |
void fnode_coef_body(FNODE f,Obj *cp,FNODE *bp) |
Line 3408 int nfnode_weight(struct wtab *tab,FNODE f) |
|
Line 3417 int nfnode_weight(struct wtab *tab,FNODE f) |
|
/* XXX w(2^x)=0 ? */ |
/* XXX w(2^x)=0 ? */ |
if ( fnode_is_rational(FA2(f)) ) { |
if ( fnode_is_rational(FA2(f)) ) { |
a2 = (Q)eval(FA2(f)); |
a2 = (Q)eval(FA2(f)); |
w = QTOS(a2); |
w = ZTOS(a2); |
} else |
} else |
w = nfnode_weight(tab,FA2(f)); |
w = nfnode_weight(tab,FA2(f)); |
return nfnode_weight(tab,FA1(f))*w; |
return nfnode_weight(tab,FA1(f))*w; |
default: |
default: |
error("nfnode_weight : not_implemented"); |
error("nfnode_weight : not_implemented"); |
|
return 0; |
} |
} |
} |
} |
|
|
Line 3470 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
Line 3480 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
if ( IS_BINARYPWR(f1) || IS_BINARYPWR(f2) ) { |
if ( IS_BINARYPWR(f1) || IS_BINARYPWR(f2) ) { |
fnode_base_exp(f1,&b1,&e1); |
fnode_base_exp(f1,&b1,&e1); |
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) ) != 0 ) { |
if ( r > 0 ) |
if ( r > 0 ) |
return nfnode_comp_lex(e1,mkfnode(1,I_FORMULA,NULLP)); |
return nfnode_comp_lex(e1,mkfnode(1,I_FORMULA,NULLP)); |
else if ( r < 0 ) |
else if ( r < 0 ) |
Line 3506 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
Line 3516 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
/* compare args */ |
/* compare args */ |
n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2)); |
n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2)); |
while ( n1 && n2 ) |
while ( n1 && n2 ) |
if ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) return r; |
if ( ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) != 0 ) return r; |
else { |
else { |
n1 = NEXT(n1); n2 = NEXT(n2); |
n1 = NEXT(n1); n2 = NEXT(n2); |
} |
} |
Line 3544 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
Line 3554 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
/* compare args */ |
/* compare args */ |
n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2)); |
n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2)); |
while ( n1 && n2 ) |
while ( n1 && n2 ) |
if ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) return r; |
if ( ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) != 0 ) return r; |
else { |
else { |
n1 = NEXT(n1); n2 = NEXT(n2); |
n1 = NEXT(n1); n2 = NEXT(n2); |
} |
} |
Line 3554 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
Line 3564 int nfnode_comp_lex(FNODE f1,FNODE f2) |
|
|
|
default: |
default: |
error("nfnode_comp_lex : undefined"); |
error("nfnode_comp_lex : undefined"); |
|
return 0; |
} |
} |
break; |
break; |
default: |
default: |
error("nfnode_comp_lex : undefined"); |
error("nfnode_comp_lex : undefined"); |
|
return 0; |
} |
} |
|
return 0; |
} |
} |
|
|
NODE append_node(NODE a1,NODE a2) |
NODE append_node(NODE a1,NODE a2) |
Line 3661 int nfnode_match(FNODE f,FNODE pat,NODE *rp) |
|
Line 3674 int nfnode_match(FNODE f,FNODE pat,NODE *rp) |
|
|
|
default: |
default: |
error("nfnode_match : invalid pattern"); |
error("nfnode_match : invalid pattern"); |
|
return 0; |
} |
} |
|
return 0; |
} |
} |
|
|
/* remove i-th element */ |
/* remove i-th element */ |
Line 3684 FNODE fnode_removeith_naryadd(FNODE p,int i) |
|
Line 3699 FNODE fnode_removeith_naryadd(FNODE p,int i) |
|
NEXT(r) = NEXT(t); |
NEXT(r) = NEXT(t); |
return fnode_node_to_nary(addfs,r0); |
return fnode_node_to_nary(addfs,r0); |
} |
} |
|
/* XXX */ |
|
return 0; |
} |
} |
|
|
/* a0,...,a(i-1) */ |
/* a0,...,a(i-1) */ |
Line 3883 NODE nfnode_pvars(FNODE pat,NODE found) |
|
Line 3899 NODE nfnode_pvars(FNODE pat,NODE found) |
|
|
|
default: |
default: |
error("nfnode_match : invalid pattern"); |
error("nfnode_match : invalid pattern"); |
|
return 0; |
} |
} |
} |
} |