| Bill Allombert on Tue, 21 Aug 2007 17:16:17 +0200 |
[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]
| [patch] lexically-scoped variables v2 |
Dear PARI-dev, This patch is an implementation of lexically-scoped variables in GP. This patch cause the following changes: 1) The new keyword my() allow to declare lexically scoped variables. 2) Functions parameters are lexically scoped. (This is an incompatibility with GP 2.3) 3) my() and local() can now happen anywhere in the code and the scope of the variables is limited to the current closure. 4) Variables defined through the prototype code V are dynamically scoped. (This is an incompatibility with GP 2.3) The code V is handled this way: 1) functions do not get any argument for V (used to be an entree*), but the corresponding closure use the variable name as a lexical variable to be created by the caller, see below. 2) the following functions are available to handle lexical variables: void push_lex(GEN val) Create a new lexical variable with initial value val. void pop_lex(void) Destroy the last lexical variable created. GEN get_lex(long vn) if vn=-1, get the value of the last lexical variable created, if vn=-2, get the value of the last but one lexical variable created, etc. void set_lex(long vn, GEN x); if vn=-1, set the value of the last lexical variable created, if vn=-2, set the value of the last but one lexical variable created, etc. vn=-2 is used for the function matrix() which needs two lexical variables. Known limitations: 1) The memory model was preserved so we essentially get the same set of bugs as with GP 2.3. 2) This is slightly slower than it should be. 3) This breaks most usage of trap() for debugging: ? f(z)=1/z ? trap ? f(0) *** _/_: division by zero *** Break loop (type 'break' or Control-d to go back to GP) break> z z instead of 0,because the lexical variable z is not defined in this scope. Maybe we should ditch trap completly and start again and implement: 1) a true iferr() facility. 2) a true debugging facility. Cheers, Bill.
Index: config/Makefile.SH
===================================================================
RCS file: /home/cvs/pari/config/Makefile.SH,v
retrieving revision 1.181
diff -u -r1.181 Makefile.SH
--- config/Makefile.SH 2 Aug 2007 21:56:06 -0000 1.181
+++ config/Makefile.SH 21 Aug 2007 15:04:50 -0000
@@ -608,7 +608,7 @@
cflags="$cflags \$(PLOTCFLAGS)"
depend="$src/graph/rect.h"
;;
- es|sumiter)
+ es|sumiter|intnum)
depend="$src/language/anal.h"
cflags="$cflags \$(DLCFLAGS)"
;;
Index: src/basemath/subgroup.c
===================================================================
RCS file: /home/cvs/pari/src/basemath/subgroup.c,v
retrieving revision 1.68
diff -u -r1.68 subgroup.c
--- src/basemath/subgroup.c 1 Aug 2007 01:11:08 -0000 1.68
+++ src/basemath/subgroup.c 21 Aug 2007 15:04:50 -0000
@@ -92,9 +92,9 @@
std_fun(subgp_iter *T, GEN x)
{
pari_sp ltop=avma;
- exprdat *E = (exprdat *)T->fundata;
- E->ep->value = (void*)x;
- closure_evalvoid(E->code); T->countsub++;
+ GEN code = (GEN) T->fundata;
+ set_lex(-1,x);
+ closure_evalvoid(code); T->countsub++;
avma=ltop;
}
/* ----subgp_iter 'fun' associated to subgrouplist ------------- */
@@ -548,10 +548,9 @@
}
void
-forsubgroup(entree *ep, GEN cyc, GEN bound, GEN code)
+forsubgroup(GEN cyc, GEN bound, GEN code)
{
subgp_iter T;
- exprdat E;
long N;
T.fun = &std_fun;
@@ -559,13 +558,12 @@
if (!cyc) pari_err(typeer,"forsubgroup");
T.bound = bound;
T.cyc = cyc;
- E.code = code;
- E.ep= ep; T.fundata = (void*)&E;
- push_val(ep, gen_0);
+ T.fundata = (void*)code;
+ push_lex(gen_0);
subgroup_engine(&T);
- pop_val(ep);
+ pop_lex();
}
static GEN
Index: src/desc/doc_make
===================================================================
RCS file: /home/cvs/pari/src/desc/doc_make,v
retrieving revision 1.7
diff -u -r1.7 doc_make
--- src/desc/doc_make 3 Apr 2007 08:24:20 -0000 1.7
+++ src/desc/doc_make 21 Aug 2007 15:04:50 -0000
@@ -71,7 +71,7 @@
next;
}
if ($c eq 'V') {
- $args .= ", entree *". shift(@ARGS) ." = NULL"; next;
+ next;
}
if ($c =~ /^[EI]$/) {
$args .= ", char *". shift(@ARGS) ." = NULL"; next;
Index: src/graph/plotport.c
===================================================================
RCS file: /home/cvs/pari/src/graph/plotport.c,v
retrieving revision 1.60
diff -u -r1.60 plotport.c
--- src/graph/plotport.c 17 May 2007 11:14:37 -0000 1.60
+++ src/graph/plotport.c 21 Aug 2007 15:05:02 -0000
@@ -106,13 +106,13 @@
static GEN quark_gen;
static GEN
-READ_EXPR(GEN code, entree *ep, GEN x) {
+READ_EXPR(GEN code, GEN x) {
if (code == QUARK) return gsubst(quark_gen,0,x);
- ep->value = x; return closure_evalgen(code);
+ set_lex(-1,x); return closure_evalgen(code);
}
void
-plot(entree *ep, GEN a, GEN b, GEN code, GEN ysmlu,GEN ybigu, long prec)
+plot(GEN a, GEN b, GEN code, GEN ysmlu,GEN ybigu, long prec)
{
long jz, j, i, sig;
pari_sp av = avma, av2, limite;
@@ -124,7 +124,7 @@
sig=gcmp(b,a); if (!sig) return;
if (sig<0) { x=a; a=b; b=x; }
- x = gtofp(a, prec); push_val(ep, x);
+ x = gtofp(a, prec); push_lex(x);
dx = divru(gtofp(gsub(b,a),prec), ISCR-1);
ysml = ybig = 0.;
for (j=1; j<=JSCR; j++) scr[1][j]=scr[ISCR][j]=YY;
@@ -137,7 +137,7 @@
av2 = avma; limite=stack_lim(av2,1);
for (i=1; i<=ISCR; i++)
{
- y[i] = gtodouble( READ_EXPR(code,ep,x) );
+ y[i] = gtodouble( READ_EXPR(code,x) );
if (y[i] < ysml) ysml = y[i];
if (y[i] > ybig) ybig = y[i];
x = addrr(x,dx);
@@ -178,7 +178,7 @@
for (i=1; i<=ISCR; i++) pariputc(scr[i][1]);
pariputc('\n');
pariprintf("%10s%-9.7g%*.7g\n"," ",todbl(a),ISCR-9,todbl(b));
- pop_val(ep);
+ pop_lex();
}
/********************************************************************/
@@ -1205,7 +1205,7 @@
}
static void
-single_recursion(dblPointList *pl,GEN code,entree *ep,GEN xleft,double yleft,
+single_recursion(dblPointList *pl,GEN code,GEN xleft,double yleft,
GEN xright,double yright,long depth)
{
GEN xx;
@@ -1215,20 +1215,20 @@
if (depth==RECUR_MAXDEPTH) return;
xx = addrr(xleft,xright); setexpo(xx, expo(xx)-1);
- yy = gtodouble(READ_EXPR(code,ep,xx));
+ yy = gtodouble(READ_EXPR(code,xx));
if (dy && fabs(yleft+yright-2*yy)< dy*RECUR_PREC) return;
- single_recursion(pl,code,ep, xleft,yleft, xx,yy, depth+1);
+ single_recursion(pl,code, xleft,yleft, xx,yy, depth+1);
Appendx(&pl[0],&pl[0],rtodbl(xx));
Appendy(&pl[0],&pl[1],yy);
- single_recursion(pl,code,ep, xx,yy, xright,yright, depth+1);
+ single_recursion(pl,code, xx,yy, xright,yright, depth+1);
avma = av;
}
static void
-param_recursion(dblPointList *pl,GEN code,entree *ep, GEN tleft,double xleft,
+param_recursion(dblPointList *pl,GEN code,GEN tleft,double xleft,
double yleft, GEN tright,double xright,double yright, long depth)
{
GEN tt, p1;
@@ -1239,25 +1239,25 @@
if (depth==PARAMR_MAXDEPTH) return;
tt = addrr(tleft,tright); setexpo(tt, expo(tt)-1);
- p1 = READ_EXPR(code,ep,tt);
+ p1 = READ_EXPR(code,tt);
xx = gtodouble(gel(p1,1));
yy = gtodouble(gel(p1,2));
if (dx && dy && fabs(xleft+xright-2*xx) < dx*RECUR_PREC
&& fabs(yleft+yright-2*yy) < dy*RECUR_PREC) return;
- param_recursion(pl,code,ep, tleft,xleft,yleft, tt,xx,yy, depth+1);
+ param_recursion(pl,code, tleft,xleft,yleft, tt,xx,yy, depth+1);
Appendx(&pl[0],&pl[0],xx);
Appendy(&pl[0],&pl[1],yy);
- param_recursion(pl,code,ep, tt,xx,yy, tright,xright,yright, depth+1);
+ param_recursion(pl,code, tt,xx,yy, tright,xright,yright, depth+1);
avma = av;
}
/* Pure graphing. If testpoints is 0, it is set to the default.
* Returns a dblPointList of (absolute) coordinates. */
static dblPointList *
-rectplothin(entree *ep, GEN a, GEN b, GEN code, long prec, ulong flags,
+rectplothin(GEN a, GEN b, GEN code, long prec, ulong flags,
long testpoints)
{
long single_c;
@@ -1283,8 +1283,8 @@
if (sig<0) swap(a, b);
dx = divru(gtofp(gsub(b,a),prec), testpoints-1);
- x = gtofp(a, prec); push_val(ep, x);
- av2=avma; t=READ_EXPR(code,ep,x); tx=typ(t);
+ x = gtofp(a, prec); push_lex(x);
+ av2=avma; t=READ_EXPR(code,x); tx=typ(t);
if (!is_matvec_t(tx))
{
xsml = gtodouble(a);
@@ -1337,14 +1337,14 @@
GEN tleft = cgetr(prec), tright = cgetr(prec);
double xleft, xright = 0;
av2 = avma;
- affgr(a,tleft); t=READ_EXPR(code,ep,tleft);
+ affgr(a,tleft); t=READ_EXPR(code,tleft);
xleft = gtodouble(gel(t,1));
yleft = gtodouble(gel(t,2));
for (i=0; i<testpoints-1; i++)
{
if (i) { affrr(tright,tleft); xleft = xright; yleft = yright; }
addrrz(tleft,dx,tright);
- t = READ_EXPR(code,ep,tright);
+ t = READ_EXPR(code,tright);
if (lg(t) != 3) pari_err(talker,"inconsistent data in rectplothin");
xright = gtodouble(gel(t,1));
yright = gtodouble(gel(t,2));
@@ -1352,7 +1352,7 @@
Appendx(&pl[0],&pl[0],xleft);
Appendy(&pl[0],&pl[1],yleft);
- param_recursion(pl,code,ep, tleft,xleft,yleft, tright,xright,yright, 0);
+ param_recursion(pl,code, tleft,xleft,yleft, tright,xright,yright, 0);
avma = av2;
}
Appendx(&pl[0],&pl[0],xright);
@@ -1363,16 +1363,16 @@
GEN xleft = cgetr(prec), xright = cgetr(prec);
av2 = avma;
affgr(a,xleft);
- yleft = gtodouble(READ_EXPR(code,ep,xleft));
+ yleft = gtodouble(READ_EXPR(code,xleft));
for (i=0; i<testpoints-1; i++)
{
addrrz(xleft,dx,xright);
- yright = gtodouble(READ_EXPR(code,ep,xright));
+ yright = gtodouble(READ_EXPR(code,xright));
Appendx(&pl[0],&pl[0],rtodbl(xleft));
Appendy(&pl[0],&pl[1],yleft);
- single_recursion(pl,code,ep,xleft,yleft,xright,yright,0);
+ single_recursion(pl,code,xleft,yleft,xright,yright,0);
avma = av2;
affrr(xright,xleft); yleft = yright;
}
@@ -1385,7 +1385,7 @@
if (single_c)
for (i=0; i<testpoints; i++)
{
- t = READ_EXPR(code,ep,x);
+ t = READ_EXPR(code,x);
pl[0].d[i]=gtodouble(x);
Appendy(&pl[0],&pl[1],gtodouble(t));
addrrz(x,dx,x); avma=av2;
@@ -1397,7 +1397,7 @@
for (i=0; i<testpoints; i++)
{
- t = READ_EXPR(code,ep,x);
+ t = READ_EXPR(code,x);
if (lg(t) != nl+1) pari_err(talker,"inconsistent data in rectplothin");
for (j=0; j<nl; j=k)
{
@@ -1413,14 +1413,14 @@
else /* plothmult */
for (i=0; i<testpoints; i++)
{
- t = READ_EXPR(code,ep,x);
+ t = READ_EXPR(code,x);
if (lg(t) != nl) pari_err(talker,"inconsistent data in rectplothin");
pl[0].d[i]=gtodouble(x);
for (j=1; j<nl; j++) { Appendy(&pl[0],&pl[j],gtodouble(gel(t,j))); }
addrrz(x,dx,x); avma=av2;
}
}
- pl[0].nb=nc; pop_val(ep); avma = av;
+ pl[0].nb=nc; pop_lex(); avma = av;
return pl;
}
@@ -1434,7 +1434,6 @@
long i, j;
pari_sp oldavma = avma;
GEN tas, X = pol_x(0), xa = cgetg(lx+1, t_VEC), ya = cgetg(lx+1, t_VEC);
- entree *var0 = varentries[0];
if (lx < 4) pari_err(talker, "Too few points (%ld) for spline plot", lx);
for (i = 1; i <= lx; i++) {
@@ -1458,7 +1457,7 @@
quark_gen = polint_i(xa, ya, X, 4, NULL);
tas = xa;
}
- rectploth(ne, var0,
+ rectploth(ne,
i==0 ? gel(tas,0) : gel(tas,1),
i==lx-4 ? gel(tas,3) : gel(tas,2),
QUARK, DEFAULTPREC,
@@ -1648,10 +1647,10 @@
/*************************************************************************/
GEN
-rectploth(long drawrect,entree *ep,GEN a,GEN b,GEN code,
+rectploth(long drawrect,GEN a,GEN b,GEN code,
long prec,ulong flags,long testpoints)
{
- dblPointList *pl=rectplothin(ep, a,b, code, prec, flags,testpoints);
+ dblPointList *pl=rectplothin(a,b, code, prec, flags,testpoints);
return rectplothrawin(0,drawrect, pl, flags,NULL);
}
@@ -1672,11 +1671,11 @@
}
static GEN
-ploth0(long stringrect,long drawrect,entree *ep,GEN a,GEN b,GEN code,
+ploth0(long stringrect,long drawrect,GEN a,GEN b,GEN code,
long prec,ulong flags,long testpoints)
{
PARI_plot *output = init_output(flags);
- dblPointList *pl=rectplothin(ep, a,b, code, prec, flags,testpoints);
+ dblPointList *pl=rectplothin(a,b, code, prec, flags,testpoints);
return rectplothrawin(stringrect,drawrect, pl, flags, output);
}
@@ -1702,21 +1701,21 @@
}
GEN
-ploth(entree *ep, GEN a, GEN b, GEN code, long prec,long flags,long numpoints)
+ploth(GEN a, GEN b, GEN code, long prec,long flags,long numpoints)
{
- return ploth0(STRINGRECT, DRAWRECT, ep,a,b,code,prec,flags,numpoints);
+ return ploth0(STRINGRECT, DRAWRECT, a,b,code,prec,flags,numpoints);
}
GEN
-ploth2(entree *ep, GEN a, GEN b, GEN code, long prec)
+ploth2(GEN a, GEN b, GEN code, long prec)
{
- return ploth0(STRINGRECT, DRAWRECT, ep,a,b,code,prec,PLOT_PARAMETRIC,0);
+ return ploth0(STRINGRECT, DRAWRECT, a,b,code,prec,PLOT_PARAMETRIC,0);
}
GEN
-plothmult(entree *ep, GEN a, GEN b, GEN code, long prec)
+plothmult(GEN a, GEN b, GEN code, long prec)
{
- return ploth0(STRINGRECT, DRAWRECT, ep,a,b,code,prec,0,0);
+ return ploth0(STRINGRECT, DRAWRECT, a,b,code,prec,0,0);
}
GEN
@@ -1727,18 +1726,17 @@
}
GEN
-postploth(entree *ep, GEN a, GEN b, GEN code, long prec,long flags,
- long numpoints)
+postploth(GEN a, GEN b, GEN code, long prec,long flags, long numpoints)
{
- return ploth0(STRINGRECT,DRAWRECT,ep,a,b,code,prec,flags|PLOT_POSTSCRIPT,
+ return ploth0(STRINGRECT,DRAWRECT,a,b,code,prec,flags|PLOT_POSTSCRIPT,
numpoints);
}
GEN
-postploth2(entree *ep, GEN a, GEN b, GEN code, long prec,
+postploth2(GEN a, GEN b, GEN code, long prec,
long numpoints)
{
- return ploth0(STRINGRECT,DRAWRECT,ep,a,b,code,prec,
+ return ploth0(STRINGRECT,DRAWRECT,a,b,code,prec,
PLOT_PARAMETRIC|PLOT_POSTSCRIPT,numpoints);
}
Index: src/graph/rect.h
===================================================================
RCS file: /home/cvs/pari/src/graph/rect.h,v
retrieving revision 1.24
diff -u -r1.24 rect.h
--- src/graph/rect.h 10 May 2007 22:30:30 -0000 1.24
+++ src/graph/rect.h 21 Aug 2007 15:05:02 -0000
@@ -266,17 +266,17 @@
void initrect_gen(long ne, GEN x, GEN y, long flag);
void killrect(long ne);
void plot_count(long *w, long lw, col_counter rcolcnt);
-void plot(entree *ep, GEN a, GEN b, GEN code, GEN ysmlu, GEN ybigu, long prec);
-GEN ploth(entree *ep, GEN a, GEN b, GEN code, long prec, long flag, long numpoints);
-GEN ploth2(entree *ep, GEN a, GEN b, GEN code, long prec);
-GEN plothmult(entree *ep, GEN a, GEN b, GEN code, long prec);
+void plot(GEN a, GEN b, GEN code, GEN ysmlu, GEN ybigu, long prec);
+GEN ploth(GEN a, GEN b, GEN code, long prec, long flag, long numpoints);
+GEN ploth2(GEN a, GEN b, GEN code, long prec);
+GEN plothmult(GEN a, GEN b, GEN code, long prec);
GEN plothraw(GEN listx, GEN listy, long flag);
GEN plothsizes(void);
GEN plothsizes_flag(long flag);
void postdraw(GEN list);
void postdraw_flag(GEN list, long flag);
-GEN postploth(entree *ep,GEN a,GEN b,GEN code,long prec,long flag,long numpoints);
-GEN postploth2(entree *ep,GEN a,GEN b,GEN code,long prec,long numpoints);
+GEN postploth(GEN a,GEN b,GEN code,long prec,long flag,long numpoints);
+GEN postploth2(GEN a,GEN b,GEN code,long prec,long numpoints);
GEN postplothraw(GEN listx, GEN listy, long flag);
void rectbox(long ne, GEN gx2, GEN gy2);
void rectcolor(long ne, long color);
@@ -289,7 +289,7 @@
void rectlines(long ne, GEN listx, GEN listy, long flag);
void rectlinetype(long ne, long t);
void rectmove(long ne, GEN x, GEN y);
-GEN rectploth(long drawrect,entree *ep, GEN a, GEN b, GEN code, long prec, ulong flags, long testpoints);
+GEN rectploth(long drawrect,GEN a, GEN b, GEN code, long prec, ulong flags, long testpoints);
GEN rectplothraw(long drawrect, GEN data, long flags);
void rectpoint(long ne, GEN x, GEN y);
void rectpoints(long ne, GEN listx, GEN listy);
Index: src/headers/paridecl.h
===================================================================
RCS file: /home/cvs/pari/src/headers/paridecl.h,v
retrieving revision 1.689
diff -u -r1.689 paridecl.h
--- src/headers/paridecl.h 17 Aug 2007 14:25:07 -0000 1.689
+++ src/headers/paridecl.h 21 Aug 2007 15:05:04 -0000
@@ -1914,8 +1914,8 @@
GEN sumpos(void *E, GEN (*eval)(GEN,void*), GEN a, long prec);
GEN sumpos2(void *E, GEN (*eval)(GEN,void*), GEN a, long prec);
GEN suminf(void *E, GEN (*eval)(GEN,void*), GEN a, long prec);
-GEN vecteur(GEN nmax, entree *ep, GEN n);
-GEN vvecteur(GEN nmax, entree *ep, GEN n);
+GEN vecteur(GEN nmax, GEN n);
+GEN vvecteur(GEN nmax, GEN n);
GEN zbrent(void *E, GEN (*eval)(GEN,void*), GEN a, GEN b, long prec);
/* thue.c */
Index: src/headers/paripriv.h
===================================================================
RCS file: /home/cvs/pari/src/headers/paripriv.h,v
retrieving revision 1.159
diff -u -r1.159 paripriv.h
--- src/headers/paripriv.h 17 Aug 2007 14:25:07 -0000 1.159
+++ src/headers/paripriv.h 21 Aug 2007 15:05:42 -0000
@@ -64,7 +64,7 @@
GEN setloop(GEN a);
/* parser */
-void forpari(entree *ep, GEN a, GEN b, GEN node);
+void forpari(GEN a, GEN b, GEN node);
void untilpari(GEN a, GEN b);
void whilepari(GEN a, GEN b);
GEN ifpari(GEN g, GEN a, GEN b);
@@ -86,39 +86,39 @@
GEN gsub1e(GEN *x);
GEN gshift_right(GEN x, long n);
-GEN derivnum0(entree *ep, GEN a, GEN code, long prec);
-GEN direuler0(entree *ep, GEN a, GEN b, GEN code, GEN c);
-GEN divsum(GEN num,entree *ep, GEN code);
-void fordiv(GEN a, entree *ep, GEN code);
-void forell(entree *ep, long a, long b, GEN code);
-void forprime(entree *ep, GEN a, GEN b, GEN code);
-void forstep(entree *ep, GEN a, GEN b, GEN s, GEN code);
-void forsubgroup(entree *oep, GEN cyc, GEN bound, GEN code);
-void forvec(entree *ep, GEN x, GEN code, long flag);
-GEN intcirc0(entree *ep, GEN a, GEN R, GEN code, GEN tab, long prec);
-GEN intfourcos0(entree *ep, GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
-GEN intfourexp0(entree *ep, GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
-GEN intfoursin0(entree *ep, GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
-GEN intfuncinit0(entree *ep, GEN a, GEN b, GEN code, long flag, long m, long prec);
-GEN intlaplaceinv0(entree *ep, GEN sig, GEN x, GEN code, GEN tab, long prec);
-GEN intmellininv0(entree *ep, GEN sig, GEN x, GEN code, GEN tab, long prec);
-GEN intnum0(entree *ep, GEN a, GEN b, GEN code, GEN tab, long prec);
+GEN derivnum0(GEN a, GEN code, long prec);
+GEN direuler0(GEN a, GEN b, GEN code, GEN c);
+GEN divsum(GEN num, GEN code);
+void fordiv(GEN a, GEN code);
+void forell(long a, long b, GEN code);
+void forprime(GEN a, GEN b, GEN code);
+void forstep(GEN a, GEN b, GEN s, GEN code);
+void forsubgroup(GEN cyc, GEN bound, GEN code);
+void forvec(GEN x, GEN code, long flag);
+GEN intcirc0(GEN a, GEN R, GEN code, GEN tab, long prec);
+GEN intfourcos0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
+GEN intfourexp0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
+GEN intfoursin0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
+GEN intfuncinit0(GEN a, GEN b, GEN code, long flag, long m, long prec);
+GEN intlaplaceinv0(GEN sig, GEN x, GEN code, GEN tab, long prec);
+GEN intmellininv0(GEN sig, GEN x, GEN code, GEN tab, long prec);
+GEN intnum0(GEN a, GEN b, GEN code, GEN tab, long prec);
GEN intnuminit0(GEN a, GEN b, GEN tab, long prec);
-GEN intnuminitgen0(entree *ep, GEN a, GEN b, GEN code, long m, long flag, long prec);
-GEN intnumromb0(entree *ep, GEN a, GEN b, GEN code, long flag, long prec);
-GEN matrice(GEN nlig, GEN ncol,entree *ep1, entree *ep2, GEN code);
-GEN prodeuler0(entree *ep, GEN a, GEN b, GEN code, long prec);
-GEN prodinf0(entree *ep, GEN a, GEN code, long flag, long prec);
-GEN produit(entree *ep, GEN a, GEN b, GEN code, GEN x);
-GEN somme(entree *ep, GEN a, GEN b, GEN code, GEN x);
-GEN sumalt0(entree *ep, GEN a, GEN code,long flag, long prec);
-GEN suminf0(entree *ep, GEN a, GEN code, long prec);
-GEN sumnum0(entree *ep, GEN a, GEN sig, GEN code, GEN tab, long flag, long prec);
-GEN sumnumalt0(entree *ep, GEN a, GEN sig, GEN code, GEN tab, long flag, long prec);
+GEN intnuminitgen0(GEN a, GEN b, GEN code, long m, long flag, long prec);
+GEN intnumromb0(GEN a, GEN b, GEN code, long flag, long prec);
+GEN matrice(GEN nlig, GEN ncol, GEN code);
+GEN prodeuler0(GEN a, GEN b, GEN code, long prec);
+GEN prodinf0(GEN a, GEN code, long flag, long prec);
+GEN produit(GEN a, GEN b, GEN code, GEN x);
+GEN somme(GEN a, GEN b, GEN code, GEN x);
+GEN sumalt0(GEN a, GEN code,long flag, long prec);
+GEN suminf0(GEN a, GEN code, long prec);
+GEN sumnum0(GEN a, GEN sig, GEN code, GEN tab, long flag, long prec);
+GEN sumnumalt0(GEN a, GEN sig, GEN code, GEN tab, long flag, long prec);
GEN sumnuminit0(GEN a, GEN tab, long sgn, long prec);
-GEN sumpos0(entree *ep, GEN a, GEN code, long flag,long prec);
-GEN vecteursmall(GEN nmax, entree *ep, GEN code);
-GEN zbrent0(entree *ep, GEN a, GEN b, GEN code, long prec);
+GEN sumpos0(GEN a, GEN code, long flag,long prec);
+GEN vecteursmall(GEN nmax, GEN code);
+GEN zbrent0(GEN a, GEN b, GEN code, long prec);
/* multiprecision */
GEN icopy_spec(GEN x, long nx);
@@ -414,7 +414,6 @@
void print_functions_hash(const char *s);
void print_all_user_fun(void);
void pop_val(entree *ep);
-void push_val(entree *ep, GEN a);
GEN readbin(const char *name, FILE *f, int *vector);
void recover(int flag);
int term_height(void);
Index: src/headers/paristio.h
===================================================================
RCS file: /home/cvs/pari/src/headers/paristio.h,v
retrieving revision 1.40
diff -u -r1.40 paristio.h
--- src/headers/paristio.h 1 Aug 2007 22:00:12 -0000 1.40
+++ src/headers/paristio.h 21 Aug 2007 15:05:42 -0000
@@ -37,7 +37,6 @@
char *help;
void *pvalue;
long arity;
- GEN lvars;
struct entree *next;
} entree;
Index: src/language/anal.c
===================================================================
RCS file: /home/cvs/pari/src/language/anal.c,v
retrieving revision 1.281
diff -u -r1.281 anal.c
--- src/language/anal.c 7 Aug 2007 14:55:16 -0000 1.281
+++ src/language/anal.c 21 Aug 2007 15:05:42 -0000
@@ -246,7 +246,6 @@
case 'M':
case 'P':
case 'S':
- case 'V':
case 'f':
case 'n':
case 'p':
@@ -262,12 +261,13 @@
if (*s == 'G' || *s == '&' || *s == 'n' || *s == 'I' || *s == 'E'
|| *s == 'V')
{
- arity++;
+ if (*s != 'V') arity++;
s++; break;
}
old = s; while (*s != ',') s++;
if (*s != ',') pari_err(talker2, "missing comma", old, code);
break;
+ case 'V':
case '=':
case ',': break;
case '\n': return arity; /* Before the mnemonic */
@@ -306,7 +306,6 @@
ep->help = NULL;
ep->pvalue = NULL;
ep->arity = 0;
- ep->lvars = NULL;
ep->next = *table;
return *table = ep;
}
Index: src/language/anal.h
===================================================================
RCS file: /home/cvs/pari/src/language/anal.h,v
retrieving revision 1.93
diff -u -r1.93 anal.h
--- src/language/anal.h 4 Aug 2007 13:45:23 -0000 1.93
+++ src/language/anal.h 21 Aug 2007 15:05:42 -0000
@@ -21,15 +21,11 @@
BEGINEXTERN
/* GP control structures */
-typedef struct {
- entree *ep;
- GEN code;
-} exprdat;
GEN gp_eval(GEN x, void *dat);
-#define EXPR_WRAP(ep, ch, call) \
-{ GEN z; exprdat __E; __E.code = ch; __E.ep = ep;\
- push_val(ep,NULL); z = call; pop_val(ep); return z; }
-#define EXPR_ARG &__E, &gp_eval
+#define EXPR_WRAP(code, call) \
+{ GEN z; GEN __E = code; \
+ push_lex(NULL); z = call; pop_lex(); return z; }
+#define EXPR_ARG __E, &gp_eval
/* to manipulate 'blocs' */
#define BL_HEAD 4
@@ -224,4 +220,9 @@
void stack_init(gp2c_stack *s, size_t size, void **data);
long stack_new(gp2c_stack *s);
+void push_lex(GEN a);
+void set_lex(long vn, GEN x);
+GEN get_lex(long vn);
+void pop_lex(void);
+
ENDEXTERN
Index: src/language/compat.c
===================================================================
RCS file: /home/cvs/pari/src/language/compat.c,v
retrieving revision 1.75
diff -u -r1.75 compat.c
--- src/language/compat.c 14 Aug 2007 15:27:07 -0000 1.75
+++ src/language/compat.c 21 Aug 2007 15:05:51 -0000
@@ -28,10 +28,10 @@
polylogp(long m, GEN x, long prec) { return polylog0(m,x,3,prec); }
static GEN
-prod0(GEN x, entree *ep, GEN a, GEN b, GEN ch) {return produit(ep,a,b,ch,x);}
+prod0(GEN x, GEN a, GEN b, GEN ch) {return produit(a,b,ch,x);}
static GEN
-sum0(GEN x, entree *ep, GEN a, GEN b, GEN ch) {return somme(ep,a,b,ch,x);}
+sum0(GEN x, GEN a, GEN b, GEN ch) {return somme(a,b,ch,x);}
static long
sturm0(GEN x) {return sturm(x);}
Index: src/language/compile.c
===================================================================
RCS file: /home/cvs/pari/src/language/compile.c,v
retrieving revision 1.18
diff -u -r1.18 compile.c
--- src/language/compile.c 15 Aug 2007 16:41:46 -0000 1.18
+++ src/language/compile.c 21 Aug 2007 15:05:57 -0000
@@ -26,12 +26,20 @@
** **
***************************************************************************/
+typedef enum {Lglobal, Llocal, Lmy} Ltype;
+
+struct vars_s
+{
+ Ltype type; /*Only Llocal and Lmy are allowed */
+ entree *ep;
+};
+
static THREAD gp2c_stack s_opcode, s_operand, s_data, s_lvar;
static THREAD char *opcode;
static THREAD long *operand;
static THREAD GEN *data;
static THREAD long offset=-1;
-static THREAD long *localvars;
+static THREAD struct vars_s *localvars;
void
pari_init_compiler(void)
@@ -94,6 +102,7 @@
gunclone(data[i+pos->data-1]);
}
s_data.n=pos->data;
+ s_lvar.n=pos->localvars;
offset=pos->offset;
return cl;
}
@@ -116,13 +125,14 @@
}
static void
-var_push(long x)
+var_push(entree *ep, Ltype type)
{
long n=stack_new(&s_lvar);
- localvars[n] = x;
+ localvars[n].ep = ep;
+ localvars[n].type = type;
}
-enum FLflag {FLnocopy=1};
+enum FLflag {FLnocopy=1, FLreturn=2};
static void compilenode(long n, int mode, long flag);
@@ -259,6 +269,21 @@
return ep;
}
+static long
+getmvar(entree *ep)
+{
+ long i;
+ long vn=0;
+ for(i=s_lvar.n-1;i>=0;i--)
+ {
+ if(localvars[i].type==Lmy)
+ vn--;
+ if(localvars[i].ep==ep)
+ return localvars[i].type==Lmy?vn:0;
+ }
+ return 0;
+}
+
static entree *
getfunc(long n)
{
@@ -273,6 +298,14 @@
return !strncmp(tree[x].str, s, tree[x].len);
}
+INLINE int
+is_node_zero(long n)
+{
+ while (tree[n].f==Ftag)
+ n=tree[n].x;
+ return (tree[n].f==Fsmall && tree[n].x==0);
+}
+
static GEN
listtogen(long n, long f)
{
@@ -474,8 +507,9 @@
PPproto mod;
GEN arg=listtogen(y,Flistarg);
long nbpointers=0;
- long nb=lg(arg)-1, lnc;
+ long nb=lg(arg)-1, lnc, lev=0;
entree *ep = getfunc(n);
+ entree *ev[8];
if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpGVAR)
pari_err(talker2,"not a function in function call",
tree[n].str, get_origin());
@@ -497,23 +531,55 @@
}
if (is_func_named(x,"if") && mode==Gvoid)
ep=is_entry("_void_if");
+ if (is_func_named(x,"my"))
+ {
+ if (tree[n].f==Fderfunc)
+ pari_err(talker2,"can't derive this",tree[n].str,get_origin());
+ if (nb)
+ {
+ op_push(OCnewframe,nb);
+ for(i=1;i<=nb;i++)
+ var_push(NULL,Lmy);
+ }
+ for (i=1;i<=nb;i++)
+ {
+ long a=arg[i];
+ if (tree[a].f==Faffect)
+ {
+ if (!is_node_zero(tree[a].y))
+ {
+ compilenode(tree[a].y,Ggen,0);
+ op_push(OCstorelex,-nb+i-1);
+ }
+ a=tree[a].x;
+ }
+ localvars[s_lvar.n-nb+i-1].ep=getvar(a);
+ }
+ compilecast(n,Gvoid,mode);
+ avma=ltop;
+ return;
+ }
if (is_func_named(x,"local"))
{
if (tree[n].f==Fderfunc)
pari_err(talker2,"can't derive this",tree[n].str,get_origin());
for (i=1;i<=nb;i++)
{
- long en, a=arg[i];
+ entree *en;
+ long a=arg[i];
+ op_code op=OClocalvar0;
if (tree[a].f==Faffect)
{
- compilenode(tree[a].y,Ggen,0);
+ if (!is_node_zero(tree[a].y))
+ {
+ compilenode(tree[a].y,Ggen,0);
+ op=OClocalvar;
+ }
a=tree[a].x;
}
- else
- op_push(OCpushlong,(long)gen_0);
- en=(long)getvar(a);
- op_push(OCgetarg,en);
- var_push(en);
+ en=getvar(a);
+ op_push(op,(long)en);
+ var_push(en,Llocal);
}
compilecast(n,Gvoid,mode);
avma=ltop;
@@ -592,7 +658,7 @@
while((mod=parseproto(&p,&c))!=PPend)
{
if (j<=nb && tree[arg[j]].f!=Fnoarg
- && (mod==PPdefault || mod==PPdefaultmulti))
+ && (mod==PPdefault || mod==PPdefaultmulti))
mod=PPstd;
switch(mod)
{
@@ -618,7 +684,7 @@
break;
case '&': case '*':
{
- long a=arg[j++];
+ long vn, a=arg[j++];
entree *ep;
if (c=='&')
{
@@ -628,11 +694,20 @@
a=tree[a].x;
}
ep=getlvalue(a);
+ vn=getmvar(ep);
if (tree[a].f==Fentry)
- op_push(OCsimpleptr, (long) ep);
+ {
+ if (vn)
+ op_push(OCsimpleptrlex, vn);
+ else
+ op_push(OCsimpleptrdyn, (long) ep);
+ }
else
{
- op_push(OCnewptr, (long) ep);
+ if (vn)
+ op_push(OCnewptrlex, vn);
+ else
+ op_push(OCnewptrdyn, (long) ep);
compilelvalue(a);
op_push(OCpushptr, 0);
}
@@ -645,18 +720,25 @@
struct codepos pos;
long a=arg[j++];
int type=c=='I'?Gvoid:Ggen;
+ long flag=c=='I'?0:FLreturn;
getcodepos(&pos);
+ for(i=0;i<lev;i++)
+ {
+ if (!ev[i])
+ pari_err(talker2,"missing variable name",
+ tree[a].str-1, get_origin());
+ var_push(ev[i],Lmy);
+ }
if (tree[a].f==Fnoarg)
compilecast(a,Gvoid,type);
else
- compilenode(a,type,0);
+ compilenode(a,type,flag);
op_push(OCpushgen, data_push(getclosure(&pos)));
break;
}
case 'V':
{
- entree *ep = getvar(arg[j++]);
- op_push(OCpushlong, (long)ep);
+ ev[lev++] = getvar(arg[j++]);
break;
}
case 'S':
@@ -669,12 +751,10 @@
{
long x=tree[arg[j]].x;
long y=tree[arg[j]].y;
- entree *ep;
if (tree[arg[j]].f!=Faffect)
pari_err(talker2,"expected character: '=' instead of",
tree[n].str+tree[n].len, get_origin());
- ep = getvar(x);
- op_push(OCpushlong, (long)ep);
+ ev[lev++] = getvar(x);
compilenode(y,Ggen,0);
i++; j++;
}
@@ -731,7 +811,6 @@
{
case 'G':
case '&':
- case 'V':
case 'r':
case 'E':
case 'I':
@@ -740,6 +819,9 @@
case 'n':
op_push(OCpushlong,-1);
break;
+ case 'V':
+ ev[lev++] = NULL;
+ break;
default:
pari_err(talker,"Unknown prototype code `%c' for `%*s'",c,
tree[x].len, tree[x].str);
@@ -878,7 +960,7 @@
case Fseq:
if (tree[x].f!=Fnoarg)
compilenode(x,Gvoid,0);
- compilenode(y,mode,0);
+ compilenode(y,mode,flag&FLreturn);
return;
case Ffacteurmat:
compilefacteurmat(n,mode);
@@ -889,11 +971,20 @@
if (tree[x].f==Fentry)
{
entree *ep=getvar(x);
+ long vn=getmvar(ep);
compilenode(y,Ggen,FLnocopy);
- op_push(OCstore,(long)ep);
+ if (vn)
+ op_push(OCstorelex,vn);
+ else
+ op_push(OCstoredyn,(long)ep);
if (mode!=Gvoid)
{
- op_push(OCpushvalue,(long)ep);
+ if (vn)
+ op_push(OCpushlex,vn);
+ else
+ op_push(OCpushdyn,(long)ep);
+ if (flag&FLreturn)
+ op_push(OCcopyifclone,0);
compilecast(n,Ggen,mode);
}
}
@@ -972,9 +1063,20 @@
case Fentry:
{
entree *ep=getentry(n);
- if (!EpSTATIC(do_alias(ep)))
+ long vn=getmvar(ep);
+ if (vn)
{
- op_push(OCpushvalue,(long)ep);
+ op_push(OCpushlex,(long)vn);
+ if (flag&FLreturn)
+ op_push(OCcopyifclone,0);
+ compilecast(n,Ggen,mode);
+ break;
+ }
+ else if (!EpSTATIC(do_alias(ep)))
+ {
+ op_push(OCpushdyn,(long)ep);
+ if (flag&FLreturn)
+ op_push(OCcopyifclone,0);
compilecast(n,Ggen,mode);
break;
}
@@ -991,8 +1093,6 @@
GEN arg2=listtogen(tree[x].y,Flistarg);
entree *ep=getfunc(x);
long loc=y;
- long nbvar;
- GEN lvar;
long arity=lg(arg2)-1;
if (loc>=0)
while (tree[loc].f==Fseq) loc=tree[loc].x;
@@ -1006,16 +1106,17 @@
tree[n].str,get_origin());
}
getcodepos(&pos);
+ if (arity) op_push(OCnewframe,arity);
for (i=1;i<=arity;i++)
{
long a = arg2[lg(arg2)-i];
- long en;
+ entree *en;
switch (tree[a].f)
{
case Fentry: case Ftag:
- en=(long)getvar(a);
- op_push(OCgetarg,en);
- var_push(en);
+ en=getvar(a);
+ var_push(en,Lmy);
+ op_push(OCgetarg,-arity+i-1);
break;
case Faffect:
{
@@ -1023,9 +1124,9 @@
getcodepos(&lpos);
compilenode(tree[a].y,Ggen,0);
op_push(OCpushgen, data_push(getclosure(&lpos)));
- en=(long)getvar(tree[a].x);
- op_push(OCdefaultarg,en);
- var_push(en);
+ en=getvar(tree[a].x);
+ var_push(en,Lmy);
+ op_push(OCdefaultarg,-arity+i-1);
break;
}
default:
@@ -1033,25 +1134,11 @@
tree[a].str,get_origin());
}
}
- if (y>=0 && tree[y].f!=Fnoarg) compilenode(y,Ggen,0);
- else compilecast(n,Gvoid,Ggen);
- nbvar=s_lvar.n-pos.localvars;
- s_lvar.n=pos.localvars;
- lvar=cgetg(nbvar+1,t_VECSMALL);
- for(i=1;i<=nbvar;i++)
- lvar[i]=localvars[pos.localvars+i-1];
- if (nbvar > 1)
- { /* check for duplicates */
- GEN x = vecsmall_copy(lvar);
- long k;
- vecsmall_sort(x);
- for (k=x[1],i=2; i<lg(x); k=x[i],i++)
- if (x[i] == k)
- pari_err(talker,"user function %s: variable %s declared twice",
- ep->name, ((entree*)x[i])->name);
- }
+ if (y>=0 && tree[y].f!=Fnoarg)
+ compilenode(y,Ggen,FLreturn);
+ else
+ compilecast(n,Gvoid,Ggen);
op_push(OCpushgen, data_push(getclosure(&pos)));
- op_push(OCpushgen, data_push(lvar));
op_push(OCpushgen, data_push(
strntoGENstr(tree[n].str,tree[n].len)));
op_push(OCpushlong, arity);
Index: src/language/eval.c
===================================================================
RCS file: /home/cvs/pari/src/language/eval.c,v
retrieving revision 1.25
diff -u -r1.25 eval.c
--- src/language/eval.c 18 Aug 2007 21:12:59 -0000 1.25
+++ src/language/eval.c 21 Aug 2007 15:05:57 -0000
@@ -158,7 +158,6 @@
switch(EpVALENCE(ep))
{
case EpUSER:
- gunclone(ep->lvars); ep->lvars=NULL;
while (ep->pvalue!=INITIAL) pop_val(ep);
gunclone((GEN)ep->value); ep->value=NULL;
break;
@@ -171,12 +170,6 @@
}
}
-void
-push_val(entree *ep, GEN a)
-{
- new_val_cell(ep, a, PUSH_VAL);
-}
-
/* kill ep->value and replace by preceding one, poped from value stack */
void
pop_val(entree *ep)
@@ -196,6 +189,20 @@
new_val_cell(ep, x, typ(x) >= t_VEC ? COPY_VAL: PUSH_VAL);
}
+INLINE void
+zerovalue (entree *ep)
+{
+ var_cell *v = (var_cell*) gpmalloc(sizeof(var_cell));
+ v->value = (GEN)ep->value;
+ v->prev = (var_cell*) ep->pvalue;
+ v->flag = PUSH_VAL;
+ v->valence= ep->valence;
+ ep->value = gen_0;
+ ep->pvalue= (char*)v;
+ ep->valence=EpVAR;
+}
+
+
/* as above IF ep->value was PUSHed, or was created after block number 'loc'
return 0 if not deleted, 1 otherwise [for recover()] */
int
@@ -305,6 +312,7 @@
matcomp c;
GEN x;
entree *ep;
+ long vn;
} gp_pointer;
@@ -349,10 +357,82 @@
** **
***************************************************************************/
-static THREAD long *st;
+struct var_lex
+{
+ long flag;
+ GEN value;
+};
+
static THREAD long sp, rp;
+static THREAD long *st;
static THREAD gp_pointer *ptrs;
-static THREAD gp2c_stack s_st,s_ptrs;
+static THREAD entree **lvars;
+static THREAD struct var_lex *var;
+static THREAD gp2c_stack s_st, s_ptrs, s_var, s_lvars;
+
+static void
+changelex(long vn, GEN x)
+{
+ struct var_lex *v=var+s_var.n+vn;
+ x = gclone(x); /* beware: killbloc may destroy old x */
+ if (v->flag == COPY_VAL) killbloc(v->value); else v->flag = COPY_VAL;
+ v->value = x;
+}
+
+INLINE void
+zerolex(long vn)
+{
+ struct var_lex *v=var+s_var.n+vn;
+ v->flag = PUSH_VAL;
+ v->value = gen_0;
+}
+
+INLINE void
+copylex(long vn, GEN x)
+{
+ struct var_lex *v=var+s_var.n+vn;
+ v->flag = typ(x) >= t_VEC ? COPY_VAL: PUSH_VAL;
+ v->value = (v->flag == COPY_VAL)? gclone(x):
+ (isclone(x))? gcopy(x): x;
+}
+
+INLINE void
+freelex(long vn)
+{
+ struct var_lex *v=var+s_var.n+vn;
+ if (v->flag == COPY_VAL) killbloc(v->value);
+}
+
+void
+push_lex(GEN a)
+{
+ long vn=stack_new(&s_var);
+ struct var_lex *v=var+vn;
+ v->flag = PUSH_VAL;
+ v->value = a;
+}
+
+GEN
+get_lex(long vn)
+{
+ struct var_lex *v=var+s_var.n+vn;
+ return v->value;
+}
+
+void
+set_lex(long vn, GEN x)
+{
+ struct var_lex *v=var+s_var.n+vn;
+ if (v->flag == COPY_VAL) { killbloc(v->value); v->flag = PUSH_VAL; }
+ v->value = x;
+}
+
+void
+pop_lex(void)
+{
+ freelex(-1);
+ s_var.n--;
+}
void
pari_init_evaluator(void)
@@ -365,6 +445,8 @@
stack_init(&s_ptrs,sizeof(*ptrs),(void**)&ptrs);
stack_alloc(&s_ptrs,16);
s_ptrs.n=s_ptrs.alloc;
+ stack_init(&s_var,sizeof(*var),(void**)&var);
+ stack_init(&s_lvars,sizeof(*lvars),(void**)&lvars);
}
static void closure_eval(GEN C);
@@ -400,12 +482,7 @@
reset_break();
}
else
- {
z = gerepileupto(ltop, gel(st,--sp));
- if (isclone(z)) z = gcopy(z);
- }
- for(j=1;j<lg(ep->lvars);j++)
- pop_val((entree*)ep->lvars[j]);
return z;
}
@@ -465,7 +542,7 @@
GEN data=gel(C,3);
long saved_sp=sp;
long saved_rp=rp;
- long pc, j;
+ long pc, j, nbmvar=0, nblvar=0;
for(pc=1;pc<lg(oper);pc++)
{
op_code opcode=(op_code) code[pc];
@@ -497,7 +574,7 @@
pari_var_create(ep);
gel(st,sp++)=(GEN)initial_value(ep);
break;
- case OCpushvalue:
+ case OCpushdyn:
ep=(entree*)operand;
switch(ep->valence)
{
@@ -511,12 +588,16 @@
goto calluser; /*Maybe it is a function*/
}
break;
- case OCsimpleptr:
+ case OCpushlex:
+ gel(st,sp++)=var[s_var.n+operand].value;
+ break;
+ case OCsimpleptrdyn:
{
gp_pointer *g;
if (rp==s_ptrs.n-1)
stack_new(&s_ptrs);
g = &ptrs[rp++];
+ g->vn=0;
g->ep = (entree*) operand;
switch (g->ep->valence)
{
@@ -531,14 +612,25 @@
gel(st,sp++) = (GEN)&(g->x);
break;
}
- case OCnewptr:
+ case OCsimpleptrlex:
+ {
+ gp_pointer *g;
+ if (rp==s_ptrs.n-1)
+ stack_new(&s_ptrs);
+ g = &ptrs[rp++];
+ g->vn=operand;
+ g->ep=(entree *)0x1L;
+ g->x = (GEN) var[s_var.n+operand].value;
+ gel(st,sp++) = (GEN)&(g->x);
+ break;
+ }
+ case OCnewptrdyn:
{
gp_pointer *g;
matcomp *C;
if (rp==s_ptrs.n-1)
stack_new(&s_ptrs);
g = &ptrs[rp++];
- C=&g->c;
ep = (entree*) operand;
switch (ep->valence)
{
@@ -552,7 +644,25 @@
pari_err(varer1,"variable name expected",NULL,NULL);
}
g->x = (GEN) ep->value;
+ g->vn=0;
+ g->ep=NULL;
+ C=&g->c;
+ C->full_col = C->full_row = 0;
+ C->parent = (GEN) g->x;
+ C->ptcell = (GEN *) &g->x;
+ break;
+ }
+ case OCnewptrlex:
+ {
+ gp_pointer *g;
+ matcomp *C;
+ if (rp==s_ptrs.n-1)
+ stack_new(&s_ptrs);
+ g = &ptrs[rp++];
+ g->x = (GEN) var[s_var.n+operand].value;
+ g->vn=0;
g->ep=NULL;
+ C=&g->c;
C->full_col = C->full_row = 0;
C->parent = (GEN) g->x;
C->ptcell = (GEN *) &g->x;
@@ -568,11 +678,17 @@
for(j=0;j<operand;j++)
{
gp_pointer *g = &ptrs[--rp];
- if (g->ep) changevalue(g->ep, g->x);
+ if (g->ep)
+ {
+ if (g->vn)
+ changelex(g->vn,g->x);
+ else
+ changevalue(g->ep, g->x);
+ }
else change_compo(&(g->c), g->x);
}
break;
- case OCstore:
+ case OCstoredyn:
ep=(entree *)operand;
switch (ep->valence)
{
@@ -585,6 +701,9 @@
pari_err(varer1,"variable name expected",NULL,NULL);
}
break;
+ case OCstorelex:
+ changelex(operand,gel(st,--sp));
+ break;
case OCstackgen:
gmael(st,sp-2,operand)=copyupto(gel(st,sp-1),gel(st,sp-2));
sp--;
@@ -619,6 +738,10 @@
case OCcopy:
gel(st,sp-1) = gcopy(gel(st,sp-1));
break;
+ case OCcopyifclone:
+ if (isclone(gel(st,sp-1)))
+ gel(st,sp-1) = gcopy(gel(st,sp-1));
+ break;
case OCcompo1:
{
GEN p=gel(st,sp-2);
@@ -768,25 +891,38 @@
break;
}
case OCgetarg:
- ep=(entree *)operand;
if (gel(st,sp-1))
- copyvalue(ep,gel(st,sp-1));
+ copylex(operand,gel(st,sp-1));
else
- copyvalue(ep,gen_0);
+ zerolex(operand);
sp--;
break;
case OCdefaultarg:
ep=(entree *)operand;
if (gel(st,sp-2))
- copyvalue(ep,gel(st,sp-2));
+ copylex(operand,gel(st,sp-2));
else
{
GEN z = closure_evalgen(gel(st,sp-1));
if (!z) pari_err(talker,"break not allowed in function parameter");
- copyvalue(ep,z);
+ copylex(operand,z);
}
sp-=2;
break;
+ case OClocalvar:
+ ep=(entree *)operand;
+ j=stack_new(&s_lvars);
+ lvars[j]=ep;
+ nblvar++;
+ copyvalue(ep,gel(st,--sp));
+ break;
+ case OClocalvar0:
+ ep=(entree *)operand;
+ j=stack_new(&s_lvars);
+ lvars[j]=ep;
+ nblvar++;
+ zerovalue(ep);
+ break;
case OCglobalvar:
ep=(entree *)operand;
if (ep->valence==EpNEW) pari_var_create(ep);
@@ -891,7 +1027,7 @@
pari_sp ltop;
long n=st[--sp];
entree *ep = (entree*) operand;
- GEN z, lvars=ep->lvars;
+ GEN z;
if (ep->valence!=EpUSER)
{
int w;
@@ -920,15 +1056,20 @@
reset_break();
}
else
- {
z = gerepileupto(ltop, gel(st,--sp));
- if (isclone(z)) z = gcopy(z);
- }
- for(j=1;j<lg(lvars);j++)
- pop_val((entree*)lvars[j]);
gel(st, sp++) = z;
break;
}
+ case OCnewframe:
+ stack_alloc(&s_var,operand);
+ s_var.n+=operand;
+ nbmvar+=operand;
+ for(j=1;j<=operand;j++)
+ {
+ var[s_var.n-j].flag=PUSH_VAL;
+ var[s_var.n-j].value=gen_0;
+ }
+ break;
case OCvec:
gel(st,sp++)=cgetg(operand,t_VEC);
break;
@@ -953,7 +1094,6 @@
gpfree(ep->code);
/*FIXME: the function might be in use...
gunclone(ep->value);
- gunclone(ep->lvars);
*/
break;
case EpNEW:
@@ -962,21 +1102,28 @@
default:
pari_err(talker,"function name expected");
}
- ep->value = (void *) gclone(gel(st,sp-4));
- ep->lvars = gclone(gel(st,sp-3));
+ ep->value = (void *) gclone(gel(st,sp-3));
ep->code = pari_strdup(GSTR(gel(st,sp-2)));
ep->arity = st[sp-1];
- sp-=4;
+ sp-=3;
break;
case OCpop:
sp-=operand;
break;
}
}
- return;
-endeval:
- sp = saved_sp;
- rp = saved_rp;
+ if (0)
+ {
+ endeval:
+ sp = saved_sp;
+ rp = saved_rp;
+ }
+ for(j=1;j<=nbmvar;j++)
+ freelex(-j);
+ s_var.n-=nbmvar;
+ for(j=1;j<=nblvar;j++)
+ pop_val(lvars[s_lvars.n-j]);
+ s_lvars.n-=nblvar;
}
GEN
@@ -1066,17 +1213,34 @@
ep=(entree*)operand;
pariprintf("pushvar\t%s\n",ep->name);
break;
- case OCpushvalue:
+ case OCpushdyn:
+ ep=(entree*)operand;
+ pariprintf("pushdyn\t\t%s\n",ep->name);
+ break;
+ case OCpushlex:
+ pariprintf("pushlex\t\t%ld\n",operand);
+ break;
+ case OCstoredyn:
+ ep=(entree *)operand;
+ pariprintf("storedyn\t%s\n",ep->name);
+ break;
+ case OCstorelex:
+ pariprintf("storelex\t%ld\n",operand);
+ break;
+ case OCsimpleptrdyn:
ep=(entree*)operand;
- pariprintf("pushvalue\t%s\n",ep->name);
+ pariprintf("simpleptrdyn\t%s\n",ep->name);
break;
- case OCsimpleptr:
+ case OCsimpleptrlex:
ep=(entree*)operand;
- pariprintf("simpleptr\t%s\n",ep->name);
+ pariprintf("simpleptrlex\t%ld\n",operand);
break;
- case OCnewptr:
+ case OCnewptrdyn:
ep=(entree*)operand;
- pariprintf("newptr\t\t%s\n",ep->name);
+ pariprintf("newptrdyn\t%s\n",ep->name);
+ break;
+ case OCnewptrlex:
+ pariprintf("newptrlex\t%ld\n",operand);
break;
case OCpushptr:
pariprintf("pushptr\n");
@@ -1087,10 +1251,6 @@
case OCendptr:
pariprintf("endptr\t\t%ld\n",operand);
break;
- case OCstore:
- ep=(entree *)operand;
- pariprintf("store\t\t%s\n",ep->name);
- break;
case OCprecreal:
pariprintf("precreal\n");
break;
@@ -1112,6 +1272,9 @@
case OCcopy:
pariprintf("copy\n");
break;
+ case OCcopyifclone:
+ pariprintf("copyifclone\n");
+ break;
case OCcompo1:
pariprintf("compo1\t\t%s\n",disassemble_cast(operand));
break;
@@ -1137,12 +1300,18 @@
pariprintf("compoLptr\n");
break;
case OCgetarg:
- ep=(entree*)operand;
- pariprintf("getarg\t\t%s\n",ep->name);
+ pariprintf("getarg\t\t%ld\n",operand);
break;
case OCdefaultarg:
+ pariprintf("defaultarg\t%ld\n",operand);
+ break;
+ case OClocalvar:
ep=(entree*)operand;
- pariprintf("defaultarg\t%s\n",ep->name);
+ pariprintf("localvar\t%s\n",ep->name);
+ break;
+ case OClocalvar0:
+ ep=(entree*)operand;
+ pariprintf("localvar0\t%s\n",ep->name);
break;
case OCglobalvar:
ep=(entree*)operand;
@@ -1193,6 +1362,9 @@
ep=(entree*)operand;
pariprintf("deffunc\t\t%s\n",ep->name);
break;
+ case OCnewframe:
+ pariprintf("newframe\t%ld\n",operand);
+ break;
case OCpop:
pariprintf("pop\t\t%ld\n",operand);
break;
Index: src/language/init.c
===================================================================
RCS file: /home/cvs/pari/src/language/init.c,v
retrieving revision 1.355
diff -u -r1.355 init.c
--- src/language/init.c 10 Aug 2007 08:51:36 -0000 1.355
+++ src/language/init.c 21 Aug 2007 15:06:04 -0000
@@ -2028,8 +2028,8 @@
* E closure whose value is used, like in sum() loop
* G GEN
* L long
- * S symbol (i.e GP function name)
- * V variable (same as S, but valence must equal EpVAR/EpGVAR)
+ * S symbol (i.e GP function name) as a entree *
+ * V lexical variable
* n variable number
* & *GEN
* f Fake *long (function requires it, but we don't use the resulting long)
Index: src/language/intnum.c
===================================================================
RCS file: /home/cvs/pari/src/language/intnum.c,v
retrieving revision 1.35
diff -u -r1.35 intnum.c
--- src/language/intnum.c 6 Jun 2007 09:36:57 -0000 1.35
+++ src/language/intnum.c 21 Aug 2007 15:06:11 -0000
@@ -30,9 +30,9 @@
GEN
gp_eval(GEN x, void *dat)
{
- exprdat *E = (exprdat*)dat;
- E->ep->value = x;
- return closure_evalnobrk(E->code);
+ GEN code = (GEN)dat;
+ set_lex(-1,x);
+ return closure_evalnobrk(code);
}
#if 0
@@ -1605,38 +1605,38 @@
}
GEN
-intnumromb0(entree *ep, GEN a, GEN b, GEN code, long flag, long prec)
-{ EXPR_WRAP(ep,code, intnumromb(EXPR_ARG, a, b, flag, prec)); }
+intnumromb0(GEN a, GEN b, GEN code, long flag, long prec)
+{ EXPR_WRAP(code, intnumromb(EXPR_ARG, a, b, flag, prec)); }
GEN
-intnum0(entree *ep, GEN a, GEN b, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(ep,code, intnum(EXPR_ARG, a, b, tab, prec)); }
+intnum0(GEN a, GEN b, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, intnum(EXPR_ARG, a, b, tab, prec)); }
GEN
-intcirc0(entree *ep, GEN a, GEN R, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(ep,code, intcirc(EXPR_ARG, a, R, tab, prec)); }
+intcirc0(GEN a, GEN R, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, intcirc(EXPR_ARG, a, R, tab, prec)); }
GEN
-intmellininv0(entree *ep, GEN sig, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(ep,code, intmellininv(EXPR_ARG, sig, x, tab, prec)); }
+intmellininv0(GEN sig, GEN x, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, intmellininv(EXPR_ARG, sig, x, tab, prec)); }
GEN
-intlaplaceinv0(entree *ep, GEN sig, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(ep,code, intlaplaceinv(EXPR_ARG, sig, x, tab, prec)); }
+intlaplaceinv0(GEN sig, GEN x, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, intlaplaceinv(EXPR_ARG, sig, x, tab, prec)); }
GEN
-intfourcos0(entree *ep, GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(ep,code, intfouriercos(EXPR_ARG, a, b, x, tab, prec)); }
+intfourcos0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, intfouriercos(EXPR_ARG, a, b, x, tab, prec)); }
GEN
-intfoursin0(entree *ep, GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(ep,code, intfouriersin(EXPR_ARG, a, b, x, tab, prec)); }
+intfoursin0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, intfouriersin(EXPR_ARG, a, b, x, tab, prec)); }
GEN
-intfourexp0(entree *ep, GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(ep,code, intfourierexp(EXPR_ARG, a, b, x, tab, prec)); }
+intfourexp0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, intfourierexp(EXPR_ARG, a, b, x, tab, prec)); }
GEN
-intnuminitgen0(entree *ep, GEN a, GEN b, GEN code, long m, long flag, long prec)
-{ EXPR_WRAP(ep,code, intnuminitgen(EXPR_ARG, a, b, m, flag, prec)); }
+intnuminitgen0(GEN a, GEN b, GEN code, long m, long flag, long prec)
+{ EXPR_WRAP(code, intnuminitgen(EXPR_ARG, a, b, m, flag, prec)); }
/* m and flag reversed on purpose */
GEN
-intfuncinit0(entree *ep, GEN a, GEN b, GEN code, long flag, long m, long prec)
-{ EXPR_WRAP(ep,code, intfuncinit(EXPR_ARG, a, b, m, flag? 1: 0, prec)); }
+intfuncinit0(GEN a, GEN b, GEN code, long flag, long m, long prec)
+{ EXPR_WRAP(code, intfuncinit(EXPR_ARG, a, b, m, flag? 1: 0, prec)); }
#if 0
/* Two variable integration */
@@ -1701,20 +1701,13 @@
}
GEN
-intnumdoub0(entree *epx, GEN a, GEN b, entree *epy, int nc, int nd, int nf, GEN tabext, GEN tabint, long prec)
+intnumdoub0(GEN a, GEN b, int nc, int nd, int nf, GEN tabext, GEN tabint, long prec)
{
- exprdat Ec, Ed;
- exprdoub Ef;
GEN z;
-
- Ec.ep = epx; Ec.ch = chc;
- Ed.ep = epx; Ed.ch = chd;
- Ef.epx = epx; push_val(epx, NULL);
- Ef.epy = epy; push_val(epy, NULL);
- Ef.ch = chf;
- z = intnumdoub(&Ef, &gp_eval2, &Ec, &gp_eval, &Ed, &gp_eval, a, b, tabext, tabint, prec);
- pop_val(epy);
- pop_val(epx); return z;
+ push_lex(NULL);
+ push_lex(NULL);
+ z = intnumdoub(chf, &gp_eval2, chc, &gp_eval, chd, &gp_eval, a, b, tabext, tabint, prec);
+ pop_lex(); pop_lex(); return z;
}
#endif
@@ -1816,8 +1809,8 @@
{ return sumnumall(E,f,a,s,tab,flag,-1,prec); }
GEN
-sumnum0(entree *ep, GEN a, GEN sig, GEN code, GEN tab, long flag, long prec)
-{ EXPR_WRAP(ep,code, sumnum(EXPR_ARG, a, sig, tab, flag, prec)); }
+sumnum0(GEN a, GEN sig, GEN code, GEN tab, long flag, long prec)
+{ EXPR_WRAP(code, sumnum(EXPR_ARG, a, sig, tab, flag, prec)); }
GEN
-sumnumalt0(entree *ep, GEN a, GEN sig, GEN code, GEN tab, long flag, long prec)
-{ EXPR_WRAP(ep,code, sumnumalt(EXPR_ARG, a, sig, tab, flag, prec)); }
+sumnumalt0(GEN a, GEN sig, GEN code, GEN tab, long flag, long prec)
+{ EXPR_WRAP(code, sumnumalt(EXPR_ARG, a, sig, tab, flag, prec)); }
Index: src/language/opcode.h
===================================================================
RCS file: /home/cvs/pari/src/language/opcode.h,v
retrieving revision 1.5
diff -u -r1.5 opcode.h
--- src/language/opcode.h 15 Aug 2007 16:41:46 -0000 1.5
+++ src/language/opcode.h 21 Aug 2007 15:06:11 -0000
@@ -16,19 +16,20 @@
typedef enum {Gvoid, Gsmall, Gvec, Gvar, Ggen} Gtype;
-typedef enum {OCpushlong='A',OCpushgen,OCpushreal,OCpushstoi,
- OCpushvalue,OCpushvar,
+typedef enum {OCpushlong='A',OCpushgen,OCpushreal,OCpushstoi,OCpushvar,
OCpop,
- OCstoi,OCitos,OCtostr,OCvarn,OCcopy,
+ OCstoi,OCitos,OCtostr,OCvarn,OCcopy,OCcopyifclone,
OCprecreal,OCprecdl,
OCvec,OCmat,OCcol,
- OCstackgen,OCstore,
+ OCstackgen,
OCcompo1,OCcompo2,OCcompoC,OCcompoL,
- OCnewptr,OCpushptr,OCendptr,OCsimpleptr,
+ OCpushptr,OCendptr,
OCcompo1ptr,OCcompo2ptr,OCcompoCptr,OCcompoLptr,
OCcalllong,OCcallgen,OCcallgen2,OCcallint,OCcallvoid,OCcalluser,
OCderivgen,OCderivuser,
- OCdeffunc,OCgetarg,OCdefaultarg,
- OCglobalvar} op_code;
+ OCdeffunc,OCnewframe,
+ OCpushdyn,OCstoredyn,OCnewptrdyn,OCsimpleptrdyn,
+ OCpushlex,OCstorelex,OCnewptrlex,OCsimpleptrlex,
+ OCgetarg,OCdefaultarg,OClocalvar,OClocalvar0,OCglobalvar} op_code;
ENDEXTERN
Index: src/language/sumiter.c
===================================================================
RCS file: /home/cvs/pari/src/language/sumiter.c,v
retrieving revision 1.122
diff -u -r1.122 sumiter.c
--- src/language/sumiter.c 13 Aug 2007 11:30:46 -0000 1.122
+++ src/language/sumiter.c 21 Aug 2007 15:06:11 -0000
@@ -23,27 +23,24 @@
/********************************************************************/
void
-forpari(entree *ep, GEN a, GEN b, GEN code)
+forpari(GEN a, GEN b, GEN code)
{
- pari_sp av, av0 = avma, lim;
+ pari_sp av=avma, lim;
- b = gcopy(b); av=avma; lim = stack_lim(av,1);
- /* gcopy nedeed in case b gets overwritten in ch, as in
- * b=10; for(a=1,b, print(a);b=1)
- */
- push_val(ep, a);
+ lim = stack_lim(av,1);
+ push_lex(a);
while (gcmp(a,b) <= 0)
{
closure_evalvoid(code); if (loop_break()) break;
- a = (GEN) ep->value; a = typ(a) == t_INT? addis(a, 1): gadd(a,gen_1);
+ a = get_lex(-1); a = typ(a) == t_INT? addis(a, 1): gaddgs(a,1);
if (low_stack(lim, stack_lim(av,1)))
{
if (DEBUGMEM>1) pari_warn(warnmem,"forpari");
a = gerepileupto(av,a);
}
- changevalue_p(ep,a);
+ set_lex(-1, a);
}
- pop_val(ep); avma = av0;
+ pop_lex(); avma = av;
}
void
@@ -78,7 +75,7 @@
static int negcmp(GEN x, GEN y) { return gcmp(y,x); }
void
-forstep(entree *ep, GEN a, GEN b, GEN s, GEN code)
+forstep(GEN a, GEN b, GEN s, GEN code)
{
long ss, i;
pari_sp av, av0 = avma, lim;
@@ -86,7 +83,7 @@
int (*cmp)(GEN,GEN);
b = gcopy(b); av=avma; lim = stack_lim(av,1);
- push_val(ep, a);
+ push_lex(a);
if (is_vec_t(typ(s)))
{
v = s; s = gen_0;
@@ -104,16 +101,16 @@
if (++i >= lg(v)) i = 1;
s = gel(v,i);
}
- a = (GEN) ep->value; a = gadd(a,s);
+ a = get_lex(-1); a = gadd(a,s);
if (low_stack(lim, stack_lim(av,1)))
{
if (DEBUGMEM>1) pari_warn(warnmem,"forstep");
a = gerepileupto(av,a);
}
- changevalue_p(ep,a);
+ set_lex(-1,a);
}
- pop_val(ep); avma = av0;
+ pop_lex(); avma = av0;
}
/* assume ptr is the address of a diffptr containing the succesive
@@ -132,9 +129,9 @@
/* value changed during the loop, replace by the first prime whose
value is strictly larger than new value */
static void
-update_p(entree *ep, byteptr *ptr, ulong prime[])
+update_p(byteptr *ptr, ulong prime[])
{
- GEN z = (GEN)ep->value;
+ GEN z = get_lex(-1);
ulong a, c;
if (typ(z) == t_INT) a = 1; else { z = gceil(z); a = 0; }
@@ -147,7 +144,7 @@
*ptr = diffptr;
prime[2] = sinitp(a, 0, ptr);
}
- changevalue_p(ep, (GEN)prime);
+ set_lex(-1,(GEN)prime);
}
static byteptr
@@ -172,7 +169,7 @@
}
void
-forprime(entree *ep, GEN ga, GEN gb, GEN code)
+forprime(GEN ga, GEN gb, GEN code)
{
long p[] = {evaltyp(t_INT)|_evallg(3), evalsigne(1)|evallgefint(3), 0};
ulong *prime = (ulong*)p;
@@ -183,37 +180,37 @@
d = prime_loop_init(ga,gb, &a,&b, (ulong*)&prime[2]);
if (!d) { avma = av; return; }
- avma = av; push_val(ep, (GEN)prime);
+ avma = av; push_lex((GEN)prime);
while (prime[2] < b)
{
closure_evalvoid(code); if (loop_break()) break;
- if (ep->value == prime)
+ if (get_lex(-1) == (GEN) prime)
NEXT_PRIME_VIADIFF(prime[2], d);
else
- update_p(ep, &d, prime);
+ update_p(&d, prime);
avma = av;
}
/* if b = P --> *d = 0 now and the loop wouldn't end if it read 'while
* (prime[2] <= b)' */
if (prime[2] == b) { closure_evalvoid(code); (void)loop_break(); avma = av; }
- pop_val(ep);
+ pop_lex();
}
void
-fordiv(GEN a, entree *ep, GEN code)
+fordiv(GEN a, GEN code)
{
long i, l;
pari_sp av2, av = avma;
GEN t = divisors(a);
- push_val(ep, NULL); l=lg(t); av2 = avma;
+ push_lex(NULL); l=lg(t); av2 = avma;
for (i=1; i<l; i++)
{
- ep->value = (void*) t[i];
+ set_lex(-1,gel(t,i));
closure_evalvoid(code); if (loop_break()) break;
avma = av2;
}
- pop_val(ep); avma=av;
+ pop_lex(); avma=av;
}
/* Embedded for loops:
@@ -473,18 +470,18 @@
}
void
-forvec(entree *ep, GEN x, GEN code, long flag)
+forvec(GEN x, GEN code, long flag)
{
pari_sp av = avma;
GEN D;
GEN (*next)(GEN,GEN);
GEN v = forvec_start(x, flag, &D, &next);
- push_val(ep, v);
+ push_lex(v);
while (v) {
closure_evalvoid(code); if (loop_break()) break;
v = next(D, v);
}
- pop_val(ep); avma = av;
+ pop_lex(); avma = av;
}
/********************************************************************/
@@ -494,7 +491,7 @@
/********************************************************************/
GEN
-somme(entree *ep, GEN a, GEN b, GEN code, GEN x)
+somme(GEN a, GEN b, GEN code, GEN x)
{
pari_sp av, av0 = avma, lim;
GEN p1;
@@ -506,7 +503,7 @@
b = gfloor(b);
a = setloop(a);
av=avma; lim = stack_lim(av,1);
- push_val(ep, a);
+ push_lex(a);
for(;;)
{
p1 = closure_evalnobrk(code);
@@ -517,9 +514,9 @@
if (DEBUGMEM>1) pari_warn(warnmem,"sum");
x = gerepileupto(av,x);
}
- ep->value = (void*) a;
+ set_lex(-1,a);
}
- pop_val(ep); return gerepileupto(av0,x);
+ pop_lex(); return gerepileupto(av0,x);
}
GEN
@@ -549,23 +546,23 @@
return gerepileupto(av0, gaddgs(x,-1));
}
GEN
-suminf0(entree *ep, GEN a, GEN code, long prec)
-{ EXPR_WRAP(ep,code, suminf(EXPR_ARG, a, prec)); }
+suminf0(GEN a, GEN code, long prec)
+{ EXPR_WRAP(code, suminf(EXPR_ARG, a, prec)); }
GEN
-divsum(GEN num, entree *ep, GEN code)
+divsum(GEN num, GEN code)
{
pari_sp av = avma;
GEN y = gen_0, t = divisors(num);
long i, l = lg(t);
- push_val(ep, NULL);
+ push_lex(NULL);
for (i=1; i<l; i++)
{
- ep->value = (void*)t[i];
+ set_lex(-1,gel(t,i));
y = gadd(y, closure_evalnobrk(code));
}
- pop_val(ep); return gerepileupto(av,y);
+ pop_lex(); return gerepileupto(av,y);
}
/********************************************************************/
@@ -575,7 +572,7 @@
/********************************************************************/
GEN
-produit(entree *ep, GEN a, GEN b, GEN code, GEN x)
+produit(GEN a, GEN b, GEN code, GEN x)
{
pari_sp av, av0 = avma, lim;
GEN p1;
@@ -587,7 +584,7 @@
b = gfloor(b);
a = setloop(a);
av=avma; lim = stack_lim(av,1);
- push_val(ep, a);
+ push_lex(a);
for(;;)
{
p1 = closure_evalnobrk(code);
@@ -598,9 +595,9 @@
if (DEBUGMEM>1) pari_warn(warnmem,"prod");
x = gerepileupto(av,x);
}
- ep->value = (void*) a;
+ set_lex(-1,a);
}
- pop_val(ep); return gerepileupto(av0,x);
+ pop_lex(); return gerepileupto(av0,x);
}
GEN
@@ -654,12 +651,12 @@
return gerepilecopy(av0,x);
}
GEN
-prodinf0(entree *ep, GEN a, GEN code, long flag, long prec)
+prodinf0(GEN a, GEN code, long flag, long prec)
{
switch(flag)
{
- case 0: EXPR_WRAP(ep,code, prodinf (EXPR_ARG, a, prec));
- case 1: EXPR_WRAP(ep,code, prodinf1(EXPR_ARG, a, prec));
+ case 0: EXPR_WRAP(code, prodinf (EXPR_ARG, a, prec));
+ case 1: EXPR_WRAP(code, prodinf1(EXPR_ARG, a, prec));
}
pari_err(flagerr);
return NULL; /* not reached */
@@ -694,8 +691,8 @@
return gerepilecopy(av0,x);
}
GEN
-prodeuler0(entree *ep, GEN a, GEN b, GEN code, long prec)
-{ EXPR_WRAP(ep,code, prodeuler(EXPR_ARG, a, b, prec)); }
+prodeuler0(GEN a, GEN b, GEN code, long prec)
+{ EXPR_WRAP(code, prodeuler(EXPR_ARG, a, b, prec)); }
GEN
direuler(void *E, GEN (*eval)(GEN,void*), GEN ga, GEN gb, GEN c)
@@ -786,8 +783,8 @@
return gerepilecopy(av0,x);
}
GEN
-direuler0(entree *ep, GEN a, GEN b, GEN code, GEN c)
-{ EXPR_WRAP(ep,code, direuler(EXPR_ARG, a, b, c)); }
+direuler0(GEN a, GEN b, GEN code, GEN c)
+{ EXPR_WRAP(code, direuler(EXPR_ARG, a, b, c)); }
/********************************************************************/
/** **/
@@ -796,7 +793,7 @@
/********************************************************************/
GEN
-vecteur(GEN nmax, entree *ep, GEN code)
+vecteur(GEN nmax, GEN code)
{
GEN y,p1;
long i,m;
@@ -804,19 +801,19 @@
m = gtos(nmax);
if (m < 0) pari_err(talker,"negative number of components in vector");
- if (!ep || !code) return zerovec(m);
- y = cgetg(m+1,t_VEC); push_val(ep, c);
+ if (!code) return zerovec(m);
+ y = cgetg(m+1,t_VEC); push_lex(c);
for (i=1; i<=m; i++)
{
c[2] = i; p1 = closure_evalnobrk(code);
gel(y,i) = isonstack(p1)? p1 : gcopy(p1);
- changevalue_p(ep,c);
+ set_lex(-1,c);
}
- pop_val(ep); return y;
+ pop_lex(); return y;
}
GEN
-vecteursmall(GEN nmax, entree *ep, GEN code)
+vecteursmall(GEN nmax, GEN code)
{
GEN y;
long i,m;
@@ -824,41 +821,40 @@
m = gtos(nmax);
if (m < 0) pari_err(talker,"negative number of components in vector");
- if (!ep || !code) return const_vecsmall(m, 0);
- y = cgetg(m+1,t_VECSMALL); push_val(ep, c);
+ if (!code) return const_vecsmall(m, 0);
+ y = cgetg(m+1,t_VECSMALL); push_lex(c);
for (i=1; i<=m; i++)
{
c[2] = i;
y[i] = gtos(closure_evalnobrk(code));
- changevalue_p(ep,c);
+ set_lex(-1,c);
}
- pop_val(ep); return y;
+ pop_lex(); return y;
}
GEN
-vvecteur(GEN nmax, entree *ep, GEN n)
+vvecteur(GEN nmax, GEN n)
{
- GEN y = vecteur(nmax,ep,n);
+ GEN y = vecteur(nmax,n);
settyp(y,t_COL); return y;
}
GEN
-matrice(GEN nlig, GEN ncol,entree *ep1, entree *ep2, GEN code)
+matrice(GEN nlig, GEN ncol, GEN code)
{
GEN y, z, p1;
long i, j, m, n;
long c1[]={evaltyp(t_INT)|_evallg(3), evalsigne(1)|evallgefint(3), 1};
long c2[]={evaltyp(t_INT)|_evallg(3), evalsigne(1)|evallgefint(3), 1};
- if (ep1 == ep2 && ep1) pari_err(talker, "identical index variables in matrix");
m = gtos(ncol);
n = gtos(nlig);
if (m < 0) pari_err(talker,"negative number of columns in matrix");
if (n < 0) pari_err(talker,"negative number of rows in matrix");
if (!m) return cgetg(1,t_MAT);
- if (!ep1 || !ep2 || !code || !n) return zeromatcopy(n, m);
- push_val(ep1, c1);
- push_val(ep2, c2); y = cgetg(m+1,t_MAT);
+ if (!code || !n) return zeromatcopy(n, m);
+ push_lex(c1);
+ push_lex(c2); y = cgetg(m+1,t_MAT);
for (i=1; i<=m; i++)
{
c2[2] = i; z = cgetg(n+1,t_COL); gel(y,i) = z;
@@ -866,12 +862,11 @@
{
c1[2] = j; p1 = closure_evalnobrk(code);
gel(z,j) = isonstack(p1)? p1 : gcopy(p1);
- changevalue_p(ep1,c1);
- changevalue_p(ep2,c2);
+ set_lex(-2,c1);
+ set_lex(-1,c2);
}
}
- pop_val(ep2);
- pop_val(ep1); return y;
+ pop_lex(); pop_lex(); return y;
}
/********************************************************************/
@@ -994,12 +989,12 @@
}
GEN
-sumalt0(entree *ep, GEN a, GEN code, long flag, long prec)
+sumalt0(GEN a, GEN code, long flag, long prec)
{
switch(flag)
{
- case 0: EXPR_WRAP(ep,code, sumalt (EXPR_ARG,a,prec));
- case 1: EXPR_WRAP(ep,code, sumalt2(EXPR_ARG,a,prec));
+ case 0: EXPR_WRAP(code, sumalt (EXPR_ARG,a,prec));
+ case 1: EXPR_WRAP(code, sumalt2(EXPR_ARG,a,prec));
default: pari_err(flagerr);
}
return NULL; /* not reached */
@@ -1097,12 +1092,12 @@
}
GEN
-sumpos0(entree *ep, GEN a, GEN code, long flag, long prec)
+sumpos0(GEN a, GEN code, long flag, long prec)
{
switch(flag)
{
- case 0: EXPR_WRAP(ep,code, sumpos (EXPR_ARG,a,prec));
- case 1: EXPR_WRAP(ep,code, sumpos2(EXPR_ARG,a,prec));
+ case 0: EXPR_WRAP(code, sumpos (EXPR_ARG,a,prec));
+ case 1: EXPR_WRAP(code, sumpos2(EXPR_ARG,a,prec));
default: pari_err(flagerr);
}
return NULL; /* not reached */
@@ -1181,8 +1176,8 @@
}
GEN
-zbrent0(entree *ep, GEN a, GEN b, GEN code, long prec)
-{ EXPR_WRAP(ep,code, zbrent(EXPR_ARG, a,b, prec)); }
+zbrent0(GEN a, GEN b, GEN code, long prec)
+{ EXPR_WRAP(code, zbrent(EXPR_ARG, a,b, prec)); }
/* x = solve_start(&D, a, b, prec)
* while (x) {
@@ -1227,8 +1222,8 @@
}
GEN
-derivnum0(entree *ep, GEN a, GEN code, long prec)
+derivnum0(GEN a, GEN code, long prec)
{
- EXPR_WRAP(ep,code, derivnum (EXPR_ARG,a,prec));
+ EXPR_WRAP(code, derivnum (EXPR_ARG,a,prec));
}
Index: src/modules/elldata.c
===================================================================
RCS file: /home/cvs/pari/src/modules/elldata.c,v
retrieving revision 1.18
diff -u -r1.18 elldata.c
--- src/modules/elldata.c 13 Apr 2007 23:42:48 -0000 1.18
+++ src/modules/elldata.c 21 Aug 2007 15:06:11 -0000
@@ -239,12 +239,12 @@
}
void
-forell(entree *ep, long a, long b, GEN code)
+forell(long a, long b, GEN code)
{
long ca=a/1000, cb=b/1000;
long i, j, k;
- push_val(ep, NULL);
+ push_lex(NULL);
for(i=ca; i<=cb; i++)
{
pari_sp ltop=avma;
@@ -259,7 +259,7 @@
for(k=2; k<lg(ells); k++)
{
pari_sp av=avma;
- ep->value = (void*)gel(ells, k);
+ set_lex(-1,gel(ells, k));
closure_evalvoid(code);
avma=av;
if (loop_break()) goto forell_end;
@@ -268,5 +268,5 @@
avma = ltop;
}
forell_end:
- pop_val(ep);
+ pop_lex();
}
Index: src/test/32/program
===================================================================
RCS file: /home/cvs/pari/src/test/32/program,v
retrieving revision 1.23
diff -u -r1.23 program
--- src/test/32/program 28 Mar 2007 22:40:42 -0000 1.23
+++ src/test/32/program 21 Aug 2007 15:06:11 -0000
@@ -134,7 +134,7 @@
3
? kill(addii)
? getheap
-[24, 3169]
+[23, 3164]
? print("Total time spent: ",gettime);
-Total time spent: 560
+Total time spent: 36
? \q
Index: src/test/64/program
===================================================================
RCS file: /home/cvs/pari/src/test/64/program,v
retrieving revision 1.25
diff -u -r1.25 program
--- src/test/64/program 28 Mar 2007 22:40:42 -0000 1.25
+++ src/test/64/program 21 Aug 2007 15:06:11 -0000
@@ -131,7 +131,7 @@
3
? kill(addii)
? getheap
-[24, 1683]
+[23, 1678]
? print("Total time spent: ",gettime);
-Total time spent: 16
+Total time spent: 8
? \q
--- /dev/null 2007-08-04 13:06:12.080067500 +0200
+++ src/functions/programming/my 2007-05-12 14:00:42.000000000 +0200
@@ -0,0 +1,3 @@
+Function: my
+Section: programming/specific
+Help: my(x,...,z): declare x,...,z as lexically-scoped local variables