Bill Allombert on Thu, 11 Oct 2007 02:02:00 +0200


[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]

Functions as first-class objects


Hello PARI-dev,

I would like to discuss moving user functions to first-class objects,
and add support for anonymous functions and closures.
The attached (-p1) patch implement that. Interestingly this patch
reduces the code size while adding features.

The idea is to remove the distinction between variables and functions:
a function would just be a variable that hold a function object
(of type t_CLOSURE in my patch). This means that functions could be
passed as parameter, store in local variable and returned by a function.

The consequence are far-reaching, so I would really appreciate comments.
I would like to keep the syntax in the spirit of GP.

1) We need new syntax to define anonymous functions:
The patch adds the following syntax:
 * (x1,...,xn)->EXPR : create an anonymous function.
 * x1->EXPR is accepted as a short-hand for (x1)->EXPR
 * f(x1,...,xn)=EXPR is accepted as a short-hand for f=(x1,...,xn)->EXPR
 * (EXPR)(x1,...,xn) evaluate the expression EXPR. If the result is a
   function, it call it on (x1,...,xn), else it fails.
Oddity:
 * Nullary anonymous functions are defined by
()->EXPR
 * The parens in (EXPR)(x1,...,xn) tend to be annoying:
 (%34)(5), (f(5))(6), etc.
 * GP does not know about tuples thought the left part of (x1,...,xn)->EXPR
looks like a tuple and the patch provide no support for currying/uncurrying:
x->y->x+y and (x,y)->x+y require different calling syntax.
 * There is no syntactic sugar for basic operations on functions like
 slice: x->f(x,56), composition x->f(g(x)), etc.

2) We have to print functions since they are objects now.
 * The patch call all function to be printed as
(x1,...,xn)->EXPR even if they were defined through f(x1,...,xn)=EXPR
because the latter is actually an affectation and that would break
copy-paste:
? f(x)=x^4+1
%1 = (x) -> x^4+1
? g=(x) -> x^4+1
%2 = (x) -> x^4+1
? f(x)==g(x)
%3 = 1
 * Actually closures break copy-paste because they refer to 'hidden'
data:
? f(x)=y->x+y
%4 = (x) -> y->x+y
? f(5)
%5 = (y) -> x+y
? (%5)(6)
%6 = 11
? ((y) -> x+y)(6)
%7 = x + 6

3) Incompatibilities:
 * f(x)=x^4+1 is equivalent to f=(x)->x^4+1 which return the 'value'
(x)->x^4+1 instead of void:
? f(x)=x^4+1
%1 = (x) -> x^4+1
 * Calling a function without () no more evaluate it:
? f
%2 = (x) -> x^4+1

4) Deficiencies
 * The patch does not provide any low-level operations on closures.
 * Built-in functions are not first-class objects, and there are no
obvious way to encapsulate them in a user function, due to some
prototype code which have now user functions equivalent.
 * While functions act as closure with respect to lexically-scoped local
variables, variables values changes occuring after the function is
defined are ignored.
 * It is not possible to define recursive anonymous functions (short
of the Y combinator). Maybe we need to add a 'self' construction:

? g(f)=x->if(x,x*f(x-1),1)
%17 = (f) -> x->if(x,x*f(x-1),1)
? fix=f->(x->f(y->(x(x))(y)))(x->f(y->(x(x))(y)))
%18 = (f) -> (x->f(y->(x(x))(y)))(x->f(y->(x(x))(y)))
? (fix(g))(6)
%19 = 720

That's all for today :)

Cheers,
Bill

PS: I dedicate this patch to Henri Cohen for his birthday.
Happy birthday, Henri!
Index: parigp3/src/gp/gp.c
===================================================================
--- parigp3.orig/src/gp/gp.c	2007-10-11 00:45:32.000000000 +0200
+++ parigp3/src/gp/gp.c	2007-10-11 00:46:05.000000000 +0200
@@ -390,6 +390,7 @@
   t_LIST   : list              [ code ] [ n ] [ nmax ][ vec ]\n\
   t_STR    : string            [ code ] [ man_1 ] ... [ man_k ]\n\
   t_VECSMALL: vec. small ints  [ code ] [ x_1 ] ... [ x_k ]\n\
+  t_CLOSURE: functions  [ code ] [ arity ] [ code ] [ operand ] [ data ] [text ]\n\
 \n");
 }
 
