version 1.6, 2001/08/22 00:54:29 |
version 1.8, 2001/08/31 09:17:12 |
|
|
* 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/print.c,v 1.5 2001/08/21 01:39:38 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/print.c,v 1.7 2001/08/22 04:20:45 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
fnodetotree((FNODE)BDY((QUOTE)(ARG0(arg))),rp); |
fnodetotree((FNODE)BDY((QUOTE)(ARG0(arg))),rp); |
} |
} |
|
|
|
/* fnode -> [tag,name,arg0,arg1,...] */ |
|
|
void fnodetotree(f,rp) |
void fnodetotree(f,rp) |
FNODE f; |
FNODE f; |
Obj *rp; |
Obj *rp; |
{ |
{ |
Obj a1,a2; |
Obj a1,a2,a3; |
NODE n,t,t0; |
NODE n,t,t0; |
STRING head; |
STRING head,op,str; |
LIST r,arg; |
LIST r,arg; |
char *opname; |
char *opname; |
|
|
if ( !f ) { |
if ( !f ) { |
*rp = 0; |
MKSTR(head,"internal"); |
|
n = mknode(2,head,0); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
return; |
return; |
} |
} |
switch ( f->id ) { |
switch ( f->id ) { |
case I_BOP: case I_COP: I_LOP: |
/* unary operators */ |
/* arg list */ |
case I_NOT: case I_PAREN: |
fnodetotree((FNODE)FA1(f),&a1); |
MKSTR(head,"u_op"); |
fnodetotree((FNODE)FA2(f),&a2); |
switch ( f->id ) { |
n = mknode(2,a1,a2); MKLIST(arg,n); |
case I_NOT: |
|
MKSTR(op,"!"); |
|
break; |
|
case I_PAREN: |
|
MKSTR(op,"()"); |
|
break; |
|
} |
|
fnodetotree((FNODE)FA0(f),&a1); |
|
n = mknode(3,head,op,a1); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
|
break; |
|
|
|
/* binary operators */ |
|
case I_BOP: case I_COP: case I_LOP: case I_AND: case I_OR: |
/* head */ |
/* head */ |
|
MKSTR(head,"b_op"); |
|
|
|
/* arg list */ |
switch ( f->id ) { |
switch ( f->id ) { |
|
case I_AND: case I_OR: |
|
fnodetotree((FNODE)FA0(f),&a1); |
|
fnodetotree((FNODE)FA1(f),&a2); |
|
break; |
|
default: |
|
fnodetotree((FNODE)FA1(f),&a1); |
|
fnodetotree((FNODE)FA2(f),&a2); |
|
break; |
|
} |
|
|
|
/* op */ |
|
switch ( f->id ) { |
case I_BOP: |
case I_BOP: |
MKSTR(head,((ARF)FA0(f))->name); break; |
MKSTR(op,((ARF)FA0(f))->name); break; |
|
|
case I_COP: |
case I_COP: |
switch( (cid)FA0(f) ) { |
switch( (cid)FA0(f) ) { |
case C_EQ: opname = "=="; break; |
case C_EQ: opname = "=="; break; |
|
|
case C_GE: opname = ">="; break; |
case C_GE: opname = ">="; break; |
case C_LE: opname = "<="; break; |
case C_LE: opname = "<="; break; |
} |
} |
MKSTR(head,opname); break; |
MKSTR(op,opname); break; |
|
|
case I_LOP: |
case I_LOP: |
switch( (lid)FA0(f) ) { |
switch( (lid)FA0(f) ) { |
case L_EQ: opname = "@=="; break; |
case L_EQ: opname = "@=="; break; |
|
|
case L_LE: opname = "@<="; break; |
case L_LE: opname = "@<="; break; |
case L_AND: opname = "@&&"; break; |
case L_AND: opname = "@&&"; break; |
case L_OR: opname = "@||"; break; |
case L_OR: opname = "@||"; break; |
case L_NOT: opname = "@!"; break; |
|
|
case L_NOT: opname = "@!"; |
|
/* XXX : L_NOT is a unary operator */ |
|
MKSTR(head,"u_op"); |
|
MKSTR(op,opname); |
|
n = mknode(3,head,op,a1); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
|
return; |
} |
} |
MKSTR(head,opname); break; |
MKSTR(op,opname); break; |
|
|
|
case I_AND: |
|
MKSTR(op,"&&"); break; |
|
|
|
case I_OR: |
|
MKSTR(op,"||"); break; |
} |
} |
n = mknode(2,head,arg); |
n = mknode(4,head,op,a1,a2); |
MKLIST(r,n); |
MKLIST(r,n); |
*rp = (Obj)r; |
*rp = (Obj)r; |
break; |
break; |
case I_AND: |
|
fnodetotree((FNODE)FA0(f),&a1); |
/* ternary operators */ |
fnodetotree((FNODE)FA1(f),&a2); |
|
n = mknode(2,a1,a2); MKLIST(arg,n); |
|
MKSTR(head,"&&"); |
|
n = mknode(2,head,arg); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
|
break; |
|
case I_OR: |
|
fnodetotree((FNODE)FA0(f),&a1); |
|
fnodetotree((FNODE)FA1(f),&a2); |
|
n = mknode(2,a1,a2); MKLIST(arg,n); |
|
MKSTR(head,"||"); |
|
n = mknode(2,head,arg); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
|
break; |
|
case I_NOT: |
|
fnodetotree((FNODE)FA0(f),&a1); |
|
n = mknode(1,a1); MKLIST(arg,n); |
|
MKSTR(head,"!"); |
|
n = mknode(2,head,arg); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
|
break; |
|
case I_CE: |
case I_CE: |
|
MKSTR(head,"t_op"); |
|
MKSTR(op,"?:"); |
fnodetotree((FNODE)FA0(f),&a1); |
fnodetotree((FNODE)FA0(f),&a1); |
fnodetotree((FNODE)FA1(f),&a2); |
fnodetotree((FNODE)FA1(f),&a2); |
n = mknode(2,a1,a2); MKLIST(arg,n); |
fnodetotree((FNODE)FA2(f),&a3); |
MKSTR(head,"?:"); |
n = mknode(5,head,op,a1,a2,a3); |
n = mknode(2,head,arg); |
|
MKLIST(r,n); |
MKLIST(r,n); |
*rp = (Obj)r; |
*rp = (Obj)r; |
break; |
break; |
case I_EV: case I_LIST: |
|
|
/* lists */ |
|
case I_LIST: |
n = (NODE)FA0(f); |
n = (NODE)FA0(f); |
for ( t0 = 0; n; n = NEXT(n) ) { |
for ( t0 = 0; n; n = NEXT(n) ) { |
NEXTNODE(t0,t); |
NEXTNODE(t0,t); |
|
|
} |
} |
if ( t0 ) |
if ( t0 ) |
NEXT(t) = 0; |
NEXT(t) = 0; |
MKLIST(arg,t0); |
MKSTR(head,"list"); |
|
MKNODE(n,head,t0); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
|
break; |
|
|
|
/* function */ |
|
case I_FUNC: case I_CAR: case I_CDR: case I_EV: |
|
MKSTR(head,"function"); |
switch ( f->id ) { |
switch ( f->id ) { |
case I_LIST: |
case I_FUNC: |
MKSTR(head,"()"); break; |
MKSTR(op,((FUNC)FA0(f))->name); |
|
fnodetotree((FNODE)FA1(f),&arg); |
|
break; |
|
case I_CAR: |
|
MKSTR(op,"car"); |
|
fnodetotree((FNODE)FA0(f),&arg); |
|
break; |
|
case I_CDR: |
|
MKSTR(op,"cdr"); |
|
fnodetotree((FNODE)FA0(f),&arg); |
|
break; |
case I_EV: |
case I_EV: |
MKSTR(head,"exponent_vector"); break; |
/* exponent vector; should be treated as function call */ |
|
MKSTR(op,"exponent_vector"); |
|
fnodetotree(mkfnode(1,I_LIST,FA0(f)),&arg); |
|
break; |
} |
} |
n = mknode(2,head,arg); |
t0 = NEXT(BDY(arg)); /* XXX : skip the headers */ |
|
MKNODE(t,op,t0); |
|
MKNODE(n,head,t); |
MKLIST(r,n); |
MKLIST(r,n); |
*rp = (Obj)r; |
*rp = (Obj)r; |
break; |
break; |
case I_FUNC: |
|
fnodetotree((FNODE)FA1(f),&arg); |
case I_STR: |
MKSTR(head,((FUNC)FA0(f))->name); |
MKSTR(head,"internal"); |
n = mknode(2,head,arg); |
MKSTR(str,FA0(f)); |
|
n = mknode(2,head,str); |
MKLIST(r,n); |
MKLIST(r,n); |
*rp = (Obj)r; |
*rp = (Obj)r; |
break; |
break; |
case I_CAR: |
|
fnodetotree((FNODE)FA0(f),&arg); |
case I_FORMULA: |
MKSTR(head,"car"); |
MKSTR(head,"internal"); |
n = mknode(2,head,arg); |
n = mknode(2,head,FA0(f)); |
MKLIST(r,n); |
MKLIST(r,n); |
*rp = (Obj)r; |
*rp = (Obj)r; |
break; |
break; |
case I_CDR: |
|
fnodetotree((FNODE)FA0(f),&arg); |
|
MKSTR(head,"cdr"); |
|
n = mknode(2,head,arg); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
|
break; |
|
case I_PAREN: |
|
fnodetotree((FNODE)FA0(f),&arg); |
|
MKSTR(head,"()"); |
|
n = mknode(2,head,arg); |
|
MKLIST(r,n); |
|
*rp = (Obj)r; |
|
break; |
|
case I_STR: |
|
MKSTR(head,FA0(f)); |
|
*rp = (Obj)head; |
|
break; |
|
case I_FORMULA: |
|
*rp = (Obj)FA0(f); |
|
break; |
|
default: |
default: |
error("fnodetotree : not implemented yet"); |
error("fnodetotree : not implemented yet"); |
} |
} |
} |
} |
|
|
|
char *get_attribute(key,attr) |
|
char *key; |
|
LIST attr; |
|
{} |
|
|
|
void treetofnode(obj,f) |
|
Obj obj; |
|
FNODE *f; |
|
{ |
|
NODE n; |
|
LIST attr; |
|
char *prop; |
|
|
|
if ( obj || OID(obj) != O_LIST ) { |
|
/* internal object */ |
|
*f = mkfnode(1,I_FORMULA,obj); |
|
} else { |
|
/* [attr(list),name(string),args(node)] */ |
|
n = BDY((LIST)obj); |
|
attr = (LIST)BDY(n); n = NEXT(n); |
|
prop = get_attribute("asir",attr); |
|
if ( !strcmp(prop,"u_op") ) { |
|
} else if ( !strcmp(prop,"b_op") ) { |
|
} else if ( !strcmp(prop,"t_op") ) { |
|
} else if ( !strcmp(prop,"function") ) { |
|
} |
|
/* default will be set to P_FUNC */ |
|
} |
|
} |
|
|