===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/io/cpexpr.c,v
retrieving revision 1.14
retrieving revision 1.20
diff -u -p -r1.14 -r1.20
--- OpenXM_contrib2/asir2000/io/cpexpr.c	2002/09/02 05:16:07	1.14
+++ OpenXM_contrib2/asir2000/io/cpexpr.c	2004/03/17 02:23:45	1.20
@@ -44,12 +44,15 @@
  * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
- * $OpenXM: OpenXM_contrib2/asir2000/io/cpexpr.c,v 1.13 2001/10/09 01:36:20 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/io/cpexpr.c,v 1.19 2004/03/17 02:10:31 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
 #include "al.h"
 #include "base.h"
+#if PARI
+#include "genpari.h"
+#endif
 
 extern int hex_output,fortran_output,double_output,real_digit;
 
@@ -78,6 +81,9 @@ extern int hex_output,fortran_output,double_output,rea
 #define PRINTGFMMAT length_gfmmat
 #define PRINTBYTEARRAY length_bytearray
 #define PRINTQUOTE length_QUOTE
+#define PRINTSYMBOL length_SYMBOL
+#define PRINTRANGE length_RANGE
+#define PRINTTB length_TB
 #define PRINTERR length_err
 #define PRINTLF length_lf
 #define PRINTLOP length_lop
@@ -87,6 +93,9 @@ extern int hex_output,fortran_output,double_output,rea
 #define PRINTUP length_up
 #define PRINTUM length_um
 #define PRINTSF length_sf
+#define PRINTFARGS length_fargs
+#define PRINTFNODENODE length_fnodenode
+#define PRINTFNODE length_fnode
 
 void PRINTEXPR();
 void PRINTNUM();
@@ -105,6 +114,9 @@ void PRINTGF2MAT();
 void PRINTGFMMAT();
 void PRINTBYTEARRAY();
 void PRINTQUOTE();
+void PRINTSYMBOL();
+void PRINTRANGE();
+void PRINTTB();
 void PRINTERR();
 void PRINTCPLX();
 void PRINTLM();
@@ -117,6 +129,7 @@ void PRINTEOP();
 void PRINTLOP();
 void PRINTQOP();
 void PRINTSF();
+void PRINTFNODE();
 
 static int total_length;
 
@@ -127,11 +140,10 @@ int estimate_length(VL vl,pointer p)
 	return total_length;
 }
 
-#if PARI
+#if defined(PARI)
 void PRINTBF(BF a)
 {
 	char *str;
-	char *GENtostr();
 	char *GENtostr0();
 	void myoutbrute();
 
@@ -187,6 +199,12 @@ void PRINTEXPR(VL vl,pointer p)
 			PRINTBYTEARRAY(vl,(BYTEARRAY)p); break;
 		case O_QUOTE:
 			PRINTQUOTE(vl,(QUOTE)p); break;
+		case O_SYMBOL:
+			PRINTSYMBOL((SYMBOL)p); break;
+		case O_RANGE:
+			PRINTRANGE(vl,(RANGE)p); break;
+		case O_TB:
+			PRINTTB(vl,(TB)p); break;
 		default:
 			break;
 	}
@@ -228,7 +246,7 @@ void PRINTNUM(Num q)
 		case N_A:
 			PUTS("("); PRINTR(ALG,(R)BDY((Alg)q)); PUTS(")");
 			break;
-#if PARI
+#if defined(PARI)
 		case N_B:
 			PRINTBF((BF)q); break;
 #endif
@@ -533,12 +551,44 @@ void PRINTBYTEARRAY(VL vl,BYTEARRAY array)
 	total_length += 1+3*array->len;
 }
 
+extern int print_quote;
+
 void PRINTQUOTE(VL vl,QUOTE quote)
 {
-	/* <...quoted...> */
-	total_length += 20;
+	LIST list;
+
+	if ( print_quote == 2 ) {
+		PRINTFNODE(BDY(quote));
+	} else if ( print_quote == 1 ) {
+		/* XXX */
+		fnodetotree(BDY(quote),&list);
+		PRINTEXPR(vl,(Obj)list);
+	} else {
+		/* <...quoted...> */
+		total_length += 20;
+	}
 }
 
+void PRINTSYMBOL(SYMBOL sym)
+{
+	total_length += strlen(sym->name);
+}
+
+void PRINTRANGE(VL vl,RANGE r)
+{
+	PUTS("range("); PRINTEXPR(vl,r->start);
+	PUTS(","); PRINTEXPR(vl,r->end); PUTS(")");
+}
+
+void PRINTTB(VL vl,TB p)
+{
+	int i;
+
+	for ( i = 0; i < p->next; i++ ) {
+		total_length += strlen(p->body[i]);
+	}
+}
+
 void PRINTERR(VL vl,ERR e)
 {
 	PUTS("error("); PRINTEXPR(vl,e->body); PUTS(")");
@@ -748,4 +798,134 @@ void PRINTSF(unsigned int i)
 		PUTS("0");
 	} else
 		total_length += 15;