@@ -668,14 +669,14 @@
 
   switch(EpVALENCE(ep))
   {
-    case EpUSER:
-      if (!ep->help || long_help) pariputs(ep->code);
-      if (!ep->help) return;
-      if (long_help) { pariputs("\n\n"); long_help=0; }
-      break;
-
     case EpVAR:
-      if (!ep->help) { aide_print(s, "user defined variable"); return; }
+      if (typ(ep->value)==t_CLOSURE)
+      {
+        if (!ep->help || long_help) pariprintf("%s = %s",ep->name,GSTR(gel(ep->value,5)));
+        if (!ep->help) return;
+        if (long_help) { pariputs("\n\n"); long_help=0; }
+      }
+      else if (!ep->help) { aide_print(s, "user defined variable"); return; }
       long_help=0; break;
 
     case EpINSTALL:
Index: parigp3/src/graph/plotport.c
===================================================================
--- parigp3.orig/src/graph/plotport.c	2007-10-11 00:45:33.000000000 +0200
+++ parigp3/src/graph/plotport.c	2007-10-11 00:46:05.000000000 +0200
@@ -103,7 +103,7 @@
 
 static GEN
 READ_EXPR(GEN code, GEN x) {
-  if (typ(code)==t_POL || typ(code[1])==t_POL) return gsubst(code,0,x);
+  if (typ(code)!=t_CLOSURE) return gsubst(code,0,x);
   set_lex(-1, x); return closure_evalgen(code);
 }
 
Index: parigp3/src/language/anal.c
===================================================================
--- parigp3.orig/src/language/anal.c	2007-10-11 00:45:32.000000000 +0200
+++ parigp3/src/language/anal.c	2007-10-11 00:46:05.000000000 +0200
@@ -637,6 +637,14 @@
     case '-':
       *lex+=2; yylloc->end = *lex; return KSE;
     }
+  if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
+  {
+    *lex+=3; yylloc->end = *lex; return KPARROW;
+  }
+  if (**lex=='-' && (*lex)[1]=='>')
+  {
+    *lex+=2; yylloc->end = *lex; return KARROW;
+  }
   if (**lex=='<' && (*lex)[1]=='>')
   {
     *lex+=2; yylloc->end = *lex; return KNE;
@@ -1126,9 +1134,10 @@
   int i;
   for (i = 0; i < functions_tblsz; i++)
     for (ep = functions_hash[i]; ep; ep = ep->next)
-      if (EpVALENCE(ep) == EpUSER)
+      if (EpVALENCE(ep) == EpVAR && typ(ep->value)==t_CLOSURE)
       {
-        pariputc('{'); pariputs(ep->code);
+        pariputc('{');
+        pariprintf("%s = %s",ep->name,GSTR(gel(ep->value,5)));
         pariputc('}'); pariputs("\n\n");
       }
 }
Index: parigp3/src/language/anal.h
===================================================================
--- parigp3.orig/src/language/anal.h	2007-10-11 00:45:32.000000000 +0200
+++ parigp3/src/language/anal.h	2007-10-11 00:46:05.000000000 +0200
@@ -94,8 +94,8 @@
 #define EpVALENCE(ep) ((ep)->valence & 0xFF)
 #define EpSTATIC(ep) ((ep)->valence & 0x100)
 #define EpSETSTATIC(ep) ((ep)->valence |= 0x100)
-#define EpPREDEFINED(ep) (EpVALENCE(ep) < EpUSER)
-enum { EpUSER = 100, EpNEW, EpALIAS, EpVAR, EpMEMBER, EpINSTALL };
+#define EpPREDEFINED(ep) (EpVALENCE(ep) < EpNEW)
+enum { EpNEW=100, EpALIAS, EpVAR, EpMEMBER, EpINSTALL };
 #define initial_value(ep) ((ep)+1)
 
 extern entree  **varentries;
Index: parigp3/src/language/compile.c
===================================================================
--- parigp3.orig/src/language/compile.c	2007-10-11 00:45:32.000000000 +0200
+++ parigp3/src/language/compile.c	2007-10-11 00:46:05.000000000 +0200
@@ -77,29 +77,31 @@
 }
 
 static GEN
-getclosure_var(struct codepos *pos, long nbmvar)
+getfunction(long n, struct codepos *pos, long arity, long nbmvar, GEN text)
 {
   long lop =s_opcode.n+1-pos->opcode;
   long ldat=s_data.n+1-pos->data;
-  GEN cl=cgetg(nbmvar?5:4,t_VEC);
+  GEN cl=cgetg(nbmvar?7:6,t_CLOSURE);
   char *s;
   long i;
-  gel(cl,1) = cgetg(nchar2nlong(lop)+1, t_STR);
-  gel(cl,2) = cgetg(lop,  t_VECSMALL);
-  gel(cl,3) = cgetg(ldat, t_VEC);
-  if (nbmvar) gel(cl,4) = zerovec(nbmvar);
-  s=GSTR(gel(cl,1))-1;
+  cl[1] = arity;
+  gel(cl,2) = cgetg(nchar2nlong(lop)+1, t_STR);
+  gel(cl,3) = cgetg(lop,  t_VECSMALL);
+  gel(cl,4) = cgetg(ldat, t_VEC);
+  gel(cl,5) = text;
+  if (nbmvar) gel(cl,6) = zerovec(nbmvar);
+  s=GSTR(gel(cl,2))-1;
   for(i=1;i<lop;i++)
   {
     s[i] = opcode[i+pos->opcode-1];
-    mael(cl, 2, i) = operand[i+pos->opcode-1];
+    mael(cl, 3, i) = operand[i+pos->opcode-1];
   }
   s[i]=0;
   s_opcode.n=pos->opcode;
   s_operand.n=pos->opcode;
   for(i=1;i<ldat;i++)
   {
-    gmael(cl, 3, i) = gcopy(data[i+pos->data-1]);
+    gmael(cl, 4, i) = gcopy(data[i+pos->data-1]);
     gunclone(data[i+pos->data-1]);
   }
   s_data.n=pos->data;
@@ -108,12 +110,14 @@
   return cl;
 }
 
