| Bill Allombert on Thu, 01 Oct 2009 13:49:08 +0200 |
[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]
| Re: experimental patch for iferr |
On Thu, Oct 01, 2009 at 12:39:48PM +0200, Lorenz Minder wrote: > Hi, > > BA: > > On Thu, Oct 01, 2009 at 07:55:42AM +0200, Lorenz Minder wrote: > > > Hi, > > > > > > 2) I'd prefer if the second argument was a reference, i.e., one would > > write > > > > > > iferr(whatever, &E, seq1, seq2) > > > > > > Right now it seems that this is the only function in GP that > > > modifies an argument that was (syntactically) passed by value. I have > > > no idea if this is difficult to do. (I've no time for studying > > > source code ATM, unfortunately.) > > > > This is a misunderstanding: E is not modified! E is actually a local > > parameter > > that only exist in the 'err' branch, as in the following expressions: > > Yes, right. I only realized this after experimenting a bit more with it. > So it's fine as is, of course. > > On an unrelated note, I found another failing instance, possibly the > same bug as before. > > ? iferr(1/0, E, ["fail", E], "ok") > *** at top-level: iferr(1/0,E,["fail",E],"ok") > *** ^---------------- > *** the PARI stack overflows ! Yes, I forgot to gcopy the error data. Please find a fixed patch. Thanks a lot for your experimentations! Cheers, Bill.
diff --git a/src/functions/programming/iferr b/src/functions/programming/iferr
new file mode 100644
index 0000000..1035f87
--- /dev/null
+++ b/src/functions/programming/iferr
@@ -0,0 +1,14 @@
+Function: iferr
+Section: programming/control
+C-Name: iferrpari
+Prototype: EVDEDE
+Help: iferr(seq1,E,{seq2},{seq3}): evaluates the expression sequence seq1. if
+ an error occurs, seq2 is evaluated with the formal parameter E set to the
+ error data, otherwise seq3 is evaluated. The arguments seq2 and seq3 are
+ optional, and if seq3 is omitted, the preceding comma can be omitted also.
+Doc: evaluates the expression sequence \var{seq1}. if an error occurs,
+ \var{seq2} is evaluated with the formal parameter \var{E} set to the error
+ data, otherwise \var{seq3} is evaluated. The arguments \var{seq2} and
+ \var{seq3} are optional, and if \var{seq3} is omitted, the preceding comma can
+ be omitted also.
+
diff --git a/src/headers/paripriv.h b/src/headers/paripriv.h
index 0f1a4a4..8ef158a 100644
--- a/src/headers/paripriv.h
+++ b/src/headers/paripriv.h
@@ -49,6 +49,7 @@ GEN resetloop(GEN a, GEN b);
GEN setloop(GEN a);
/* parser */
+GEN iferrpari(GEN a, GEN b, GEN c);
void forpari(GEN a, GEN b, GEN node);
void untilpari(GEN a, GEN b);
void whilepari(GEN a, GEN b);
diff --git a/src/language/compile.c b/src/language/compile.c
index e95b6ba..28e6a06 100644
--- a/src/language/compile.c
+++ b/src/language/compile.c
@@ -1105,6 +1105,7 @@ compilefunc(entree *ep, long n, int mode)
}
checkdups(varg,vep);
frame_push(vep);
+ lev=0;
}
if (tree[a].f==Fnoarg)
compilecast(a,Gvoid,type);
@@ -1194,10 +1195,11 @@ compilefunc(entree *ep, long n, int mode)
j++;
switch(c)
{
- case 'G':
- case '&':
case 'E':
case 'I':
+ lev=0; /*FALL THROUGH*/
+ case 'G':
+ case '&':
op_push(OCpushlong,0,n);
break;
case 'n':
diff --git a/src/language/es.c b/src/language/es.c
index 72777d2..ca8357e 100644
--- a/src/language/es.c
+++ b/src/language/es.c
@@ -4023,7 +4023,11 @@ void print (GEN g) { print0(g, f_RAW); pari_putc('\n'); pari_flush(); }
void printtex(GEN g) { print0(g, f_TEX); pari_putc('\n'); pari_flush(); }
void print1 (GEN g) { print0(g, f_RAW); pari_flush(); }
-void error0(GEN g) { pari_err(user, g); }
+void error0(GEN g)
+{
+ if (lg(g)==2 && typ(gel(g,1))==t_VEC) pari_err(0, gel(g,1));
+ else pari_err(user, g);
+}
void warning0(GEN g) { pari_warn(user, g); }
static char *
diff --git a/src/language/init.c b/src/language/init.c
index 5cba082..a660cfa 100644
--- a/src/language/init.c
+++ b/src/language/init.c
@@ -817,9 +817,13 @@ err_seek(long n)
return NULL;
}
+
+extern jmp_buf *iferr_env;
+
void
err_recover(long numerr)
{
+ iferr_env=NULL;
initout(0);
dbg_release();
killallfiles(0);
@@ -911,6 +915,118 @@ pari_sigint(const char *s)
err_recover(talker);
}
+GEN
+pari_err_GEN(int numerr, va_list ap)
+{
+ switch (numerr)
+ {
+ case talker: case alarmer:
+ {
+ const char *ch1 = va_arg(ap, char*);
+ char *s = pari_vsprintf(ch1,ap);
+ GEN res = mkvec3(stoi(numerr),strtoGENstr(ch1),strtoGENstr(s));
+ free(s);
+ return res;
+ }
+ case user:
+ case invmoder:
+ case notfuncer:
+ return mkvec2(stoi(numerr),va_arg(ap, GEN));
+ case openfiler:
+ case overflower:
+ case impl:
+ case typeer: case mattype1: case negexper:
+ case constpoler: case notpoler: case redpoler:
+ case zeropoler: case consister: case flagerr: case precer:
+ case bugparier:
+ return mkvec2(stoi(numerr),strtoGENstr(va_arg(ap, char*)));
+ case operi: case operf:
+ {
+ const char *op = va_arg(ap, const char*);
+ GEN x = va_arg(ap, GEN);
+ GEN y = va_arg(ap, GEN);
+ return mkvec4(stoi(numerr),strtoGENstr(op),x,y);
+ }
+ case primer1:
+ return mkvec2(stoi(numerr),utoi(va_arg(ap, ulong)));
+ default:
+ return mkvecs(numerr);
+ }
+}
+
+void
+pari_err_display(GEN err)
+{
+ long numerr=itos(gel(err,1));
+ err_init_msg(numerr); pari_puts(errmessage[numerr]);
+ switch (numerr)
+ {
+ case talker: case alarmer:
+ pari_printf("%Ps.",gel(err,3));
+ break;
+ case user:
+ pari_puts("user error: ");
+ print0(gel(err,2), f_RAW);
+ break;
+ case invmoder:
+ pari_printf("impossible inverse modulo: %Ps.", gel(err,2));
+ break;
+ case openfiler:
+ pari_printf("error opening %Ps file: `%Ps'.", gel(err,2), gel(err,3));
+ break;
+ case overflower:
+ pari_printf("overflow in %Ps.", gel(err,2));
+ break;
+ case notfuncer:
+ {
+ GEN fun = gel(err,2);
+ if (gcmpX(fun))
+ {
+ entree *ep = varentries[varn(fun)];
+ const char *s = ep->name;
+ if (cb_pari_whatnow) cb_pari_whatnow(s,1);
+ }
+ break;
+ }
+ case impl:
+ pari_printf("sorry, %Ps is not yet implemented.", gel(err,2));
+ break;
+ case typeer: case mattype1: case negexper:
+ case constpoler: case notpoler: case redpoler:
+ case zeropoler: case consister: case flagerr: case precer:
+ pari_printf(" in %Ps.", gel(err,2)); break;
+ case bugparier:
+ pari_printf("bug in %Ps, please report",gel(err,2)); break;
+ case operi: case operf:
+ {
+ const char *f, *op = GSTR(gel(err,2));
+ GEN x = gel(err,3);
+ GEN y = gel(err,4);
+ pari_puts(numerr == operi? "impossible": "forbidden");
+ switch(*op)
+ {
+ case '+': f = "addition"; break;
+ case '-':
+ pari_printf(" negation - %s.",type_name(typ(x)));
+ f = NULL; break;
+ case '*': f = "multiplication"; break;
+ case '/': case '%': case '\\': f = "division"; break;
+ case 'g': op = ","; f = "gcd"; break;
+ default: op = "-->"; f = "assignment"; break;
+ }
+ if (f)
+ pari_printf(" %s %s %s %s.",f,type_name(typ(x)),op,type_name(typ(y)));
+ break;
+ }
+ case primer1:
+ {
+ ulong c = itou(gel(err,2));
+ if (c) pari_printf(", need primelimit ~ %u.", c);
+ break;
+ }
+ }
+}
+
void
pari_err(int numerr, ...)
{
@@ -937,89 +1053,22 @@ pari_err(int numerr, ...)
longjmp(*(trapped->penv), numerr);
}
}
- err_init();
if (numerr == talker2)
{
const char *msg = va_arg(ap, char*);
const char *s = va_arg(ap,char *);
+ err_init();
print_errcontext(msg,s,va_arg(ap,char *));
}
else
{
+ GEN err=numerr?pari_err_GEN(numerr,ap):va_arg(ap,GEN);
+ global_err_data=err;
+ if (*iferr_env)
+ longjmp(*iferr_env, numerr);
+ err_init();
closure_err();
- err_init_msg(numerr); pari_puts(errmessage[numerr]);
- switch (numerr)
- {
- case talker: case alarmer: {
- const char *ch1 = va_arg(ap, char*);
- pari_vprintf(ch1,ap); pari_putc('.'); break;
- }
- case user:
- pari_puts("user error: ");
- print0(va_arg(ap, GEN), f_RAW);
- break;
- case invmoder:
- pari_printf("impossible inverse modulo: %Ps.", va_arg(ap, GEN));
- break;
- case openfiler: {
- const char *type = va_arg(ap, char*);
- pari_printf("error opening %s file: `%s'.", type, va_arg(ap,char*));
- break;
- }
- case overflower:
- pari_printf("overflow in %s.", va_arg(ap, char*));
- break;
- case notfuncer:
- {
- GEN fun = va_arg(ap, GEN);
- if (gcmpX(fun))
- {
- entree *ep = varentries[varn(fun)];
- const char *s = ep->name;
- if (cb_pari_whatnow) cb_pari_whatnow(s,1);
- }
- break;
- }
-
- case impl:
- pari_printf("sorry, %s is not yet implemented.", va_arg(ap, char*));
- break;
- case typeer: case mattype1: case negexper:
- case constpoler: case notpoler: case redpoler:
- case zeropoler: case consister: case flagerr: case precer:
- pari_printf(" in %s.",va_arg(ap, char*)); break;
-
- case bugparier:
- pari_printf("bug in %s, please report",va_arg(ap, char*)); break;
-
- case operi: case operf:
- {
- const char *f, *op = va_arg(ap, const char*);
- GEN x = va_arg(ap, GEN);
- GEN y = va_arg(ap, GEN);
- pari_puts(numerr == operi? "impossible": "forbidden");
- switch(*op)
- {
- case '+': f = "addition"; break;
- case '-':
- pari_printf(" negation - %s.",type_name(typ(x)));
- f = NULL; break;
- case '*': f = "multiplication"; break;
- case '/': case '%': case '\\': f = "division"; break;
- case 'g': op = ","; f = "gcd"; break;
- default: op = "-->"; f = "assignment"; break;
- }
- if (f)
- pari_printf(" %s %s %s %s.",f,type_name(typ(x)),op,type_name(typ(y)));
- break;
- }
-
- case primer1: {
- ulong c = va_arg(ap, ulong);
- if (c) pari_printf(", need primelimit ~ %lu.", c);
- break;
- }
- }
+ pari_err_display(err);
}
term_color(c_NONE); va_end(ap);
if (numerr==errpile)
diff --git a/src/language/sumiter.c b/src/language/sumiter.c
index f56a693..6289e07 100644
--- a/src/language/sumiter.c
+++ b/src/language/sumiter.c
@@ -16,6 +16,33 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
#include "pari.h"
#include "paripriv.h"
#include "anal.h"
+
+jmp_buf *iferr_env=NULL;
+
+GEN
+iferrpari(GEN a, GEN b, GEN c)
+{
+ GEN res;
+ jmp_buf *iferr_old=iferr_env;
+ jmp_buf env;
+ struct pari_evalstate state;
+ evalstate_save(&state);
+ iferr_env = &env;
+ if (setjmp(*iferr_env))
+ {
+ iferr_env = iferr_old;
+ evalstate_restore(&state);
+ if (!b) return gnil;
+ push_lex(gcopy(global_err_data),b);
+ res = closure_evalgen(b);
+ pop_lex(1);
+ return res;
+ }
+ res = closure_evalgen(a);
+ iferr_env = iferr_old;
+ return c?closure_evalgen(c):res;
+}
+
/********************************************************************/
/** **/
/** ITERATIONS **/