+}
+
+
+void PRINTFNODENODE(NODE n)
+{
+	for ( ; n; n = NEXT(n) ) {
+		PRINTFNODE((FNODE)BDY(n),0);
+		if ( NEXT(n) ) PUTS(",");
+	}
+}
+
+void PRINTFARGS(FNODE f)
+{
+	NODE n;
+
+	if ( f->id == I_LIST ) {
+		n = (NODE)FA0(f);
+		PRINTFNODENODE(n);
+	} else
+		PRINTFNODE(f,0);
+}
+
+void PRINTFNODE(FNODE f,int paren)
+{
+	NODE n,t,t0;
+	char vname[BUFSIZ],prefix[BUFSIZ];
+	char *opname,*vname_conv,*prefix_conv;
+	Obj obj;
+	int i,len,allzero,elen,elen2;
+	C cplx;
+	char *r;
+	FNODE fi,f2;
+
+	if ( !f ) {
+		PUTS("(0)");
+		return;
+	}
+	if ( paren ) PUTS("(");
+	switch ( f->id ) {
+		/* unary operators */
+		case I_NOT: PUTS("!"); PRINTFNODE((FNODE)FA0(f),1); break;
+		case I_PAREN: PRINTFNODE((FNODE)FA0(f),0); break;
+		case I_MINUS: PUTS("-"); PRINTFNODE((FNODE)FA0(f),1); break;
+		/* binary operators */
+		/* arg list */
+		/* I_AND, I_OR => FA0(f), FA1(f) */
+		/* otherwise   => FA1(f), FA2(f) */
+		case I_BOP:
+			PRINTFNODE((FNODE)FA1(f),1);
+			PUTS(((ARF)FA0(f))->name);
+			PRINTFNODE((FNODE)FA2(f),1);
+			break;
+		case I_COP:
+			switch( (cid)FA0(f) ) {
+				case C_EQ: opname = ("=="); break;
+				case C_NE: opname = ("!="); break;
+				case C_GT: opname = (">"); break;
+				case C_LT: opname = ("<"); break;
+				case C_GE: opname = (">="); break;
+				case C_LE: opname = ("<="); break;
+			}
+			PRINTFNODE((FNODE)FA1(f),1);
+			PUTS(opname);
+			PRINTFNODE((FNODE)FA2(f),1);
+			break;
+		case I_LOP:
+			switch( (lid)FA0(f) ) {
+				case L_EQ: opname = ("@=="); break;
+				case L_NE: opname = ("@!="); break;
+				case L_GT: opname = ("@>"); break;
+				case L_LT: opname = ("@<"); break;
+				case L_GE: opname = ("@>="); break;
+				case L_LE: opname = ("@<="); break;
+				case L_AND: opname = ("@&&"); break;
+				case L_OR: opname = ("@||"); break;
+				case L_NOT: opname = ("@!"); break;
+			}
+			if ( (lid)FA0(f)==L_NOT ) {
+				PUTS(opname); PRINTFNODE((FNODE)FA1(f),1);
+			} else {
+				PRINTFNODE((FNODE)FA1(f),1);
+				PUTS(opname);
+				PRINTFNODE((FNODE)FA2(f),1);
+			}
+			break;
+		case I_AND:
+			PRINTFNODE((FNODE)FA0(f),1);
+			PUTS("&&");
+			PRINTFNODE((FNODE)FA1(f),1);
+			break;
+		case I_OR:
+			PRINTFNODE((FNODE)FA0(f),1);
+			PUTS("!!");
+			PRINTFNODE((FNODE)FA1(f),1);
+			break;
+		/* ternary operators */
+		case I_CE:
+			PRINTFNODE((FNODE)FA0(f),1); PUTS("?"); PRINTFNODE((FNODE)FA1(f),1);
+			PUTS(":"); PRINTFNODE((FNODE)FA2(f),1);
+			break;
+		/* lists */
+		case I_LIST: PUTS("["); PRINTFNODENODE((NODE)FA0(f)); PUTS("]"); break;
+		/* function */
+		case I_FUNC:
+			if ( !strcmp(((FUNC)FA0(f))->name,"@pi") ) PUTS("@pi");
+			else if ( !strcmp(((FUNC)FA0(f))->name,"@e") ) PUTS("@e");
+			else {
+				PUTS(((FUNC)FA0(f))->name);
+				PUTS("("); PRINTFARGS(FA1(f)); PUTS(")");
+			}
+			break;
+		/* XXX */
+		case I_CAR: PUTS("car("); PRINTFNODE(FA0(f),0); PUTS(")"); break;
+		case I_CDR: PUTS("cdr("); PRINTFNODE(FA0(f),0); PUTS(")"); break;
+		/* exponent vector */
+		case I_EV: PUTS("<<"); PRINTFNODENODE((NODE)FA0(f)); PUTS(">>"); break;
+		/* string */
+		case I_STR: PUTS((char *)FA0(f)); break;
+		/* internal object */
+		case I_FORMULA: obj = (Obj)FA0(f); PRINTEXPR(CO,obj); break;
+		/* program variable */
+		case I_PVAR:
+			if ( FA1(f) )
+				error("length_fnode : not implemented yet");
+			GETPVNAME(FA0(f),opname);
+			PUTS(opname);
+			break;
+		default: error("length_fnode : not implemented yet");
+	}
+	if ( paren ) PUTS(")");
 }