+
 static GEN
-getclosure(struct codepos *pos)
+getclosure(long n, struct codepos *pos)
 {
-  return getclosure_var(pos,0);
+  return getfunction(n,pos,0,0,strntoGENstr(tree[n].str,tree[n].len));
 }
 
+
 static void
 op_push(op_code o, long x)
 {
@@ -551,6 +555,27 @@
 enum { RET_GEN, RET_INT, RET_LONG, RET_VOID };
 
 static void
+compilecall(long n, int mode)
+{
+  pari_sp ltop=avma;
+  long j;
+  long x=tree[n].x;
+  long y=tree[n].y;
+  GEN arg=listtogen(y,Flistarg);
+  long nb=lg(arg)-1;
+  compilenode(x,Ggen,0);
+  for (j=1;j<=nb;j++)
+    if (tree[arg[j]].f!=Fnoarg)
+      compilenode(arg[j], Ggen,0);
+    else
+      op_push(OCpushlong,0);
+  op_push(OCcalluser, nb);
+  compilecast(n,Ggen,mode);
+  avma=ltop;
+  return;
+}
+
+static void
 compilefunc(long n, int mode)
 {
   pari_sp ltop=avma;
@@ -565,23 +590,24 @@
   long lnc=first_safe_arg(arg);
   long nbpointers=0;
   long nb=lg(arg)-1, lev=0;
-  entree *ep = getfunc(n);
+  entree *ep=getfunc(n);
   entree *ev[8];
-  if (EpVALENCE(ep)==EpVAR)
-    pari_err(talker2,"not a function in function call",
-        tree[n].str, get_origin());
-  if (EpVALENCE(ep)==EpUSER|| EpVALENCE(ep)==EpNEW)
+  if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
   {
+    long vn=getmvar(ep);
+    if (vn)
+      op_push(OCpushlex,vn);
+    else
+      op_push(OCpushdyn,(long)ep);
     for (j=1;j<=nb;j++)
       if (tree[arg[j]].f!=Fnoarg)
         compilenode(arg[j], Ggen,0);
       else
         op_push(OCpushlong,0);
-    op_push(OCpushlong, nb);
     if (tree[n].f==Fderfunc)
-      op_push(OCderivuser, (long) ep);
+      op_push(OCderivuser, nb);
     else
-      op_push(OCcalluser, (long) ep);
+      op_push(OCcalluser, nb);
     compilecast(n,Ggen,mode);
     avma=ltop;
     return;
@@ -794,7 +820,7 @@
               compilecast(a,Gvoid,type);
             else
               compilenode(a,type,flag);
-            op_push(OCpushgen, data_push(getclosure(&pos)));
+            op_push(OCpushgen, data_push(getclosure(a,&pos)));
             break;
           }
         case 'V':
@@ -1146,26 +1172,25 @@
   case Ffunction:
     compilefunc(n, mode);
     return;
-  case Fdeffunc:
+  case Fcall:
+    compilecall(n, mode);
+    return;
+  case Flambda:
     {
       pari_sp ltop=avma;
       struct codepos pos;
       long i;
-      GEN arg2=listtogen(tree[x].y,Flistarg);
-      entree *ep=getfunc(x);
+      GEN arg2=listtogen(x,Flistarg);
       long loc=y;
       long arity=lg(arg2)-1,nbmvar=numbmvar();
+      GEN text,textv=cgetg(5,t_VEC);
+      gel(textv,1)=strtoGENstr("(");
+      gel(textv,2)=strntoGENstr(tree[x].str,tree[x].len);
+      gel(textv,3)=strtoGENstr(") -> ");
+      gel(textv,4)=strntoGENstr(tree[y].str,tree[y].len);
+      text=concat(textv,NULL);
       if (loc>=0)
         while (tree[loc].f==Fseq) loc=tree[loc].x;
-      if (ep->valence!=EpNEW && ep->valence!=EpUSER)
-      {
-        if (ep->valence==EpVAR)
-          pari_err(talker2,"this is a variable",
-              tree[n].str,get_origin());
-        else
-          pari_err(talker2,"cannot redefine GP functions",
-              tree[n].str,get_origin());
-      }
       getcodepos(&pos);
       if (arity) op_push(OCnewframe,arity);
       for (i=1;i<=arity;i++)
@@ -1184,7 +1209,7 @@
             struct codepos lpos;
             getcodepos(&lpos);
             compilenode(tree[a].y,Ggen,0);
-            op_push(OCpushgen, data_push(getclosure(&lpos)));
+            op_push(OCpushgen, data_push(getclosure(tree[a].y,&lpos)));
             en=getvar(tree[a].x);
             var_push(en,Lmy);
             op_push(OCdefaultarg,-arity+i-1);
@@ -1199,12 +1224,8 @@
         compilenode(y,Ggen,FLreturn);
       else
         compilecast(n,Gvoid,Ggen);
-      op_push(OCpushgen, data_push(getclosure_var(&pos,nbmvar)));
-      op_push(OCpushgen, data_push(
-            strntoGENstr(tree[n].str,tree[n].len)));
-      op_push(OCpushlong, arity);
-      op_push(OCdeffunc, (long) ep);
-      compilecast(n,Gvoid,mode);
+      op_push(OCpushgen, data_push(getfunction(n,&pos,arity,nbmvar,text)));
+      if(nbmvar) op_push(OCsaveframe,0);
       avma=ltop;
       break;
     }
@@ -1224,6 +1245,6 @@
 {
   struct codepos pos={0,0,0,-1};
   compilenode(n,Ggen,0);
-  return getclosure(&pos);
+  return getclosure(n,&pos);
 }
 
Index: parigp3/src/language/es.c
===================================================================
--- parigp3.orig/src/language/es.c	2007-10-11 00:45:33.000000000 +0200
+++ parigp3/src/language/es.c	2007-10-11 00:46:05.000000000 +0200
@@ -1307,6 +1307,7 @@
     case t_LIST   : s="t_LIST";    break;
     case t_STR    : s="t_STR";     break;
     case t_VECSMALL:s="t_VECSMALL";break;
+    case t_CLOSURE: s="t_CLOSURE"; break;
     default: pari_err(talker,"unknown type %ld",t);
       s = NULL; /* not reached */
   }
@@ -1370,7 +1371,8 @@
   {
     pariprintf("(lmax=%ld):", list_nmax(x));
     x = list_data(x); lx = x? lg(x): 1;
-  }
+  } else if (tx == t_CLOSURE)
+    pariprintf("(arity=%ld):", x[1]);
   for (i=1; i<lx; i++) pariprintf(VOIR_STRING2,x[i]);
   bl+=2; pariputc('\n');
   switch(tx)
