version 1.106, 2005/12/10 14:14:15 |
version 1.107, 2005/12/11 05:27:30 |
|
|
* 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.105 2005/12/09 08:10:44 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.106 2005/12/10 14:14:15 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
Line 109 void Pnbm_hxky(), Pnbm_xky_rest(); |
|
Line 109 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 Pqt_match(),Pget_quote_id(),Pqt_match_rewrite(); |
void Pqt_match(),Pget_quote_id(); |
void Pqt_to_nary(),Pqt_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); |
Line 137 void fnode_coef_body(FNODE f,Num *cp,FNODE *bp); |
|
Line 137 void fnode_coef_body(FNODE f,Num *cp,FNODE *bp); |
|
FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNODE a,int mode); |
FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNODE a,int mode); |
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); |
|
FNODE rewrite_fnode(FNODE f,NODE arg,int qarg); |
|
|
struct ftab str_tab[] = { |
struct ftab str_tab[] = { |
{"sprintf",Psprintf,-99999999}, |
{"sprintf",Psprintf,-99999999}, |
Line 163 struct ftab str_tab[] = { |
|
Line 164 struct ftab str_tab[] = { |
|
{"qt_set_ord",Pqt_set_ord,-1}, |
{"qt_set_ord",Pqt_set_ord,-1}, |
{"qt_normalize",Pqt_normalize,-2}, |
{"qt_normalize",Pqt_normalize,-2}, |
{"qt_match",Pqt_match,2}, |
{"qt_match",Pqt_match,2}, |
{"qt_match_rewrite",Pqt_match_rewrite,-4}, |
|
{"nqt_match_rewrite",Pnqt_match_rewrite,3}, |
{"nqt_match_rewrite",Pnqt_match_rewrite,3}, |
|
|
{"nqt_comp",Pnqt_comp,2}, |
{"nqt_comp",Pnqt_comp,2}, |
Line 710 void Pnqt_match(NODE arg,Q *rp) |
|
Line 710 void Pnqt_match(NODE arg,Q *rp) |
|
*rp = 0; |
*rp = 0; |
} |
} |
|
|
|
|
FNODE rewrite_fnode(FNODE,NODE,int); |
|
|
|
extern Obj VOIDobj; |
|
|
|
void Pqt_match_rewrite(NODE arg,Obj *rp) |
|
{ |
|
FNODE f,g,h,c,value; |
|
Obj obj; |
|
QUOTE q; |
|
NODE r,t,s,s0,pair; |
|
int ret,ind,ac; |
|
|
|
obj = (Obj)ARG0(arg); |
|
ret = qt_match(obj,(Obj)ARG1(arg),&r); |
|
if ( ret ) { |
|
for ( t = r, s0 = 0; t; t = NEXT(t) ) { |
|
NEXTNODE(s0,s); |
|
pair = BDY((LIST)BDY(t)); |
|
ind = (int)FA0((FNODE)BDY((QUOTE)BDY(pair))); |
|
value = BDY((QUOTE)(BDY(NEXT(pair)))); |
|
BDY(s) = mknode(2,ind,value); |
|
} |
|
if ( s0 ) NEXT(s) = 0; |
|
switch ( ac = argc(arg) ) { |
|
case 3: |
|
h = rewrite_fnode(BDY((QUOTE)ARG2(arg)),s0,0); |
|
MKQUOTE(q,h); *rp = (Obj)q; |
|
break; |
|
case 4: |
|
c = rewrite_fnode(BDY((QUOTE)ARG2(arg)),s0,0); |
|
if ( eval(c) ) { |
|
h = rewrite_fnode(BDY((QUOTE)ARG3(arg)),s0,0); |
|
MKQUOTE(q,h); *rp = (Obj)q; |
|
} else |
|
*rp = VOIDobj; |
|
break; |
|
default: |
|
error("qt_match_rewrite : invalid argument"); |
|
} |
|
} else |
|
*rp = VOIDobj; |
|
} |
|
|
|
void Pnqt_match_rewrite(NODE arg,Obj *rp) |
void Pnqt_match_rewrite(NODE arg,Obj *rp) |
{ |
{ |
FNODE f,p,c,a,r; |
FNODE f,p,c,a,r; |
Line 800 FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNO |
|
Line 756 FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNO |
|
ARF op; |
ARF op; |
NODE arg,h0,t,h,valuen; |
NODE arg,h0,t,h,valuen; |
NODE r,s0,s,pair; |
NODE r,s0,s,pair; |
FNODE any,pany,head,tail,a1; |
FNODE any,pany,head,tail,a1,a2; |
QUOTE q; |
QUOTE q; |
int ret; |
int ret; |
FNODE value; |
FNODE value; |
Line 841 FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNO |
|
Line 797 FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNO |
|
ret = nfnode_match(f,p,&r) && eval(rewrite_fnode(c,r,1)); |
ret = nfnode_match(f,p,&r) && eval(rewrite_fnode(c,r,1)); |
|
|
if ( ret ) { |
if ( ret ) { |
a1 = rewrite_fnode(a,r,1); |
a1 = rewrite_fnode(a,r,0); |
return fnode_normalize(partial_eval(a1),mode); |
a2 = partial_eval(a1); |
|
return fnode_normalize(a2,mode); |
} else |
} else |
return 0; |
return 0; |
} |
} |