=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/eval.c,v retrieving revision 1.39 retrieving revision 1.43 diff -u -p -r1.39 -r1.43 --- OpenXM_contrib2/asir2000/parse/eval.c 2004/12/18 03:27:17 1.39 +++ OpenXM_contrib2/asir2000/parse/eval.c 2005/09/14 02:48:38 1.43 @@ -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.38 2004/11/22 04:11:36 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.42 2005/09/13 06:54:22 noro Exp $ */ #include #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,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 ) { @@ -332,14 +334,18 @@ pointer eval(FNODE f) return ( val ); } +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 ); @@ -378,7 +384,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: @@ -430,6 +442,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; @@ -461,10 +480,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)); @@ -768,11 +792,15 @@ pointer bevalf(FUNC f,NODE a) pointer evalif(FNODE f,FNODE a) { Obj g; + FNODE t; 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); + return eval(t); + } else { error("invalid function pointer"); /* NOTREACHED */ return (pointer)-1;