@@ -1430,7 +1432,16 @@
 	dbg(gel(x,i),nb,bl);
       }
       break;
-
+    case t_CLOSURE:
+      blancs(bl); pariputs("code = "); dbg(gel(x,2),nb,bl);
+      blancs(bl); pariputs("operand = "); dbg(gel(x,3),nb,bl);
+      blancs(bl); pariputs("data = "); dbg(gel(x,4),nb,bl);
+      blancs(bl); pariputs("text = "); dbg(gel(x,5),nb,bl);
+      if (lg(x)==7)
+      {
+        blancs(bl); pariputs("frame = "); dbg(gel(x,6),nb,bl);
+      }
+      break;
     case t_MAT:
     {
       GEN c = gel(x,1);
@@ -2086,7 +2097,8 @@
 
     case t_STR:
       quote_string(GSTR(g)); break;
-
+    case t_CLOSURE:
+      pariputs(GSTR(gel(g,5))); break;
     case t_MAT:
     {
       void (*print)(GEN, pariout_t *, int);
@@ -2453,6 +2465,9 @@
       pariputs(GSTR(g)); break;
 #endif
     }
+    case t_CLOSURE:
+      pariputs(GSTR(gel(g,5)));
+    break;
     case t_MAT:
     {
       void (*print)(GEN, pariout_t *, int);
Index: parigp3/src/language/eval.c
===================================================================
--- parigp3.orig/src/language/eval.c	2007-10-11 00:45:32.000000000 +0200
+++ parigp3/src/language/eval.c	2007-10-11 00:46:05.000000000 +0200
@@ -171,10 +171,6 @@
   if (ep->code) {gpfree(ep->code); ep->code=NULL;}
   switch(EpVALENCE(ep))
   {
-    case EpUSER:
-      while (ep->pvalue!=INITIAL) pop_val(ep);
-      gunclone((GEN)ep->value); ep->value=NULL;
-      break;
     case EpVAR:
       while (ep->pvalue!=INITIAL) pop_val(ep);
       break;
@@ -213,11 +209,7 @@
   if (v->flag == COPY_VAL && !pop_entree_bloc(ep, loc)) return 0;
   ep->value = v->value;
   ep->pvalue= (char*) v->prev;
-  if (ep->pvalue == INITIAL)
-  {
-    if (ep->code) ep->valence=EpUSER;
-    else if (ep->value==NULL) ep->valence=EpNEW;
-  }
+  ep->valence=v->valence;
   gpfree((void*)v); return 1;
 }
 
@@ -457,15 +449,16 @@
 derivuserwrap(GEN x, void* E)
 {
   pari_sp ltop;
-  entree *ep=(entree*)E;
+  GEN fun=(GEN)E;
   GEN z;
+  long arity=fun[1];
   long j;
   gel(st,sp)=x;
-  for (j=1;j<ep->arity;j++)
-    gel(st,sp+j)=gel(st,sp+j-ep->arity);
-  sp+=ep->arity;
+  for (j=1;j<arity;j++)
+    gel(st,sp+j)=gel(st,sp+j-arity);
+  sp+=arity;
   ltop=avma;
-  closure_eval((GEN) ep->value);
+  closure_eval(fun);
   if (br_status)
   {
     if (br_status!=br_RETURN)
@@ -479,6 +472,7 @@
   return z;
 }
 
+
 INLINE long
 closure_varn(GEN x)
 {
@@ -530,15 +524,15 @@
 static void
 closure_eval(GEN C)
 {
-  char *code=GSTR(gel(C,1))-1;
-  GEN oper=gel(C,2);
-  GEN data=gel(C,3);
+  char *code=GSTR(gel(C,2))-1;
+  GEN oper=gel(C,3);
+  GEN data=gel(C,4);
   long saved_sp=sp;
   long saved_rp=rp;
   long pc, j, nbmvar=0, nblvar=0;
-  if (lg(C)==5)
+  if (lg(C)==7)
   {
-    GEN z=gel(C,4);
+    GEN z=gel(C,6);
     long l=lg(z)-1;
     stack_alloc(&s_var,l);
     s_var.n+=l;
@@ -591,8 +585,7 @@
           gel(st,sp++)=(GEN)ep->value;
           break;
         default:
-          gel(st,sp++)=0;
-          goto calluser; /*Maybe it is a function*/
+          pari_err(talker,"no such variable `%s'",ep->name);
         }
         break;
     case OCpushlex:
@@ -1006,68 +999,67 @@
     case OCderivuser:
         {
           GEN z;
-          long n=st[--sp];
-          ep = (entree*) operand;
-          if (ep->valence!=EpUSER)
-          {
-            if (ep->valence==EpNEW)
-              pari_err(talker,"function '%s' not yet defined",ep->name);
-            else
-              pari_err(talker,"not a function in function call: %s",ep->name);
-          }
-          if (n>ep->arity)
-            pari_err(talker,"Too many arguments for function '%s'",ep->name);
-          for (j=n+1;j<=ep->arity;j++)
+          long n=operand;
+          long arity;
+          GEN fun = gel(st,sp-1-n);
+          if (typ(fun)!=t_CLOSURE)
+             pari_err(talker,"not a function in function call");
+          arity=fun[1];
+          if (n>arity)
+            pari_err(talker,"too many parameters in user-defined function call");
+          for (j=n+1;j<=arity;j++)
             gel(st,sp++)=0;
-          z = derivnum((void*)ep, derivuserwrap, gel(st,sp-ep->arity), precreal);
-          sp-=ep->arity;
+          z = derivnum((void*)fun, derivuserwrap, gel(st,sp-arity), precreal);
+          sp-=arity;
+          sp--;
           gel(st, sp++) = z;
           break;
         }
     case OCcalluser:
-calluser:
         {
           pari_sp ltop;
-          long n=st[--sp];
-          entree *ep = (entree*) operand;
+          long n=operand;
+          GEN fun = gel(st,sp-1-n);
+          long arity;
           GEN z;
-          if (ep->valence!=EpUSER)
+          if (typ(fun)!=t_CLOSURE)
           {
-            int w;
-            if (whatnow_fun && (w = whatnow_fun(ep->name,1)))
-              pari_err(obsoler, ep->name, w);
-            else
+            if (typ(fun) == t_POL && lg(fun) == 4
+                && gel(fun,2)==gen_0 && gel(fun,3)==gen_1)
             {
-              if (ep->valence==EpNEW)
-                pari_err(talker,"function '%s' not yet defined",ep->name);
-              else
-                pari_err(talker,"not a function in function call: %s",ep->name);
+              int w;
+              ep = varentries[varn(fun)];
+              if (whatnow_fun && (w = whatnow_fun(ep->name,1)))
+                pari_err(obsoler, ep->name, w);
             }
+            pari_err(talker,"not a function in function call");
           }
-          if (n>ep->arity)
-            pari_err(talker,"Too many arguments for function '%s'",ep->name);
-          for (j=n+1;j<=ep->arity;j++)
+          arity=fun[1];
+          if (n>arity)
+            pari_err(talker,"too many parameters in user-defined function call");
+          for (j=n+1;j<=arity;j++)
             gel(st,sp++)=0;
 #ifdef STACK_CHECK
           if (PARI_stack_limit && (void*) &z <= PARI_stack_limit)
             pari_err(talker, "deep recursion");
 #endif
           ltop=avma;
-          closure_eval((GEN) ep->value);
+          closure_eval(fun);
           if (br_status)
           {
             if (br_status!=br_RETURN)
               pari_err(talker, "break/next/allocatemem not allowed here");
             avma=ltop;
-            sp-=ep->arity;
+            sp-=arity;
             z = br_res ? gcopy(br_res) : gnil;
             reset_break();
           }
-          else
-            z = gerepileupto(ltop, gel(st,--sp));
-          gel(st, sp++) = z;
-          break;
-        }
+         else
+           z = gerepileupto(ltop, gel(st,--sp));
+         sp--;
+         gel(st, sp++) = z;
+         break;
+       }
     case OCnewframe:
         stack_alloc(&s_var,operand);
         s_var.n+=operand;
@@ -1078,6 +1070,19 @@
           var[s_var.n-j].value=gen_0;
         }
         break;
+     case OCsaveframe:
+       {
+         GEN cl=gcopy(gel(st,sp-1));
+         if (lg(cl)==7)
+         {
+           GEN v=gel(cl,6);
+           long l=lg(v)-1;
+           for(j=1;j<=l;j++)
+             gel(v,j)=gcopy(var[s_var.n-j].value);
+         }
+         gel(st,sp-1) = cl;
+       }
+       break;
     case OCvec:
         gel(st,sp++)=cgetg(operand,t_VEC);
         break;
@@ -1094,37 +1099,6 @@
           gel(st,sp-1) = z;
         }
         break;
-    case OCdeffunc:
-        ep=(entree*)operand;
-        switch(ep->valence)
-        {
-        case EpUSER:
-          gpfree(ep->code);
-          /*FIXME: the function might be in use...
-            gunclone(ep->value);
-          */
-          break;
-        case EpNEW:
-          ep->valence = EpUSER;
-          break;
-        default:
-          pari_err(talker,"function name expected");
-        }
-        { 
-          GEN cl=gel(st,sp-3);
-          if (lg(cl)==5)
-          {
-            GEN v=gel(cl,4);
-            long l=lg(v)-1;
-            for(j=1;j<=l;j++)
-              gel(v,j)=var[s_var.n-j].value;
-          }
-          ep->value = (void *) gclone(cl);
-        }
-        ep->code  = pari_strdup(GSTR(gel(st,sp-2)));
-        ep->arity = st[sp-1];
-        sp-=3;
-        break;
     case OCpop:
         sp-=operand;
         break;
@@ -1207,17 +1181,10 @@
   char * code;
   GEN oper;
   long i;
-  if (typ(C)==t_STR)
-  {
-    entree *ep=fetch_entry(GSTR(C),strlen(GSTR(C)));
-    if (ep->valence!=EpUSER)
-      pari_err(typeer,"disassemble");
-    C=(GEN)ep->value;
-  }
-  if (typ(C)!=t_VEC || lg(C)!=4 || typ(C[1])!=t_STR || typ(C[2])!=t_VECSMALL)
+  if (typ(C)!=t_CLOSURE)
     pari_err(typeer,"disassemble");
-  code=GSTR(gel(C,1))-1;
-  oper=gel(C,2);
+  code=GSTR(gel(C,2))-1;
+  oper=gel(C,3);
   for(i=1;i<lg(oper);i++)
   {
     op_code opcode=(op_code) code[i];
@@ -1378,12 +1345,10 @@
       pariprintf("callvoid\t%s\n",ep->name);
       break;
     case OCderivuser:
-      ep=(entree*)operand;
-      pariprintf("derivuser\t\t%s\n",ep->name);
+      pariprintf("derivuser\t%ld\n",operand);
       break;
     case OCcalluser:
-      ep=(entree*)operand;
-      pariprintf("calluser\t%s\n",ep->name);
+      pariprintf("calluser\t%ld\n",operand);
       break;
     case OCvec:
       pariprintf("vec\t\t%ld\n",operand);
@@ -1394,13 +1359,12 @@
     case OCmat:
       pariprintf("mat\t\t%ld\n",operand);
       break;
-    case OCdeffunc:
-      ep=(entree*)operand;
-      pariprintf("deffunc\t\t%s\n",ep->name);
-      break;
     case OCnewframe:
       pariprintf("newframe\t%ld\n",operand);
       break;
+    case OCsaveframe:
+      pariprintf("saveframe\n");
+      break;
     case OCpop:
       pariprintf("pop\t\t%ld\n",operand);
       break;
Index: parigp3/src/language/init.c
===================================================================
--- parigp3.orig/src/language/init.c	2007-10-11 00:45:33.000000000 +0200
+++ parigp3/src/language/init.c	2007-10-11 00:46:05.000000000 +0200
@@ -1196,7 +1196,7 @@
 /*                                                                 */
 /*******************************************************************/
 /* lontyp[tx] = 0 (non recursive type) or number of codewords for type tx */
-const  long lontyp[] = { 0,0,0,1,1,2,1,2,1,1, 2,2,0,1,1,1,1,1,1,1, 0,0,0 };
+const  long lontyp[] = { 0,0,0,1,1,2,1,2,1,1, 2,2,0,1,1,1,1,1,1,1, 0,0,0,2 };
 
 static GEN
 list_internal_copy(GEN z, long nmax)
Index: parigp3/src/language/opcode.h
===================================================================
--- parigp3.orig/src/language/opcode.h	2007-10-11 00:45:33.000000000 +0200
+++ parigp3/src/language/opcode.h	2007-10-11 00:46:05.000000000 +0200
@@ -27,7 +27,7 @@
               OCcompo1ptr,OCcompo2ptr,OCcompoCptr,OCcompoLptr,
               OCcalllong,OCcallgen,OCcallgen2,OCcallint,OCcallvoid,OCcalluser,
               OCderivgen,OCderivuser,
-              OCdeffunc,OCnewframe,
+              OCnewframe,OCsaveframe,
               OCpushdyn,OCstoredyn,OCnewptrdyn,OCsimpleptrdyn,
               OCpushlex,OCstorelex,OCnewptrlex,OCsimpleptrlex,
               OCgetarg,OCdefaultarg,OClocalvar,OClocalvar0} op_code;
Index: parigp3/src/language/parse.y
===================================================================
--- parigp3.orig/src/language/parse.y	2007-10-11 00:45:32.000000000 +0200
+++ parigp3/src/language/parse.y	2007-10-11 00:46:05.000000000 +0200
@@ -158,6 +158,14 @@
   return newconst(CSTint,loc);
 }
 
+static long
+newfunc(CSTtype t, struct node_loc *func, long args, long code,
+                   struct node_loc *loc)
+{
+  long name=newnode(Fentry,newconst(t,func),-1,func);
+  return newnode(Faffect,name,newnode(Flambda,args,code,loc),loc);
+}
+
 %}
 %name-prefix="pari_"
 %pure-parser
