version 1.14, 2001/10/09 01:36:07 |
version 1.24, 2007/11/22 05:14:48 |
|
|
* 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.13 2001/09/05 09:01:27 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/print.c,v 1.23 2007/11/07 19:26:17 ohara Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
|
void Pprintf(); |
void Pprint(); |
void Pprint(); |
void Pquotetolist(); |
void Pquotetolist(); |
|
void Pobjtoquote(); |
void Peval_variables_in_quote(); |
void Peval_variables_in_quote(); |
void Pset_print_function(); |
void Pset_print_function(); |
|
|
struct ftab print_tab[] = { |
struct ftab print_tab[] = { |
|
{"printf",Pprintf,-99999999}, |
{"print",Pprint,-2}, |
{"print",Pprint,-2}, |
|
{"objtoquote",Pobjtoquote,1}, |
{"quotetolist",Pquotetolist,1}, |
{"quotetolist",Pquotetolist,1}, |
{"eval_variables_in_quote",Peval_variables_in_quote,1}, |
{"eval_variables_in_quote",Peval_variables_in_quote,1}, |
{"set_print_function",Pset_print_function,-1}, |
{"set_print_function",Pset_print_function,-1}, |
{0,0,0}, |
{0,0,0}, |
}; |
}; |
|
|
|
extern int I_am_server; |
|
|
|
int wfep_mode; |
|
|
|
void Pprintf(NODE arg,pointer *rp) |
|
{ |
|
STRING s; |
|
if ( arg ) { |
|
Psprintf(arg,&s); |
|
/* engine for wfep */ |
|
if ( wfep_mode ) { |
|
print_to_wfep(s); |
|
}else { |
|
printexpr(CO,s); |
|
fflush(asir_out); |
|
} |
|
} |
|
*rp = 0; |
|
return; |
|
} |
|
|
void Pprint(NODE arg,pointer *rp) |
void Pprint(NODE arg,pointer *rp) |
{ |
{ |
printexpr(CO,ARG0(arg)); |
Obj obj; |
if ( argc(arg) == 2 ) |
STRING nl; |
switch ( QTOS((Q)ARG1(arg)) ) { |
Q opt; |
case 0: |
|
break; |
/* engine for wfep */ |
case 2: |
if ( wfep_mode ) { |
fflush(asir_out); break; |
if ( arg ) { |
break; |
print_to_wfep((Obj)ARG0(arg)); |
case 1: default: |
if ( !NEXT(arg) || ARG1(arg) ) { |
putc('\n',asir_out); break; |
MKSTR(nl,"\r\n"); |
|
print_to_wfep((Obj)nl); |
|
} |
} |
} |
else |
*rp = 0; |
putc('\n',asir_out); |
return; |
|
} |
|
if ( arg ) { |
|
obj = (Obj)ARG0(arg); |
|
if ( NEXT(arg) ) { |
|
opt = (Q)ARG1(arg); |
|
if ( INT(opt) ) { |
|
printexpr(CO,obj); |
|
switch ( QTOS(opt) ) { |
|
case 0: |
|
break; |
|
case 2: |
|
fflush(asir_out); break; |
|
break; |
|
case 1: default: |
|
putc('\n',asir_out); break; |
|
} |
|
} else |
|
error("print : invalid argument"); |
|
} else { |
|
printexpr(CO,obj); |
|
putc('\n',asir_out); |
|
} |
|
} |
|
/* XXX : if ox_asir, we have to fflush always */ |
|
if ( I_am_server ) |
|
fflush(asir_out); |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
|
void Pobjtoquote(NODE arg,QUOTE *rp) |
|
{ |
|
objtoquote(ARG0(arg),rp); |
|
} |
|
|
void Pquotetolist(NODE arg,LIST *rp) |
void Pquotetolist(NODE arg,LIST *rp) |
{ |
{ |
asir_assert(ARG0(arg),O_QUOTE,"quotetolist"); |
asir_assert(ARG0(arg),O_QUOTE,"quotetolist"); |
Line 195 void fnodetotree(FNODE f,LIST *rp) |
|
Line 253 void fnodetotree(FNODE f,LIST *rp) |
|
MKLIST(*rp,n); |
MKLIST(*rp,n); |
break; |
break; |
|
|
|
case I_NARYOP: |
|
/* head */ |
|
MKSTR(head,"n_op"); |
|
n = (NODE)FA1(f); |
|
for ( t0 = 0; n; n = NEXT(n) ) { |
|
NEXTNODE(t0,t); |
|
fnodetotree((FNODE)BDY(n),&a1); |
|
BDY(t) = (pointer)a1; |
|
} |
|
MKSTR(op,((ARF)FA0(f))->name); |
|
MKNODE(t,op,t0); |
|
MKNODE(n,head,t); |
|
MKLIST(*rp,n); |
|
break; |
|
|
/* ternary operators */ |
/* ternary operators */ |
case I_CE: |
case I_CE: |
MKSTR(head,"t_op"); |
MKSTR(head,"t_op"); |
Line 222 void fnodetotree(FNODE f,LIST *rp) |
|
Line 295 void fnodetotree(FNODE f,LIST *rp) |
|
break; |
break; |
|
|
/* function */ |
/* function */ |
case I_FUNC: case I_CAR: case I_CDR: case I_EV: |
case I_FUNC: case I_FUNC_QARG: case I_CAR: case I_CDR: case I_EV: |
MKSTR(head,"function"); |
MKSTR(head,"function"); |
switch ( f->id ) { |
switch ( f->id ) { |
case I_FUNC: |
case I_FUNC: case I_FUNC_QARG: |
MKSTR(op,((FUNC)FA0(f))->name); |
MKSTR(op,((FUNC)FA0(f))->fullname); |
fnodetotree((FNODE)FA1(f),&a1); |
fnodetotree((FNODE)FA1(f),&a1); |
break; |
break; |
case I_CAR: |
case I_CAR: |