| Bill Allombert on Fri, 25 Sep 2009 15:04:57 +0200 |
[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]
| experimental patch for iferr |
Dear PARI-dev,
Please find attached a patch that add a new function iferr()
? ?iferr
iferr(seq1,E,{seq2},{seq3}): evaluates the expression sequence seq1. if an
error occurs, seq2 is evaluated with the variable 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.
This is a very crude ECM implementation:
ecm(N,a,B)=
{
my(E=ellinit([0,0,0,a,1]*Mod(1,N)));
iferr(ellpow(E,[0,1]*Mod(1,N),B),
err,if(err[1]==20,return(gcd(lift(err[2]),N)),error(E)));
0
}
? ecm(2^32+1,1,100!)
%1 = 641
? ecm(2^64+1,1,200!)
%2 = 274177
The difficult part is the definition of the error data.
Currently it is simply a vector whose first component is the error
number and the rest is the other arguments passed to pari_err.
The whole problem is that it brings error messages to the status of
GP interface and thus a small change in the report of an error can
cause some GP programs to fail. So the error data format should be carefully
considered.
Cheers,
Bill.
diff --git a/src/functions/programming/iferr b/src/functions/programming/iferr
new file mode 100644
index 0000000..e63bcfd
--- /dev/null
+++ b/src/functions/programming/iferr
@@ -0,0 +1,13 @@
+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 variable 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 variable 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 7d2b634..6d2076e 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 74269e3..40d776d 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..9e8a90c 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..8aea45a 100644
--- a/src/language/sumiter.c
+++ b/src/language/sumiter.c
@@ -16,6 +16,34 @@ 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(global_err_data,b);
+ res = closure_evalgen(b);
+ pop_lex(1);
+ return res;
+ }
+ else
+ res = closure_evalgen(a);
+ iferr_env = iferr_old;
+ return c?closure_evalgen(c):res;
+}
+
/********************************************************************/
/** **/
/** ITERATIONS **/