@@ -169,7 +177,7 @@
 %left KDER
 %left INT LVAL
 %left ';' ','
-%right '=' KPE KSE KME KDE KDRE KEUCE KMODE KSRE KSLE
+%right KPARROW KARROW '=' KPE KSE KME KDE KDRE KEUCE KMODE KSRE KSLE
 %left '&' KAND '|' KOR
 %left KEQ KNE KGE '<' KLE '>'
 %left '+' '-'
@@ -220,6 +228,7 @@
     | '%'           {$$=newopcall(OPhist,-1,-1,&@$);}
     | '%' KINTEGER  {$$=newopcall(OPhist,newintnode(&@2),-1,&@$);}
     | '%' backticks {$$=newopcall(OPhist,newnode(Fsmall,-$2,-1,&@$),-1,&@$);}
+    | '(' expr ')' '(' listarg ')'  {$$=newnode(Fcall,$2,$5,&@$);}
     | funcid            {$$=$1;}
     | funcder           {$$=$1;}
     | lvalue %prec LVAL	{$$=$1;}
@@ -300,17 +309,24 @@
        | listarg ',' arg {$$=newnode(Flistarg,$1,$3,&@$);}
 ;
 
-funcid: KENTRY '(' listarg ')' {$$=newnode(Ffunction,newconst(CSTentry,&@1),$3,&@$);}
+funcid: KENTRY '(' listarg ')'
+                     {$$=newnode(Ffunction,newconst(CSTentry,&@1),$3,&@$);}
 ;
 
-funcder: KENTRY KDER listarg ')' {$$=newnode(Fderfunc,newconst(CSTentry,&@1),$3,&@$);}
+funcder: KENTRY KDER listarg ')'
+                     {$$=newnode(Fderfunc,newconst(CSTentry,&@1),$3,&@$);}
+;
 
 memberid:
      expr '.' KENTRY {$$=newnode(Ffunction,newconst(CSTmember,&@3),$1,&@$);}
 ;
 
-definition: funcid   '=' seq %prec DEFFUNC {$$=newnode(Fdeffunc,$1,$3,&@$);}
-          | memberid '=' seq %prec DEFFUNC {$$=newnode(Fdeffunc,$1,$3,&@$);}
+definition: KENTRY '(' listarg ')' '=' seq %prec DEFFUNC
+                                   {$$=newfunc(CSTentry,&@1,$3,$6,&@$);}
+          | expr '.' KENTRY '=' seq %prec DEFFUNC
+                                   {$$=newfunc(CSTmember,&@3,$1,$5,&@$);}
+          | lvalue KARROW seq              {$$=newnode(Flambda, $1,$3,&@$);}
+          | '(' listarg KPARROW seq        {$$=newnode(Flambda, $2,$4,&@$);}
 ;
 
 %%
Index: parigp3/src/language/tree.h
===================================================================
--- parigp3.orig/src/language/tree.h	2007-10-11 00:45:32.000000000 +0200
+++ parigp3/src/language/tree.h	2007-10-11 00:46:05.000000000 +0200
@@ -24,7 +24,8 @@
 	      Frefarg,
 	      Fconst,Fsmall,
 	      Ftag,
