===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/print.c,v
retrieving revision 1.14
retrieving revision 1.23
diff -u -p -r1.14 -r1.23
--- OpenXM_contrib2/asir2000/builtin/print.c	2001/10/09 01:36:07	1.14
+++ OpenXM_contrib2/asir2000/builtin/print.c	2007/11/07 19:26:17	1.23
@@ -45,42 +45,103 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * 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.22 2006/09/26 05:35:25 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
 
+void Pprintf();
 void Pprint();
 void Pquotetolist();
+void Pobjtoquote();
 void Peval_variables_in_quote();
 void Pset_print_function();
 
 struct ftab print_tab[] = {
+	{"printf",Pprintf,-99999999},
 	{"print",Pprint,-2},
+	{"objtoquote",Pobjtoquote,1},
 	{"quotetolist",Pquotetolist,1},
 	{"eval_variables_in_quote",Peval_variables_in_quote,1},
 	{"set_print_function",Pset_print_function,-1},
 	{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);
+			/* XXX : if ox_asir, we have to fflush always */
+			if ( I_am_server ) {
+				fflush(asir_out);
+			}
+		}
+	}
+	*rp = 0;
+	return;
+}
+
 void Pprint(NODE arg,pointer *rp)
 {
-	printexpr(CO,ARG0(arg)); 
-	if ( argc(arg) == 2 )
-		switch ( QTOS((Q)ARG1(arg)) ) {
-			case 0:
-				break;
-			case 2:
-				fflush(asir_out); break;
-				break;
-			case 1: default:
-				putc('\n',asir_out); break;
+	Obj obj;
+	STRING nl;
+	Q opt;
+
+	/* engine for wfep */
+	if ( wfep_mode ) {
+		if ( arg ) {
+			print_to_wfep((Obj)ARG0(arg));
+			if ( !NEXT(arg) || ARG1(arg) ) {
+				MKSTR(nl,"\r\n");
+				print_to_wfep((Obj)nl);
+			}
 		}
-	else
-		putc('\n',asir_out);
+		*rp = 0;
+		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;
 }
 
+void Pobjtoquote(NODE arg,QUOTE *rp)
+{
+	objtoquote(ARG0(arg),rp);
+}
+
 void Pquotetolist(NODE arg,LIST *rp)
 {
 	asir_assert(ARG0(arg),O_QUOTE,"quotetolist");	
@@ -195,6 +256,21 @@ void fnodetotree(FNODE f,LIST *rp)
 			MKLIST(*rp,n);
 			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 */
 		case I_CE:
 			MKSTR(head,"t_op");
@@ -222,11 +298,11 @@ void fnodetotree(FNODE f,LIST *rp)
 			break;
 
 		/* 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");
 			switch ( f->id ) {
-				case I_FUNC:
-					MKSTR(op,((FUNC)FA0(f))->name);
+				case I_FUNC: case I_FUNC_QARG:
+					MKSTR(op,((FUNC)FA0(f))->fullname);
 					fnodetotree((FNODE)FA1(f),&a1);
 					break;
 				case I_CAR: