version 1.103, 2005/11/30 04:51:46 |
version 1.105, 2005/12/09 08:10:44 |
|
|
* 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.102 2005/11/27 00:07:05 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.104 2005/11/30 05:08:00 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
Line 92 void Pquotetotex(); |
|
Line 92 void Pquotetotex(); |
|
void Pquotetotex_env(); |
void Pquotetotex_env(); |
void Pflatten_quote(); |
void Pflatten_quote(); |
|
|
void Pquote_is_integer(),Pquote_is_rational(),Pquote_is_number(); |
void Pqt_is_integer(),Pqt_is_rational(),Pqt_is_number(); |
void Pquote_is_dependent(),Pquote_is_function(); |
void Pqt_is_dependent(),Pqt_is_function(); |
void Pquote_normalize(); |
void Pqt_set_ord(); |
void Pnquote_comp(); |
void Pqt_normalize(); |
void Pnquote_match(); |
void Pnqt_comp(); |
|
void Pnqt_match(); |
|
|
void Pquote_to_nbp(); |
void Pqt_to_nbp(); |
void Pshuffle_mul(), Pharmonic_mul(); |
void Pshuffle_mul(), Pharmonic_mul(); |
void Pnbp_hm(), Pnbp_ht(), Pnbp_hc(), Pnbp_rest(); |
void Pnbp_hm(), Pnbp_ht(), Pnbp_hc(), Pnbp_rest(); |
void Pnbm_deg(); |
void Pnbm_deg(); |
Line 107 void Pnbm_hxky(), Pnbm_xky_rest(); |
|
Line 108 void Pnbm_hxky(), Pnbm_xky_rest(); |
|
void Pnbm_hv(), Pnbm_rest(); |
void Pnbm_hv(), Pnbm_rest(); |
|
|
void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name(); |
void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name(); |
void Pquote_match(),Pget_quote_id(),Pquote_match_rewrite(); |
void Pqt_match(),Pget_quote_id(),Pqt_match_rewrite(); |
void Pquote_to_nary(),Pquote_to_bin(); |
void Pqt_to_nary(),Pqt_to_bin(); |
void fnode_do_assign(NODE arg); |
void fnode_do_assign(NODE arg); |
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 120 void tb_to_string(TB tb,STRING *rp); |
|
Line 121 void tb_to_string(TB tb,STRING *rp); |
|
void fnodenodetotex_tb(NODE n,TB tb); |
void fnodenodetotex_tb(NODE n,TB tb); |
void fargstotex_tb(char *opname,FNODE f,TB tb); |
void fargstotex_tb(char *opname,FNODE f,TB tb); |
int top_is_minus(FNODE f); |
int top_is_minus(FNODE f); |
int quote_match(Obj f,Obj pat,NODE *rp); |
int qt_match(Obj f,Obj pat,NODE *rp); |
|
|
struct ftab str_tab[] = { |
struct ftab str_tab[] = { |
{"sprintf",Psprintf,-99999999}, |
{"sprintf",Psprintf,-99999999}, |
Line 138 struct ftab str_tab[] = { |
|
Line 139 struct ftab str_tab[] = { |
|
{"string_to_tb",Pstring_to_tb,1}, |
{"string_to_tb",Pstring_to_tb,1}, |
{"get_quote_id",Pget_quote_id,1}, |
{"get_quote_id",Pget_quote_id,1}, |
|
|
{"quote_is_number",Pquote_is_number,1}, |
{"qt_is_number",Pqt_is_number,1}, |
{"quote_is_rational",Pquote_is_rational,1}, |
{"qt_is_rational",Pqt_is_rational,1}, |
{"quote_is_integer",Pquote_is_integer,1}, |
{"qt_is_integer",Pqt_is_integer,1}, |
{"quote_is_function",Pquote_is_function,1}, |
{"qt_is_function",Pqt_is_function,1}, |
{"quote_is_dependent",Pquote_is_dependent,2}, |
{"qt_is_dependent",Pqt_is_dependent,2}, |
|
|
{"quote_normalize",Pquote_normalize,-2}, |
{"qt_set_ord",Pqt_set_ord,-1}, |
{"quote_match",Pquote_match,2}, |
{"qt_normalize",Pqt_normalize,-2}, |
{"quote_match_rewrite",Pquote_match_rewrite,-4}, |
{"qt_match",Pqt_match,2}, |
|
{"qt_match_rewrite",Pqt_match_rewrite,-4}, |
|
|
{"nquote_comp",Pnquote_comp,2}, |
{"nqt_comp",Pnqt_comp,2}, |
{"nquote_match",Pnquote_match,2}, |
{"nqt_match",Pnqt_match,-3}, |
{"quote_to_nbp",Pquote_to_nbp,1}, |
{"qt_to_nbp",Pqt_to_nbp,1}, |
{"shuffle_mul",Pshuffle_mul,2}, |
{"shuffle_mul",Pshuffle_mul,2}, |
{"harmonic_mul",Pharmonic_mul,2}, |
{"harmonic_mul",Pharmonic_mul,2}, |
|
|
Line 165 struct ftab str_tab[] = { |
|
Line 167 struct ftab str_tab[] = { |
|
{"nbm_hv", Pnbm_hv,1}, |
{"nbm_hv", Pnbm_hv,1}, |
{"nbm_rest", Pnbm_rest,1}, |
{"nbm_rest", Pnbm_rest,1}, |
|
|
{"quote_to_nary",Pquote_to_nary,1}, |
{"qt_to_nary",Pqt_to_nary,1}, |
{"quote_to_bin",Pquote_to_bin,2}, |
{"qt_to_bin",Pqt_to_bin,2}, |
|
|
{"quotetotex_tb",Pquotetotex_tb,2}, |
{"quotetotex_tb",Pquotetotex_tb,2}, |
{"quotetotex",Pquotetotex,1}, |
{"quotetotex",Pquotetotex,1}, |
Line 572 void Pwrite_to_tb(NODE arg,Q *rp) |
|
Line 574 void Pwrite_to_tb(NODE arg,Q *rp) |
|
|
|
FNODE partial_eval(FNODE), fnode_to_nary(FNODE), fnode_to_bin(FNODE,int); |
FNODE partial_eval(FNODE), fnode_to_nary(FNODE), fnode_to_bin(FNODE,int); |
|
|
void Pquote_to_nary(NODE arg,QUOTE *rp) |
void Pqt_to_nary(NODE arg,QUOTE *rp) |
{ |
{ |
FNODE f; |
FNODE f; |
|
|
Line 580 void Pquote_to_nary(NODE arg,QUOTE *rp) |
|
Line 582 void Pquote_to_nary(NODE arg,QUOTE *rp) |
|
MKQUOTE(*rp,f); |
MKQUOTE(*rp,f); |
} |
} |
|
|
void Pquote_to_bin(NODE arg,QUOTE *rp) |
void Pqt_to_bin(NODE arg,QUOTE *rp) |
{ |
{ |
FNODE f; |
FNODE f; |
int direction; |
int direction; |
Line 591 void Pquote_to_bin(NODE arg,QUOTE *rp) |
|
Line 593 void Pquote_to_bin(NODE arg,QUOTE *rp) |
|
MKQUOTE(*rp,f); |
MKQUOTE(*rp,f); |
} |
} |
|
|
void Pquote_is_number(NODE arg,Q *rp) |
void Pqt_is_number(NODE arg,Q *rp) |
{ |
{ |
QUOTE q; |
QUOTE q; |
int ret; |
int ret; |
|
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"quote_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); |
STOQ(ret,*rp); |
} |
} |
|
|
void Pquote_is_rational(NODE arg,Q *rp) |
void Pqt_is_rational(NODE arg,Q *rp) |
{ |
{ |
QUOTE q; |
QUOTE q; |
int ret; |
int ret; |
|
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"quote_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); |
STOQ(ret,*rp); |
} |
} |
|
|
void Pquote_is_integer(NODE arg,Q *rp) |
void Pqt_is_integer(NODE arg,Q *rp) |
{ |
{ |
QUOTE q; |
QUOTE q; |
int ret; |
int ret; |
|
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"quote_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); |
STOQ(ret,*rp); |
} |
} |
|
|
void Pquote_is_function(NODE arg,Q *rp) |
void Pqt_is_function(NODE arg,Q *rp) |
{ |
{ |
QUOTE q; |
QUOTE q; |
int ret; |
int ret; |
|
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
asir_assert(q,O_QUOTE,"quote_is_function"); |
asir_assert(q,O_QUOTE,"qt_is_function"); |
if ( q->id == I_FUNC || q->id == I_IFUNC ) |
if ( q->id == I_FUNC || q->id == I_IFUNC ) |
ret = 1; |
ret = 1; |
else |
else |
Line 638 void Pquote_is_function(NODE arg,Q *rp) |
|
Line 640 void Pquote_is_function(NODE arg,Q *rp) |
|
STOQ(ret,*rp); |
STOQ(ret,*rp); |
} |
} |
|
|
void Pquote_is_dependent(NODE arg,Q *rp) |
void Pqt_is_dependent(NODE arg,Q *rp) |
{ |
{ |
P x; |
P x; |
QUOTE q,v; |
QUOTE q,v; |
Line 647 void Pquote_is_dependent(NODE arg,Q *rp) |
|
Line 649 void Pquote_is_dependent(NODE arg,Q *rp) |
|
|
|
q = (QUOTE)ARG0(arg); |
q = (QUOTE)ARG0(arg); |
v = (QUOTE)ARG1(arg); |
v = (QUOTE)ARG1(arg); |
asir_assert(q,O_QUOTE,"quote_is_dependent"); |
asir_assert(q,O_QUOTE,"qt_is_dependent"); |
asir_assert(v,O_QUOTE,"quote_is_dependent"); |
asir_assert(v,O_QUOTE,"qt_is_dependent"); |
x = (P)eval(BDY(v)); |
x = (P)eval(BDY(v)); |
if ( !x || OID(x) != O_P ) |
if ( !x || OID(x) != O_P ) |
*rp = 0; |
*rp = 0; |
Line 658 void Pquote_is_dependent(NODE arg,Q *rp) |
|
Line 660 void Pquote_is_dependent(NODE arg,Q *rp) |
|
} |
} |
|
|
|
|
void Pquote_match(NODE arg,Q *rp) |
void Pqt_match(NODE arg,Q *rp) |
{ |
{ |
FNODE f,g; |
FNODE f,g; |
Obj obj; |
Obj obj; |
Line 669 void Pquote_match(NODE arg,Q *rp) |
|
Line 671 void Pquote_match(NODE arg,Q *rp) |
|
#if 0 |
#if 0 |
g = partial_eval(BDY(((QUOTE)ARG0(arg)))); |
g = partial_eval(BDY(((QUOTE)ARG0(arg)))); |
MKQUOTE(q,g); |
MKQUOTE(q,g); |
ret = quote_match((Obj)q,(Obj)ARG1(arg),&r); |
ret = qt_match((Obj)q,(Obj)ARG1(arg),&r); |
#else |
#else |
obj = (Obj)ARG0(arg); |
obj = (Obj)ARG0(arg); |
ret = quote_match(obj,(Obj)ARG1(arg),&r); |
ret = qt_match(obj,(Obj)ARG1(arg),&r); |
#endif |
#endif |
if ( ret ) { |
if ( ret ) { |
do_assign(r); |
do_assign(r); |
Line 681 void Pquote_match(NODE arg,Q *rp) |
|
Line 683 void Pquote_match(NODE arg,Q *rp) |
|
*rp = 0; |
*rp = 0; |
} |
} |
|
|
void Pnquote_match(NODE arg,Q *rp) |
void Pnqt_match(NODE arg,Q *rp) |
{ |
{ |
QUOTE fq,pq; |
QUOTE fq,pq; |
FNODE f,p; |
FNODE f,p; |
Q two; |
|
int ret; |
int ret; |
|
Q mode; |
NODE r; |
NODE r; |
|
|
STOQ(2,two); |
mode = argc(arg)==3 ? (Q)ARG2(arg) : 0; |
fq = (QUOTE)ARG0(arg); Pquote_normalize(mknode(2,fq,two),&fq); f = (FNODE)BDY(fq); |
fq = (QUOTE)ARG0(arg); Pqt_normalize(mknode(2,fq,mode),&fq); f = (FNODE)BDY(fq); |
pq = (QUOTE)ARG1(arg); Pquote_normalize(mknode(2,pq,two),&pq); p = (FNODE)BDY(pq); |
pq = (QUOTE)ARG1(arg); Pqt_normalize(mknode(2,pq,mode),&pq); p = (FNODE)BDY(pq); |
ret = nfnode_match(f,p,&r); |
ret = nfnode_match(f,p,&r); |
if ( ret ) { |
if ( ret ) { |
fnode_do_assign(r); |
fnode_do_assign(r); |
Line 705 FNODE rewrite_fnode(FNODE,NODE); |
|
Line 707 FNODE rewrite_fnode(FNODE,NODE); |
|
|
|
extern Obj VOIDobj; |
extern Obj VOIDobj; |
|
|
void Pquote_match_rewrite(NODE arg,Obj *rp) |
void Pqt_match_rewrite(NODE arg,Obj *rp) |
{ |
{ |
FNODE f,g,h,c,value; |
FNODE f,g,h,c,value; |
Obj obj; |
Obj obj; |
Line 714 void Pquote_match_rewrite(NODE arg,Obj *rp) |
|
Line 716 void Pquote_match_rewrite(NODE arg,Obj *rp) |
|
int ret,ind,ac; |
int ret,ind,ac; |
|
|
obj = (Obj)ARG0(arg); |
obj = (Obj)ARG0(arg); |
ret = quote_match(obj,(Obj)ARG1(arg),&r); |
ret = qt_match(obj,(Obj)ARG1(arg),&r); |
if ( ret ) { |
if ( ret ) { |
for ( t = r, s0 = 0; t; t = NEXT(t) ) { |
for ( t = r, s0 = 0; t; t = NEXT(t) ) { |
NEXTNODE(s0,s); |
NEXTNODE(s0,s); |
Line 738 void Pquote_match_rewrite(NODE arg,Obj *rp) |
|
Line 740 void Pquote_match_rewrite(NODE arg,Obj *rp) |
|
*rp = VOIDobj; |
*rp = VOIDobj; |
break; |
break; |
default: |
default: |
error("quote_match_rewrite : invalid argument"); |
error("qt_match_rewrite : invalid argument"); |
} |
} |
} else |
} else |
*rp = VOIDobj; |
*rp = VOIDobj; |
Line 818 int merge_matching_node(NODE n,NODE a,NODE *rp) |
|
Line 820 int merge_matching_node(NODE n,NODE a,NODE *rp) |
|
return 1; |
return 1; |
} |
} |
|
|
int quote_match_node(NODE f,NODE pat,NODE *rp) { |
int qt_match_node(NODE f,NODE pat,NODE *rp) { |
NODE r,a,tf,tp,r1; |
NODE r,a,tf,tp,r1; |
int ret; |
int ret; |
|
|
if ( length(f) != length(pat) ) return 0; |
if ( length(f) != length(pat) ) return 0; |
r = 0; |
r = 0; |
for ( tf = f, tp = pat; tf; tf = NEXT(tf), tp = NEXT(tp) ) { |
for ( tf = f, tp = pat; tf; tf = NEXT(tf), tp = NEXT(tp) ) { |
ret = quote_match((Obj)BDY(tf),(Obj)BDY(tp),&a); |
ret = qt_match((Obj)BDY(tf),(Obj)BDY(tp),&a); |
if ( !ret ) return 0; |
if ( !ret ) return 0; |
ret = merge_matching_node(r,a,&r1); |
ret = merge_matching_node(r,a,&r1); |
if ( !ret ) return 0; |
if ( !ret ) return 0; |
Line 837 int quote_match_node(NODE f,NODE pat,NODE *rp) { |
|
Line 839 int quote_match_node(NODE f,NODE pat,NODE *rp) { |
|
|
|
/* f = [a,b,c,...] pat = [X,Y,...] rpat matches the rest of f */ |
/* f = [a,b,c,...] pat = [X,Y,...] rpat matches the rest of f */ |
|
|
int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp) { |
int qt_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp) { |
QUOTE q; |
QUOTE q; |
Q id; |
Q id; |
FNODE fn; |
FNODE fn; |
Line 849 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp |
|
Line 851 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp |
|
if ( length(f) < length(pat) ) return 0; |
if ( length(f) < length(pat) ) return 0; |
r = 0; |
r = 0; |
for ( tf = f, tp = pat; tp; tf = NEXT(tf), tp = NEXT(tp) ) { |
for ( tf = f, tp = pat; tp; tf = NEXT(tf), tp = NEXT(tp) ) { |
ret = quote_match((Obj)BDY(tf),(Obj)BDY(tp),&a); |
ret = qt_match((Obj)BDY(tf),(Obj)BDY(tp),&a); |
if ( !ret ) return 0; |
if ( !ret ) return 0; |
ret = merge_matching_node(r,a,&r1); |
ret = merge_matching_node(r,a,&r1); |
if ( !ret ) return 0; |
if ( !ret ) return 0; |
Line 861 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp |
|
Line 863 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp |
|
MKLIST(alist,a); |
MKLIST(alist,a); |
arg = mknode(1,alist); |
arg = mknode(1,alist); |
Pfunargs_to_quote(arg,&q); |
Pfunargs_to_quote(arg,&q); |
ret = quote_match((Obj)q,rpat,&a); |
ret = qt_match((Obj)q,rpat,&a); |
if ( !ret ) return 0; |
if ( !ret ) return 0; |
ret = merge_matching_node(r,a,&r1); |
ret = merge_matching_node(r,a,&r1); |
if ( !ret ) return 0; |
if ( !ret ) return 0; |
Line 880 void get_quote_id_arg(QUOTE f,int *id,NODE *r) |
|
Line 882 void get_quote_id_arg(QUOTE f,int *id,NODE *r) |
|
|
|
/* *rp : [[quote(A),quote(1)],...] */ |
/* *rp : [[quote(A),quote(1)],...] */ |
|
|
int quote_match(Obj f, Obj pat, NODE *rp) |
int qt_match(Obj f, Obj pat, NODE *rp) |
{ |
{ |
NODE tf,tp,head,body; |
NODE tf,tp,head,body; |
NODE parg,farg,r; |
NODE parg,farg,r; |
Line 899 int quote_match(Obj f, Obj pat, NODE *rp) |
|
Line 901 int quote_match(Obj f, Obj pat, NODE *rp) |
|
return 0; |
return 0; |
else if ( OID(pat) == O_LIST ) { |
else if ( OID(pat) == O_LIST ) { |
if ( OID(f) == O_LIST ) |
if ( OID(f) == O_LIST ) |
return quote_match_node(BDY((LIST)f),BDY((LIST)pat),rp); |
return qt_match_node(BDY((LIST)f),BDY((LIST)pat),rp); |
else |
else |
return 0; |
return 0; |
} else if ( OID(pat) == O_QUOTE ) { |
} else if ( OID(pat) == O_QUOTE ) { |
Line 926 int quote_match(Obj f, Obj pat, NODE *rp) |
|
Line 928 int quote_match(Obj f, Obj pat, NODE *rp) |
|
|
|
tp = BDY((LIST)BDY(parg)); |
tp = BDY((LIST)BDY(parg)); |
if ( pid == I_LIST ) |
if ( pid == I_LIST ) |
return quote_match_node(tf,tp,rp); |
return qt_match_node(tf,tp,rp); |
else { |
else { |
rpat = (Obj)BDY(NEXT(parg)); |
rpat = (Obj)BDY(NEXT(parg)); |
return quote_match_cons(tf,tp,rpat,rp); |
return qt_match_cons(tf,tp,rpat,rp); |
} |
} |
|
|
case I_PVAR: |
case I_PVAR: |
Line 945 int quote_match(Obj f, Obj pat, NODE *rp) |
|
Line 947 int quote_match(Obj f, Obj pat, NODE *rp) |
|
if ( id == I_FUNC ) { |
if ( id == I_FUNC ) { |
r = mknode(2,BDY(parg),BDY(farg)); MKLIST(l,r); |
r = mknode(2,BDY(parg),BDY(farg)); MKLIST(l,r); |
head = mknode(1,l); |
head = mknode(1,l); |
ret = quote_match(BDY(NEXT(farg)), |
ret = qt_match(BDY(NEXT(farg)), |
BDY(NEXT(parg)),&body); |
BDY(NEXT(parg)),&body); |
if ( !ret ) return 0; |
if ( !ret ) return 0; |
else return merge_matching_node(head,body,rp); |
else return merge_matching_node(head,body,rp); |
Line 973 int quote_match(Obj f, Obj pat, NODE *rp) |
|
Line 975 int quote_match(Obj f, Obj pat, NODE *rp) |
|
get_quote_id_arg((QUOTE)pat,&pid,&parg); |
get_quote_id_arg((QUOTE)pat,&pid,&parg); |
get_quote_id_arg((QUOTE)f,&id,&farg); |
get_quote_id_arg((QUOTE)f,&id,&farg); |
if ( compqa(CO,BDY(farg),BDY(parg)) ) return 0; |
if ( compqa(CO,BDY(farg),BDY(parg)) ) return 0; |
return quote_match_node(NEXT(farg),NEXT(parg),rp); |
return qt_match_node(NEXT(farg),NEXT(parg),rp); |
|
|
default: |
default: |
if ( OID(f) != O_QUOTE ) return 0; |
if ( OID(f) != O_QUOTE ) return 0; |
Line 981 int quote_match(Obj f, Obj pat, NODE *rp) |
|
Line 983 int quote_match(Obj f, Obj pat, NODE *rp) |
|
if ( id != pid ) return 0; |
if ( id != pid ) return 0; |
get_quote_id_arg((QUOTE)pat,&pid,&parg); |
get_quote_id_arg((QUOTE)pat,&pid,&parg); |
get_quote_id_arg((QUOTE)f,&id,&farg); |
get_quote_id_arg((QUOTE)f,&id,&farg); |
return quote_match_node(farg,parg,rp); |
return qt_match_node(farg,parg,rp); |
} |
} |
} |
} |
} |
} |
Line 2051 void Pfunargs_to_quote(NODE arg,QUOTE *rp) |
|
Line 2053 void Pfunargs_to_quote(NODE arg,QUOTE *rp) |
|
FNODE fnode_apply(FNODE f,FNODE (*func)(),int expand); |
FNODE fnode_apply(FNODE f,FNODE (*func)(),int expand); |
FNODE fnode_normalize(FNODE f,int expand); |
FNODE fnode_normalize(FNODE f,int expand); |
|
|
void Pquote_normalize(NODE arg,QUOTE *rp) |
VL reordvars(VL vl0,NODE head) |
{ |
{ |
|
VL vl,svl,tvl; |
|
int i,j; |
|
NODE n; |
|
P t; |
|
V *va; |
|
V v; |
|
|
|
for ( vl = 0, i = 0, n = head; n; n = NEXT(n), i++ ) { |
|
NEXTVL(vl,tvl); |
|
if ( !(t = (P)BDY(n)) || (OID(t) != O_P) ) |
|
error("reordvars : invalid argument"); |
|
VR(tvl) = VR(t); |
|
} |
|
va = (V *)ALLOCA(i*sizeof(V)); |
|
for ( j = 0, svl = vl; j < i; j++, svl = NEXT(svl) ) |
|
va[j] = VR(svl); |
|
for ( svl = vl0; svl; svl = NEXT(svl) ) { |
|
v = VR(svl); |
|
for ( j = 0; j < i; j++ ) |
|
if ( v == va[j] ) |
|
break; |
|
if ( j == i ) { |
|
NEXTVL(vl,tvl); |
|
VR(tvl) = v; |
|
} |
|
} |
|
if ( vl ) |
|
NEXT(tvl) = 0; |
|
return vl; |
|
} |
|
|
|
VL qt_current_ord; |
|
LIST qt_current_ord_obj; |
|
|
|
void Pqt_set_ord(NODE arg,LIST *rp) |
|
{ |
|
NODE r0,r; |
|
VL vl; |
|
P v; |
|
|
|
if ( !argc(arg) ) |
|
*rp = qt_current_ord_obj; |
|
else { |
|
qt_current_ord = reordvars(CO,BDY((LIST)ARG0(arg))); |
|
for ( r0 = 0, vl = qt_current_ord; vl; vl = NEXT(vl) ) { |
|
NEXTNODE(r0,r); MKV(vl->v,v); BDY(r) = v; |
|
} |
|
if ( r0 ) NEXT(r) = 0; |
|
MKLIST(*rp,r0); |
|
qt_current_ord_obj = *rp; |
|
} |
|
} |
|
|
|
void Pqt_normalize(NODE arg,QUOTE *rp) |
|
{ |
QUOTE q,r; |
QUOTE q,r; |
FNODE f; |
FNODE f; |
int expand,ac; |
int expand,ac; |
|
|
ac = argc(arg); |
ac = argc(arg); |
if ( !ac ) error("quote_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 = QTOS((Q)ARG1(arg)); |
Line 2073 void Pquote_normalize(NODE arg,QUOTE *rp) |
|
Line 2130 void Pquote_normalize(NODE arg,QUOTE *rp) |
|
|
|
NBP fnode_to_nbp(FNODE f); |
NBP fnode_to_nbp(FNODE f); |
|
|
void Pquote_to_nbp(NODE arg,NBP *rp) |
void Pqt_to_nbp(NODE arg,NBP *rp) |
{ |
{ |
QUOTE q; |
QUOTE q; |
FNODE f; |
FNODE f; |
Line 2302 NBP fnode_to_nbp(FNODE f) |
|
Line 2359 NBP fnode_to_nbp(FNODE f) |
|
} |
} |
} |
} |
|
|
void Pnquote_comp(NODE arg,Q *rp) |
void Pnqt_comp(NODE arg,Q *rp) |
{ |
{ |
QUOTE q1,q2; |
QUOTE q1,q2; |
FNODE f1,f2; |
FNODE f1,f2; |
Line 2947 int nfnode_comp(FNODE f1,FNODE f2) |
|
Line 3004 int nfnode_comp(FNODE f1,FNODE f2) |
|
case I_FORMULA: |
case I_FORMULA: |
switch ( f2->id ) { |
switch ( f2->id ) { |
case I_FORMULA: |
case I_FORMULA: |
return arf_comp(CO,FA0(f1),FA0(f2)); |
return arf_comp(qt_current_ord?qt_current_ord:CO,FA0(f1),FA0(f2)); |
case I_FUNC: case I_IFUNC: case I_PVAR: |
case I_FUNC: case I_IFUNC: case I_PVAR: |
return -1; |
return -1; |
default: |
default: |