-	      Fentry,Ffunction,Fderfunc,Fdeffunc,
+              Fentry,Fcall,Ffunction,Fderfunc,
+              Flambda
 } Ffunc;
 
 #define Flastfunc  (Fdeffunc)
Index: parigp3/src/test/64/program
===================================================================
--- parigp3.orig/src/test/64/program	2007-10-11 00:45:33.000000000 +0200
+++ parigp3/src/test/64/program	2007-10-11 00:46:05.000000000 +0200
@@ -64,7 +64,7 @@
 , 4582267480000687864, -7629613429408037667, 4813661187837882458, -776313336
 5088963398, 63, 3001673639903682625])
 ? getstack
-80
+120
 ? if(3<2,print("bof"),print("ok"));
 ok
 ? kill(y);print(x+y);
@@ -75,6 +75,7 @@
 ? f=12
 12
 ? g(u)=if(u,,return(17));u+2
+(u) -> if(u,,return(17));u+2
 ? g(2)
 4
 ? g(0)
@@ -131,7 +132,7 @@
 3
 ? kill(addii)
 ? getheap
-[23, 1678]
+[25, 1758]
 ? print("Total time spent: ",gettime);
 Total time spent: 8
 ? \q
Index: parigp3/src/headers/paritype.h
===================================================================
--- parigp3.orig/src/headers/paritype.h	2007-10-11 00:07:00.000000000 +0200
+++ parigp3/src/headers/paritype.h	2007-10-11 00:46:05.000000000 +0200
@@ -35,7 +35,8 @@
   t_MAT    =  19,
   t_LIST   =  20,
   t_STR    =  21,
