===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/eval.c,v
retrieving revision 1.37
retrieving revision 1.54
diff -u -p -r1.37 -r1.54
--- OpenXM_contrib2/asir2000/parse/eval.c	2004/11/22 02:26:56	1.37
+++ OpenXM_contrib2/asir2000/parse/eval.c	2005/11/06 01:27:28	1.54
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.36 2004/10/27 08:21:47 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.53 2005/10/19 14:09:13 noro Exp $ 
 */
 #include <ctype.h>
 #include "ca.h"
@@ -64,6 +64,7 @@ int f_break,f_return,f_continue;
 int evalstatline;
 int recv_intr;
 int show_crossref;
+void gen_searchf_searchonly(char *name,FUNC *r);
 
 pointer eval(FNODE f)
 {
@@ -71,11 +72,11 @@ pointer eval(FNODE f)
 	STRING str;
 	pointer val = 0;
 	pointer a,a1,a2;
-	NODE tn,ind;
+	NODE tn,tn1,ind,match;
 	R u;
 	DP dp;
 	unsigned int pv;
-	int c;
+	int c,ret;
 	FNODE f1;
 	UP2 up2;
 	UP up;
@@ -85,6 +86,7 @@ pointer eval(FNODE f)
 	GFPN gfpn;
 	GFSN gfsn;
 	RANGE range;
+	QUOTE expr,pattern;
 
 #if defined(VISUAL)
 	if ( recv_intr ) {
@@ -113,6 +115,16 @@ pointer eval(FNODE f)
 			a1 = eval((FNODE)FA1(f)); a2 = eval((FNODE)FA2(f));
 			(*((ARF)FA0(f))->fp)(CO,a1,a2,&val); 
 			break;
+		case I_NARYOP:
+			tn = (NODE)FA1(f);
+			a = eval((FNODE)BDY(tn));
+			for ( tn = NEXT(tn); tn; tn = NEXT(tn) ) {
+				a1 = eval((FNODE)BDY(tn));
+				(*((ARF)FA0(f))->fp)(CO,a,a1,&a2); 
+				a = a2;
+			}
+			val = a;
+			break;
 		case I_COP:
 			a1 = eval((FNODE)FA1(f)); a2 = eval((FNODE)FA2(f));
 			c = arf_comp(CO,a1,a2);
@@ -167,8 +179,7 @@ pointer eval(FNODE f)
 		case I_FUNC_OPT:
 			val = evalf((FUNC)FA0(f),(FNODE)FA1(f),(FNODE)FA2(f)); break;
 		case I_PFDERIV:
-			error("eval : not implemented yet");
-			break;
+			val = evalf_deriv((FUNC)FA0(f),(FNODE)FA1(f),(FNODE)FA2(f)); break;
 		case I_MAP:
 			val = evalmapf((FUNC)FA0(f),(FNODE)FA1(f)); break;
 		case I_RECMAP:
@@ -223,7 +234,9 @@ pointer eval(FNODE f)
 				error("-- : not implemented yet");
 			break;
 		case I_PVAR:
-			pv = (unsigned int)FA0(f); ind = (NODE)FA1(f); GETPV(pv,a); 
+			pv = (unsigned int)FA0(f);
+			ind = (NODE)FA1(f);
+			GETPV(pv,a); 
 			if ( !ind )
 				val = a;
 			else {
@@ -287,6 +300,14 @@ pointer eval(FNODE f)
 			 val = FA0(f); break;
 		case I_LIST:
 			evalnodebody((NODE)FA0(f),&tn); MKLIST(t,tn); val = (pointer)t; break;
+		case I_CONS:
+			evalnodebody((NODE)FA0(f),&tn); a2 = eval(FA1(f));
+			if ( !a2 || OID(a2) != O_LIST )
+					error("cons : invalid argument");
+			for ( tn1 = tn; NEXT(tn1); tn1 = NEXT(tn1) );
+			NEXT(tn1) = BDY((LIST)a2);
+			MKLIST(t,tn); val = (pointer)t;
+			break;
 		case I_NEWCOMP:
 			newstruct((int)FA0(f),(struct oCOMP **)&val); break;
 		case I_CAR:
@@ -330,14 +351,350 @@ pointer eval(FNODE f)
 	return ( val );
 }
 
+NODE fnode_to_nary_node(NODE);
+NODE fnode_to_bin_node(NODE,int);
+
+FNODE fnode_to_nary(FNODE f)
+{
+	FNODE a0,a1,a2;
+	NODE n,t,t0;
+	pointer val;
+	char *op;
+
+	if ( !f )
+		return f;
+	switch ( f->id ) {
+		case I_NARYOP:
+				n = fnode_to_nary_node((NODE)FA1(f));
+				return mkfnode(2,I_NARYOP,FA0(f),n);
+
+		case I_BOP: 
+			a1 = fnode_to_nary((FNODE)FA1(f));
+			a2 = fnode_to_nary((FNODE)FA2(f));
+			op = ((ARF)FA0(f))->name;
+			if ( !strcmp(op,"+") || !strcmp(op,"*") ) {
+				if ( a1->id == I_NARYOP && !strcmp(op,((ARF)FA0(a1))->name) ) {
+					for ( n = (NODE)FA1(a1); NEXT(n); n = NEXT(n) );
+					if ( a2->id == I_NARYOP && !strcmp(op,((ARF)FA0(a2))->name) )
+						NEXT(n) = (NODE)FA1(a2);
+					else
+						MKNODE(NEXT(n),a2,0);
+					return a1;
+				} else if ( a2->id == I_NARYOP && !strcmp(op,((ARF)FA0(a2))->name) ) {
+					MKNODE(t,a1,(NODE)FA1(a2));
+					return mkfnode(2,I_NARYOP,FA0(f),t);
+				} else {
+					t = mknode(2,a1,a2);
+					return mkfnode(2,I_NARYOP,FA0(f),t);
+				}
+			} else
+				return mkfnode(3,f->id,FA0(f),a1,a2);
+
+		case I_NOT: case I_PAREN: case I_MINUS:
+		case I_CAR: case I_CDR:
+			a0 = fnode_to_nary((FNODE)FA0(f));
+			return mkfnode(1,f->id,a0);
+
+		case I_COP: case I_LOP:
+			a1 = fnode_to_nary((FNODE)FA1(f));
+			a2 = fnode_to_nary((FNODE)FA2(f));
+			return mkfnode(3,f->id,FA0(f),a1,a2);
+
+		case I_AND: case I_OR:
+			a0 = fnode_to_nary((FNODE)FA0(f));
+			a1 = fnode_to_nary((FNODE)FA1(f));
+			return mkfnode(2,f->id,a0,a1);
+
+		/* ternary operators */
+		case I_CE:
+			a0 = fnode_to_nary((FNODE)FA0(f));
+			a1 = fnode_to_nary((FNODE)FA1(f));
+			a2 = fnode_to_nary((FNODE)FA2(f));
+			return mkfnode(3,f->id,a0,a1,a2);
+			break;
+
+		/* function */
+		case I_FUNC:
+			a1 = fnode_to_nary((FNODE)FA1(f));
+			return mkfnode(2,f->id,FA0(f),a1);
+
+		case I_LIST: case I_EV:
+			n = fnode_to_nary_node((NODE)FA0(f));
+			return mkfnode(1,f->id,n);
+
+		case I_STR: case I_FORMULA: case I_PVAR:
+			return f;
+
+		default:
+			error("fnode_to_nary : not implemented yet");
+	}
+}
+
+FNODE fnode_to_bin(FNODE f,int dir)
+{
+	FNODE a0,a1,a2;
+	NODE n,t;
+	pointer val;
+	ARF fun;
+	int len,i;
+	FNODE *arg;
+
+	if ( !f )
+		return f;
+	switch ( f->id ) {
+		case I_NARYOP: 
+			fun = (ARF)FA0(f);
+			len = length((NODE)FA1(f));
+			if ( len==1 ) return BDY((NODE)(FA1(f)));
+
+			arg = (FNODE *)ALLOCA(len*sizeof(FNODE));
+			for ( i = 0, t = (NODE)FA1(f); i < len; i++, t = NEXT(t) )
+				arg[i] = fnode_to_bin((FNODE)BDY(t),dir);
+			if ( dir ) {
+				a2 = mkfnode(3,I_BOP,fun,arg[len-2],arg[len-1]);
+				for ( i = len-3; i >= 0; i-- )
+					a2 = mkfnode(3,I_BOP,fun,arg[i],a2);
+			} else {
+				a2 = mkfnode(3,I_BOP,fun,arg[0],arg[1]);
+				for ( i = 2; i < len; i++ )
+					a2 = mkfnode(3,I_BOP,fun,a2,arg[i]);
+			}
+			return a2;
+
+		case I_NOT: case I_PAREN: case I_MINUS:
+		case I_CAR: case I_CDR:
+			a0 = fnode_to_bin((FNODE)FA0(f),dir);
+			return mkfnode(1,f->id,a0);
+
+		case I_BOP: case I_COP: case I_LOP:
+			a1 = fnode_to_bin((FNODE)FA1(f),dir);
+			a2 = fnode_to_bin((FNODE)FA2(f),dir);
+			return mkfnode(3,f->id,FA0(f),a1,a2);
+
+		case I_AND: case I_OR:
+			a0 = fnode_to_bin((FNODE)FA0(f),dir);
+			a1 = fnode_to_bin((FNODE)FA1(f),dir);
+			return mkfnode(2,f->id,a0,a1);
+
+		/* ternary operators */
+		case I_CE:
+			a0 = fnode_to_bin((FNODE)FA0(f),dir);
+			a1 = fnode_to_bin((FNODE)FA1(f),dir);
+			a2 = fnode_to_bin((FNODE)FA2(f),dir);
+			return mkfnode(3,f->id,a0,a1,a2);
+			break;
+
+		/* function */
+		case I_FUNC:
+			a1 = fnode_to_bin((FNODE)FA1(f),dir);
+			return mkfnode(2,f->id,FA0(f),a1);
+
+		case I_LIST: case I_EV:
+			n = fnode_to_bin_node((NODE)FA0(f),dir);
+			return mkfnode(1,f->id,n);
+
+		case I_STR: case I_FORMULA: case I_PVAR:
+			return f;
+
+		default:
+			error("fnode_to_bin : not implemented yet");
+	}
+}
+
+NODE partial_eval_node(NODE n);
+FNODE partial_eval(FNODE f);
+
+FNODE partial_eval(FNODE f)
+{
+	FNODE a0,a1,a2;
+	NODE n;
+	pointer val;
+
+	if ( !f )
+		return f;
+	switch ( f->id ) {
+		case I_NOT: case I_PAREN: case I_MINUS:
+		case I_CAR: case I_CDR:
+			a0 = partial_eval((FNODE)FA0(f));
+			return mkfnode(1,f->id,a0);
+
+		case I_BOP: case I_COP: case I_LOP:
+			a1 = partial_eval((FNODE)FA1(f));
+			a2 = partial_eval((FNODE)FA2(f));
+			return mkfnode(3,f->id,FA0(f),a1,a2);
+
+		case I_NARYOP:
+			n = partial_eval_node((NODE)FA1(f));
+			return mkfnode(2,f->id,FA0(f),n);
+
+		case I_AND: case I_OR:
+			a0 = partial_eval((FNODE)FA0(f));
+			a1 = partial_eval((FNODE)FA1(f));
+			return mkfnode(2,f->id,a0,a1);
+
+		/* ternary operators */
+		case I_CE:
+			a0 = partial_eval((FNODE)FA0(f));
+			a1 = partial_eval((FNODE)FA1(f));
+			a2 = partial_eval((FNODE)FA2(f));
+			return mkfnode(3,f->id,a0,a1,a2);
+			break;
+
+		/* function */
+		case I_FUNC:
+			a1 = partial_eval((FNODE)FA1(f));
+			return mkfnode(2,f->id,FA0(f),a1);
+
+		case I_LIST: case I_EV:
+			n = partial_eval_node((NODE)FA0(f));
+			return mkfnode(1,f->id,n);
+
+		case I_STR: case I_FORMULA:
+			return f;
+
+		/* program variable */
+		case I_PVAR:
+			val = eval(f);
+			if ( val && OID((Obj)val) == O_QUOTE )
+				return partial_eval((FNODE)BDY((QUOTE)val));
+			else
+				return mkfnode(1,I_FORMULA,val);
+
+		default:
+			error("partial_eval : not implemented yet");
+	}
+}
+
+NODE partial_eval_node(NODE n)
+{
+	NODE r0,r,t;
+
+	for ( r0 = 0, t = n; t; t = NEXT(t) ) {
+		NEXTNODE(r0,r);
+		BDY(r) = partial_eval((FNODE)BDY(t));
+	}
+	if ( r0 ) NEXT(r) = 0;
+	return r0;
+}
+
+NODE rewrite_fnode_node(NODE n,NODE arg);
+FNODE rewrite_fnode(FNODE f,NODE arg);
+
+FNODE rewrite_fnode(FNODE f,NODE arg)
+{
+	FNODE a0,a1,a2,value;
+	NODE n,t,pair;
+	pointer val;
+	int pv,ind;
+
+	if ( !f )
+		return f;
+	switch ( f->id ) {
+		case I_NOT: case I_PAREN: case I_MINUS:
+		case I_CAR: case I_CDR:
+			a0 = rewrite_fnode((FNODE)FA0(f),arg);
+			return mkfnode(1,f->id,a0);
+
+		case I_BOP: case I_COP: case I_LOP:
+			a1 = rewrite_fnode((FNODE)FA1(f),arg);
+			a2 = rewrite_fnode((FNODE)FA2(f),arg);
+			return mkfnode(3,f->id,FA0(f),a1,a2);
+
+		case I_AND: case I_OR:
+			a0 = rewrite_fnode((FNODE)FA0(f),arg);
+			a1 = rewrite_fnode((FNODE)FA1(f),arg);
+			return mkfnode(2,f->id,a0,a1);
+
+		/* ternary operators */
+		case I_CE:
+			a0 = rewrite_fnode((FNODE)FA0(f),arg);
+			a1 = rewrite_fnode((FNODE)FA1(f),arg);
+			a2 = rewrite_fnode((FNODE)FA2(f),arg);
+			return mkfnode(3,f->id,a0,a1,a2);
+			break;
+
+		/* nary operators */
+		case I_NARYOP:
+			n = rewrite_fnode_node((NODE)FA1(f),arg);
+			return mkfnode(2,f->id,FA0(f),n);
+
+		/* and function */
+		case I_FUNC:
+			a1 = rewrite_fnode((FNODE)FA1(f),arg);
+			return mkfnode(2,f->id,FA0(f),a1);
+
+		case I_LIST: case I_EV:
+			n = rewrite_fnode_node((NODE)FA0(f),arg);
+			return mkfnode(1,f->id,n);
+
+		case I_STR: case I_FORMULA:
+			return f;
+
+		/* program variable */
+		case I_PVAR:
+			pv = (int)FA0(f);
+			for ( t = arg; t; t = NEXT(t) ) {
+				pair = (NODE)BDY(t);
+				ind = (int)BDY(pair); value = (FNODE)BDY(NEXT(pair));
+				if ( pv == ind )
+					return value;
+			}
+			return f;
+			break;
+
+		default:
+			error("rewrite_fnode : not implemented yet");
+	}
+}
+
+NODE rewrite_fnode_node(NODE n,NODE arg)
+{
+	NODE r0,r,t;
+
+	for ( r0 = 0, t = n; t; t = NEXT(t) ) {
+		NEXTNODE(r0,r);
+		BDY(r) = rewrite_fnode((FNODE)BDY(t),arg);
+	}
+	if ( r0 ) NEXT(r) = 0;
+	return r0;
+}
+
+NODE fnode_to_nary_node(NODE n)
+{
+	NODE r0,r,t;
+
+	for ( r0 = 0, t = n; t; t = NEXT(t) ) {
+		NEXTNODE(r0,r);
+		BDY(r) = fnode_to_nary((FNODE)BDY(t));
+	}
+	if ( r0 ) NEXT(r) = 0;
+	return r0;
+}
+
+NODE fnode_to_bin_node(NODE n,int dir)
+{
+	NODE r0,r,t;
+
+	for ( r0 = 0, t = n; t; t = NEXT(t) ) {
+		NEXTNODE(r0,r);
+		BDY(r) = fnode_to_bin((FNODE)BDY(t),dir);
+	}
+	if ( r0 ) NEXT(r) = 0;
+	return r0;
+}
+
+V searchvar(char *name);
+
 pointer evalstat(SNODE f)
 {
 	pointer val = 0,t,s,s1;
 	P u;
 	NODE tn;
 	int i,ac;
+	V v;
 	V *a;
 	char *buf;
+	FUNC func;
 
 	if ( !f )
 		return ( 0 );
@@ -376,7 +733,13 @@ pointer evalstat(SNODE f)
 				makevar(buf,&u); a[i] = VR(u);
 				substr(CO,0,(Obj)s,VR((P)t),(Obj)u,(Obj *)&s1); s = s1;
 			}
-			mkpf((char *)FA0(f),(Obj)s,ac,a,0,0,0,(PF *)&val); val = 0; break;
+			mkpf((char *)FA0(f),(Obj)s,ac,a,0,0,0,(PF *)&val); val = 0;
+			v = searchvar((char *)FA0(f));
+			if ( v ) {
+				searchpf((char *)FA0(f),&func);
+				makesrvar(func,&u);
+			}
+			break;
 		case S_SINGLE:
 			val = eval((FNODE)FA0(f)); break;
 		case S_CPLX:
@@ -428,6 +791,13 @@ pointer evalstat(SNODE f)
 					break;
 			}
 			f_break = 0; break;
+		case S_MODULE:
+			CUR_MODULE = (MODULE)FA0(f);
+			if ( CUR_MODULE )
+					MPVS = CUR_MODULE->pvs;
+			else
+					MPVS = 0;
+			break;
 		default:
 			error("evalstat : unknown id");
 			break;
@@ -449,6 +819,33 @@ pointer evalnode(NODE node)
 extern FUNC cur_binf;
 extern NODE PVSS;
 
+LIST eval_arg(FNODE a,unsigned int quote)
+{
+	LIST l;
+	FNODE fn;
+	NODE n,n0,tn;
+	QUOTE q;
+	int i;
+
+	for ( tn = (NODE)FA0(a), n0 = 0, i = 0; tn; tn = NEXT(tn), i++ ) {
+		NEXTNODE(n0,n);
+		if ( quote & (1<<i) ) {
+			fn = (FNODE)(BDY(tn));
+			if ( fn->id == I_FORMULA && FA0(fn) 
+				&& OID((Obj)FA0(fn))== O_QUOTE )
+		 		BDY(n) = FA0(fn);		
+			else {
+				MKQUOTE(q,(FNODE)BDY(tn));
+				BDY(n) = (pointer)q;
+			}
+		} else
+			BDY(n) = eval((FNODE)BDY(tn));
+	}
+	if ( n0 ) NEXT(n) = 0;
+	MKLIST(l,n0);
+	return l;
+}
+
 pointer evalf(FUNC f,FNODE a,FNODE opt)
 {
 	LIST args;
@@ -459,10 +856,15 @@ pointer evalf(FUNC f,FNODE a,FNODE opt)
 	char errbuf[BUFSIZ];
 	static unsigned int stack_size;
 	static void *stack_base;
+	FUNC f1;
 
 	if ( f->id == A_UNDEF ) {
-		sprintf(errbuf,"evalf : %s undefined",NAME(f));
-		error(errbuf);
+		gen_searchf_searchonly(f->fullname,&f1);
+		if ( f1->id == A_UNDEF ) {
+			sprintf(errbuf,"evalf : %s undefined",NAME(f));
+			error(errbuf);
+		} else
+			*f = *f1;
 	}
 	if ( getsecuremode() && !PVSS && !f->secure ) {
 		sprintf(errbuf,"evalf : %s not permitted",NAME(f));
@@ -495,7 +897,7 @@ pointer evalf(FUNC f,FNODE a,FNODE opt)
 				cur_binf = f;
 				(*f->f.binf)(&val);
 			} else {
-				args = (LIST)eval(a);
+				args = (LIST)eval_arg(a,f->quote);
 				current_option = opts;
 				cur_binf = f;
 				(*f->f.binf)(args?BDY(args):0,&val);
@@ -521,7 +923,7 @@ pointer evalf(FUNC f,FNODE a,FNODE opt)
 			if ( (stack_base - (void *)&args) +0x100000 > stack_size )
 				error("stack overflow");
 #endif
-			args = (LIST)eval(a);
+			args = (LIST)eval_arg(a,f->quote);
 			if ( opt ) {
 				opts = BDY((LIST)eval(opt));
 				/* opts = ["opt1",arg1],... */
@@ -568,7 +970,7 @@ pointer evalf(FUNC f,FNODE a,FNODE opt)
 			break;
 		case A_PURE:
 			args = (LIST)eval(a);
-			val = evalpf(f->f.puref,args?BDY(args):0);
+			val = evalpf(f->f.puref,args?BDY(args):0,0);
 			break;
 		default:
 			sprintf(errbuf,"evalf : %s undefined",NAME(f));
@@ -578,6 +980,28 @@ pointer evalf(FUNC f,FNODE a,FNODE opt)
 	return val;
 }
 
+pointer evalf_deriv(FUNC f,FNODE a,FNODE deriv)
+{
+	LIST args,dargs;
+	pointer val;
+	char errbuf[BUFSIZ];
+
+	switch ( f->id ) {
+		case A_PURE:
+			args = (LIST)eval(a);
+			dargs = (LIST)eval(deriv);
+			val = evalpf(f->f.puref,
+				args?BDY(args):0,dargs?BDY(dargs):0);
+			break;
+		default:
+			sprintf(errbuf,
+				"evalf : %s is not a pure function",NAME(f));
+			error(errbuf);
+			break;
+	}
+	return val;
+}
+
 pointer evalmapf(FUNC f,FNODE a)
 {
 	LIST args;
@@ -589,7 +1013,7 @@ pointer evalmapf(FUNC f,FNODE a)
 	int len,row,col,i,j;
 	pointer val;
 
-	args = (LIST)eval(a);
+	args = (LIST)eval_arg(a,f->quote);
 	node = BDY(args); head = (Obj)BDY(node); rest = NEXT(node);
 	if ( !head ) {
 		val = bevalf(f,node);
@@ -632,7 +1056,7 @@ pointer eval_rec_mapf(FUNC f,FNODE a)
 {
 	LIST args;
 
-	args = (LIST)eval(a);
+	args = (LIST)eval_arg(a,f->quote);
 	return beval_rec_mapf(f,BDY(args));
 }
 
@@ -691,7 +1115,7 @@ pointer bevalf(FUNC f,NODE a)
 	pointer val;
 	int i,n;
 	NODE tn,sn;
-    VS pvs;
+	VS pvs,prev_mpvs;
 	char errbuf[BUFSIZ];
 
 	if ( f->id == A_UNDEF ) {
@@ -743,11 +1167,17 @@ pointer bevalf(FUNC f,NODE a)
 			for ( tn = f->f.usrf->args, sn = a; 
 				sn; tn = NEXT(tn), sn = NEXT(sn) )
 				ASSPV((int)FA0((FNODE)BDY(tn)),BDY(sn));
-			val = evalstat((SNODE)BDY(f->f.usrf)); 
+			if ( f->f.usrf->module ) {
+				prev_mpvs = MPVS;
+				MPVS = f->f.usrf->module->pvs;
+				val = evalstat((SNODE)BDY(f->f.usrf)); 
+				MPVS = prev_mpvs;
+			} else
+				val = evalstat((SNODE)BDY(f->f.usrf)); 
 			f_return = f_break = f_continue = 0; poppvs(); 
 			break;
 		case A_PURE:
-			val = evalpf(f->f.puref,a);
+			val = evalpf(f->f.puref,a,0);
 			break;
 		default:
 			sprintf(errbuf,"bevalf : %s undefined",NAME(f));
@@ -760,36 +1190,56 @@ pointer bevalf(FUNC f,NODE a)
 pointer evalif(FNODE f,FNODE a)
 {
 	Obj g;
+	QUOTE q;
+	FNODE t;
+	LIST l;
 
 	g = (Obj)eval(f);
 	if ( g && (OID(g) == O_P) && (VR((P)g)->attr == (pointer)V_SR) )
 		return evalf((FUNC)VR((P)g)->priv,a,0);
-	else {
+	else if ( g && OID(g) == O_QUOTEARG && ((QUOTEARG)g)->type == A_func ) {
+		t = mkfnode(2,I_FUNC,((QUOTEARG)g)->body,a);
+		MKQUOTE(q,t);
+		return q;
+	} else {
 		error("invalid function pointer");
 		/* NOTREACHED */
 		return (pointer)-1;
 	}
 }
 
-pointer evalpf(PF pf,NODE args)
+pointer evalpf(PF pf,NODE args,NODE dargs)
 {
 	Obj s,s1;
-	int i;
-	NODE node;
+	int i,di,j;
+	NODE node,dnode;
 	PFINS ins;
 	PFAD ad;
 	
 	if ( !pf->body ) {
 		ins = (PFINS)CALLOC(1,sizeof(PF)+pf->argc*sizeof(struct oPFAD));
 		ins->pf = pf;
-		for ( i = 0, node = args, ad = ins->ad;
-			node; node = NEXT(node), i++ ) {
-			ad[i].d = 0; ad[i].arg = (Obj)node->body;	
+		for ( i = 0, node = args, dnode = dargs, ad = ins->ad;
+			node; i++ ) {
+			ad[i].arg = (Obj)node->body;	
+			if ( !dnode ) ad[i].d = 0;
+			else
+				ad[i].d = QTOS((Q)dnode->body);
+			node = NEXT(node);
+			if ( dnode ) dnode = NEXT(dnode);
 		}
 		simplify_ins(ins,&s);
 	} else {
-		for ( i = 0, s = pf->body, node = args; 
-			node; node = NEXT(node), i++ ) {
+		s = pf->body;
+		if ( dnode ) {
+			for ( i = 0, dnode = dargs; dnode; dnode = NEXT(dnode), i++ ) {
+				di = QTOS((Q)dnode->body);
+				for ( j = 0; j < di; j++ ) {
+					derivr(CO,s,pf->args[i],&s1); s = s1;
+				}
+			}
+		}
+		for ( i = 0, node = args; node; node = NEXT(node), i++ ) {
 			substr(CO,0,s,pf->args[i],(Obj)node->body,&s1); s = s1;
 		}
 	}
@@ -988,6 +1438,9 @@ void mkuf(char *name,char *fname,NODE args,SNODE body,
 	char *longname;
 	int argc;
 
+	if ( getsecuremode() ) {
+		error("defining function is not permitted in the secure mode");
+	}
 	if ( *name == ':' )
 		name += 2;
 	if ( !module ) {