OpenXM_contrib2/asir2000/builtin/strobj.c - diff

Return to strobj.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/strobj.c between version 1.63 and 1.66

version 1.63, 2005/09/28 08:08:34

version 1.66, 2005/09/30 02:20:06

Line 45

* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,

* 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.65 2005/09/30 01:35:25 noro Exp $

#include "ca.h"

#include "parse.h"

Line 79 void Pquotetotex_env();

void Pflatten_quote();

void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name();

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 fnodetotex_tb(FNODE f,TB tb);

char *symbol_name(char *name);

Line 107 struct ftab str_tab[] = {

{"tb_to_string",Ptb_to_string,1},

{"string_to_tb",Pstring_to_tb,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",Pquotetotex,1},

{"quotetotex_env",Pquotetotex_env,-99999999},

{"flatten_quote",Pflatten_quote,2},

{"flatten_quote",Pflatten_quote,-2},

{"quote_to_funargs",Pquote_to_funargs,1},

{"quote_unify",Pquote_unify,2},

{"funargs_to_quote",Pfunargs_to_quote,1},

Line 512 void Pwrite_to_tb(NODE arg,Q *rp)

*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;

f = quote_bin_to_nary(BDY((QUOTE)ARG0(arg)));

f = quote_to_nary(BDY((QUOTE)ARG0(arg)));

MKQUOTE(*rp,f);

}

void Pquote_nary_to_bin(NODE arg,QUOTE *rp)

void Pquote_to_bin(NODE arg,QUOTE *rp)

{

FNODE f;

int direction;

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);

}

Line 536 void Pquote_nary_to_bin(NODE arg,QUOTE *rp)

void Pquote_unify(NODE arg,Q *rp)

{

FNODE f,g;

Obj obj;

QUOTE q;

NODE r;

int ret;

Line 545 void Pquote_unify(NODE arg,Q *rp)

Line 546 void Pquote_unify(NODE arg,Q *rp)

MKQUOTE(q,g);

ret = quote_unify((Obj)q,(Obj)ARG1(arg),&r);

#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

if ( ret ) {

do_assign(r);

Line 621 int quote_unify_node(NODE f,NODE pat,NODE *rp) {

Line 626 int quote_unify_node(NODE f,NODE pat,NODE *rp) {

return 1;

}

/* f = [a,b,c,...] pat = [X,Y,...] rpat matches the rest of f */

int quote_unify_cons(NODE f,NODE pat,Obj rpat,NODE *rp) {

QUOTE q;

Q id;

FNODE fn;

NODE r,a,tf,tp,r1,arg;

int ret;

LIST list,alist;

/* matching of the head part */

if ( length(f) < length(pat) ) return 0;

r = 0;

for ( tf = f, tp = pat; tp; tf = NEXT(tf), tp = NEXT(tp) ) {

ret = quote_unify((Obj)BDY(tf),(Obj)BDY(tp),&a);

if ( !ret ) return 0;

ret = merge_matching_node(r,a,&r1);

if ( !ret ) return 0;

else r = r1;

}

/* matching of the rest */

MKLIST(list,tf);

STOQ(I_LIST,id); a = mknode(2,id,list);

MKLIST(alist,a);

arg = mknode(1,alist);

Pfunargs_to_quote(arg,&q);

ret = quote_unify((Obj)q,rpat,&a);

if ( !ret ) return 0;

ret = merge_matching_node(r,a,&r1);

if ( !ret ) return 0;

*rp = r1;

return 1;

}

void get_quote_id_arg(QUOTE f,int *id,NODE *r)

{

LIST fa;

Line 636 int quote_unify(Obj f, Obj pat, NODE *rp)

Line 675 int quote_unify(Obj f, Obj pat, NODE *rp)

{

NODE tf,tp,head,body;

NODE parg,farg,r;

Obj rpat;

LIST fa,l;

int pid,id;

FUNC ff,pf;

int ret;

QUOTE q;

FNODE g;

if ( OID(pat) == O_LIST ) {

if ( OID(f) == O_LIST )

Line 662 int quote_unify(Obj f, Obj pat, NODE *rp)

Line 704 int quote_unify(Obj f, Obj pat, NODE *rp)

case I_LIST:

return quote_unify_node(BDY((LIST)BDY(farg)),

BDY((LIST)BDY(parg)),rp);

case I_CONS:

tf = BDY((LIST)BDY(farg));

tp = BDY((LIST)BDY(parg));

rpat = (Obj)BDY(NEXT(parg));

return quote_unify_cons(tf,tp,rpat,rp);

case I_PVAR:

/* [[pat,f]] */

r = mknode(2,pat,f); MKLIST(l,r);

Line 678 int quote_unify(Obj f, Obj pat, NODE *rp)

Line 725 int quote_unify(Obj f, Obj pat, NODE *rp)

else return merge_matching_node(head,body,rp);

} else

return 0;

case I_NARYOP:

case I_BOP:

case I_FUNC:

/* 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(...) = ... */

if ( compqa(CO,BDY(farg),BDY(parg)) ) return 0;

return quote_unify_node(NEXT(farg),NEXT(parg),rp);

Line 1540 void Pflatten_quote(NODE arg,Obj *rp)

Line 1605 void Pflatten_quote(NODE arg,Obj *rp)

if ( !ARG0(arg) || OID((Obj)ARG0(arg)) != O_QUOTE )

*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)));

MKQUOTE(q,f);

*rp = (Obj)q;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>