-  t_VECSMALL= 22
+  t_VECSMALL= 22,
+  t_CLOSURE = 23
 };
 #define is_const_t(t) ((t) < t_POLMOD)
 #define is_extscalar_t(t) ((t) <= t_POL)
Index: parigp3/src/basemath/gen3.c
===================================================================
--- parigp3.orig/src/basemath/gen3.c	2007-10-11 00:07:00.000000000 +0200
+++ parigp3/src/basemath/gen3.c	2007-10-11 00:46:05.000000000 +0200
@@ -3150,6 +3150,9 @@
     case t_RFRAC:
       av = avma;
       return gerepileupto(av, gdiv(geval(gel(x,1)), geval(gel(x,2))));
+    case t_CLOSURE:
+      if (x[1]) pari_err(impl,"eval on functions with parameters");
+      return closure_evalres(x);
   }
   pari_err(typeer,"geval");
   return NULL; /* not reached */
@@ -3165,7 +3168,7 @@
   {
     case t_INT: case t_REAL: case t_FRAC: case t_FFELT:
     case t_INTMOD: case t_PADIC: case t_QFR: case t_QFI:
-    case t_LIST: case t_STR: case t_VECSMALL:
+    case t_LIST: case t_STR: case t_VECSMALL: case t_CLOSURE:
       return x;
 
     case t_COMPLEX:
Index: parigp3/src/gp/gp_rl.c
===================================================================
--- parigp3.orig/src/gp/gp_rl.c	2007-10-11 00:07:00.000000000 +0200
+++ parigp3/src/gp/gp_rl.c	2007-10-11 00:46:05.000000000 +0200
@@ -288,7 +288,7 @@
   if (end < 0 || rl_line_buffer[end] == '(')
     return 0; /* not from command_generator or already there */
   ep = do_alias(current_ep); /* current_ep set in command_generator */
-  if (EpVALENCE(ep) < EpUSER)
+  if (EpVALENCE(ep) < EpNEW)
   { /* is it a constant masked as a function (e.g Pi)? */
     s = ep->help; if (!s) return 1;
     while (is_keyword_char(*s)) s++;
@@ -296,7 +296,6 @@
   }
   switch(EpVALENCE(ep))
   {
-    case EpUSER:
     case EpINSTALL: return 1;
   }
   return 0;