version 1.63, 2005/09/28 08:08:34 |
version 1.65, 2005/09/30 01:35:25 |
|
|
* 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.62 2005/09/27 09:32:22 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.64 2005/09/29 08:55:26 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
Line 79 void Pquotetotex_env(); |
|
Line 79 void Pquotetotex_env(); |
|
void Pflatten_quote(); |
void Pflatten_quote(); |
void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name(); |
void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name(); |
void Pquote_unify(),Pget_quote_id(); |
void Pquote_unify(),Pget_quote_id(); |
void Pquote_bin_to_nary(),Pquote_nary_to_bin(); |
void Pquote_to_nary(),Pquote_to_bin(); |
void do_assign(NODE arg); |
void do_assign(NODE arg); |
void fnodetotex_tb(FNODE f,TB tb); |
void fnodetotex_tb(FNODE f,TB tb); |
char *symbol_name(char *name); |
char *symbol_name(char *name); |
Line 107 struct ftab str_tab[] = { |
|
Line 107 struct ftab str_tab[] = { |
|
{"tb_to_string",Ptb_to_string,1}, |
{"tb_to_string",Ptb_to_string,1}, |
{"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_bin_to_nary",Pquote_bin_to_nary,1}, |
{"quote_to_nary",Pquote_to_nary,1}, |
{"quote_nary_to_bin",Pquote_nary_to_bin,2}, |
{"quote_to_bin",Pquote_to_bin,2}, |
{"quotetotex_tb",Pquotetotex_tb,2}, |
{"quotetotex_tb",Pquotetotex_tb,2}, |
{"quotetotex",Pquotetotex,1}, |
{"quotetotex",Pquotetotex,1}, |
{"quotetotex_env",Pquotetotex_env,-99999999}, |
{"quotetotex_env",Pquotetotex_env,-99999999}, |
{"flatten_quote",Pflatten_quote,2}, |
{"flatten_quote",Pflatten_quote,-2}, |
{"quote_to_funargs",Pquote_to_funargs,1}, |
{"quote_to_funargs",Pquote_to_funargs,1}, |
{"quote_unify",Pquote_unify,2}, |
{"quote_unify",Pquote_unify,2}, |
{"funargs_to_quote",Pfunargs_to_quote,1}, |
{"funargs_to_quote",Pfunargs_to_quote,1}, |
Line 512 void Pwrite_to_tb(NODE arg,Q *rp) |
|
Line 512 void Pwrite_to_tb(NODE arg,Q *rp) |
|
*rp = 0; |
*rp = 0; |
} |
} |
|
|
FNODE partial_eval(FNODE), quote_bin_to_nary(FNODE), quote_nary_to_bin(FNODE,int); |
FNODE partial_eval(FNODE), quote_to_nary(FNODE), quote_to_bin(FNODE,int); |
|
|
void Pquote_bin_to_nary(NODE arg,QUOTE *rp) |
void Pquote_to_nary(NODE arg,QUOTE *rp) |
{ |
{ |
FNODE f; |
FNODE f; |
|
|
f = quote_bin_to_nary(BDY((QUOTE)ARG0(arg))); |
f = quote_to_nary(BDY((QUOTE)ARG0(arg))); |
MKQUOTE(*rp,f); |
MKQUOTE(*rp,f); |
} |
} |
|
|
void Pquote_nary_to_bin(NODE arg,QUOTE *rp) |
void Pquote_to_bin(NODE arg,QUOTE *rp) |
{ |
{ |
FNODE f; |
FNODE f; |
int direction; |
int direction; |
|
|
direction = QTOS((Q)ARG1(arg)); |
direction = QTOS((Q)ARG1(arg)); |
f = quote_nary_to_bin(BDY((QUOTE)ARG0(arg)),direction); |
f = quote_to_bin(BDY((QUOTE)ARG0(arg)),direction); |
|
|
MKQUOTE(*rp,f); |
MKQUOTE(*rp,f); |
} |
} |
Line 536 void Pquote_nary_to_bin(NODE arg,QUOTE *rp) |
|
Line 536 void Pquote_nary_to_bin(NODE arg,QUOTE *rp) |
|
void Pquote_unify(NODE arg,Q *rp) |
void Pquote_unify(NODE arg,Q *rp) |
{ |
{ |
FNODE f,g; |
FNODE f,g; |
|
Obj obj; |
QUOTE q; |
QUOTE q; |
NODE r; |
NODE r; |
int ret; |
int ret; |
Line 545 void Pquote_unify(NODE arg,Q *rp) |
|
Line 546 void Pquote_unify(NODE arg,Q *rp) |
|
MKQUOTE(q,g); |
MKQUOTE(q,g); |
ret = quote_unify((Obj)q,(Obj)ARG1(arg),&r); |
ret = quote_unify((Obj)q,(Obj)ARG1(arg),&r); |
#else |
#else |
ret = quote_unify((Obj)ARG0(arg),(Obj)ARG1(arg),&r); |
obj = (Obj)ARG0(arg); |
|
if ( !obj || OID(obj) != O_QUOTE) { |
|
objtoquote(obj,&q); obj = (Obj)q; |
|
} |
|
ret = quote_unify(obj,(Obj)ARG1(arg),&r); |
#endif |
#endif |
if ( ret ) { |
if ( ret ) { |
do_assign(r); |
do_assign(r); |
Line 640 int quote_unify(Obj f, Obj pat, NODE *rp) |
|
Line 645 int quote_unify(Obj f, Obj pat, NODE *rp) |
|
int pid,id; |
int pid,id; |
FUNC ff,pf; |
FUNC ff,pf; |
int ret; |
int ret; |
|
QUOTE q; |
|
FNODE g; |
|
|
if ( OID(pat) == O_LIST ) { |
if ( OID(pat) == O_LIST ) { |
if ( OID(f) == O_LIST ) |
if ( OID(f) == O_LIST ) |
Line 678 int quote_unify(Obj f, Obj pat, NODE *rp) |
|
Line 685 int quote_unify(Obj f, Obj pat, NODE *rp) |
|
else return merge_matching_node(head,body,rp); |
else return merge_matching_node(head,body,rp); |
} else |
} else |
return 0; |
return 0; |
|
|
|
case I_NARYOP: |
case I_BOP: |
case I_BOP: |
case I_FUNC: |
|
/* X+Y = ... */ |
/* X+Y = ... */ |
|
if ( compqa(CO,BDY(farg),BDY(parg)) ) return 0; |
|
|
|
/* XXX converting to I_BOP */ |
|
if ( ((FNODE)BDY((QUOTE)pat))->id == I_NARYOP ) { |
|
g = quote_to_bin(BDY((QUOTE)pat),1); |
|
MKQUOTE(q,g); |
|
get_quote_id_arg((QUOTE)q,&pid,&parg); |
|
} |
|
if ( ((FNODE)BDY((QUOTE)f))->id == I_NARYOP ) { |
|
g = quote_to_bin(BDY((QUOTE)f),1); |
|
MKQUOTE(q,g); |
|
get_quote_id_arg((QUOTE)q,&id,&farg); |
|
} |
|
return quote_unify_node(NEXT(farg),NEXT(parg),rp); |
|
break; |
|
|
|
case I_FUNC: |
/* f(...) = ... */ |
/* f(...) = ... */ |
if ( compqa(CO,BDY(farg),BDY(parg)) ) return 0; |
if ( compqa(CO,BDY(farg),BDY(parg)) ) return 0; |
return quote_unify_node(NEXT(farg),NEXT(parg),rp); |
return quote_unify_node(NEXT(farg),NEXT(parg),rp); |
Line 1540 void Pflatten_quote(NODE arg,Obj *rp) |
|
Line 1565 void Pflatten_quote(NODE arg,Obj *rp) |
|
|
|
if ( !ARG0(arg) || OID((Obj)ARG0(arg)) != O_QUOTE ) |
if ( !ARG0(arg) || OID((Obj)ARG0(arg)) != O_QUOTE ) |
*rp = (Obj)ARG0(arg); |
*rp = (Obj)ARG0(arg); |
else { |
else if ( argc(arg) == 1 ) { |
|
f = flatten_fnode(BDY((QUOTE)ARG0(arg)),"+"); |
|
f = flatten_fnode(f,"*"); |
|
MKQUOTE(q,f); |
|
*rp = (Obj)q; |
|
} else { |
f = flatten_fnode(BDY((QUOTE)ARG0(arg)),BDY((STRING)ARG1(arg))); |
f = flatten_fnode(BDY((QUOTE)ARG0(arg)),BDY((STRING)ARG1(arg))); |
MKQUOTE(q,f); |
MKQUOTE(q,f); |
*rp = (Obj)q; |
*rp = (Obj)q; |