Add BindingsOfClosure helper

lib/function.gi

@@ -114,3 +114,23 @@ function(op)
 end);
 
 InstallMethod( SetNameFunction, [IsFunction and IsInternalRep, IS_STRING], SET_NAME_FUNC );
+
+BIND_GLOBAL( "BindingsOfClosure",
+function(f)
+    local x, r, i;
+    x := ENVI_FUNC(f);
+    if x = fail then return fail; fi;
+    r := rec();
+    while x <> GetBottomLVars() do
+        x := ContentsLVars(x);
+        if x = false then break; fi;
+        for i in [1..Length(x.names)] do
+            # respect the lookup order
+            if not IsBound(r.(x.names[i])) then
+                r.(x.names[i]) := x.values[i];
+            fi;
+        od;
+        x := ENVI_FUNC(x.func);
+    od;
+    return r;
+end);

src/vars.c

@@ -2008,13 +2008,16 @@ static Obj FuncParentLVars(Obj self, Obj lvars)
 
 static Obj FuncContentsLVars(Obj self, Obj lvars)
 {
+  if (!IS_LVARS_OR_HVARS(lvars)) {
+      RequireArgument("ContentsLVars", lvars, "must be an lvars");
+  }
   Obj contents = NEW_PREC(0);
   Obj func = FUNC_LVARS(lvars);
   Obj nams = NAMS_FUNC(func);
   UInt len = (SIZE_BAG(lvars) - 2*sizeof(Obj) - sizeof(UInt))/sizeof(Obj);
   Obj values = NEW_PLIST_IMM(T_PLIST, len);
   if (lvars == STATE(BottomLVars))
-    return False;
+    return Fail;
   AssPRec(contents, RNamName("func"), func);
   AssPRec(contents, RNamName("names"), nams);
   memcpy(1+ADDR_OBJ(values), 3+CONST_ADDR_OBJ(lvars), len*sizeof(Obj));
@@ -2027,6 +2030,13 @@ static Obj FuncContentsLVars(Obj self, Obj lvars)
   return contents;
 }
 
+static Obj FuncENVI_FUNC(Obj self, Obj func)
+{
+    RequireFunction("ENVI_FUNC", func);
+    Obj envi = ENVI_FUNC(func);
+    return (envi && IS_LVARS_OR_HVARS(envi)) ? envi : Fail;
+}
+
 /****************************************************************************
 **
 *F  VarsBeforeCollectBags() . . . . . . . . actions before garbage collection
@@ -2130,6 +2140,7 @@ static StructGVarFunc GVarFuncs [] = {
   GVAR_FUNC(GetBottomLVars, 0, ""),
   GVAR_FUNC(ParentLVars, 1, "lvars"),
   GVAR_FUNC(ContentsLVars, 1, "lvars"),
+  GVAR_FUNC(ENVI_FUNC, 1, "func"),
   { 0, 0, 0, 0, 0 }
 };
 

tst/testbugfix/2017-05-14-lvars.tst

@@ -1,7 +1,7 @@
 gap> GetCurrentLVars();
 <lvars bag>
 gap> ContentsLVars(GetCurrentLVars());
-false
+fail
 gap> f := function() return ContentsLVars(GetCurrentLVars()); end;
 function(  ) ... end
 gap> f();

tst/testinstall/opers/BindingsOfClosure.tst

@@ -0,0 +1,52 @@
+gap> START_TEST("BindingsOfClosure");
+
+# Test bad input
+gap> BindingsOfClosure(0);
+Error, ENVI_FUNC: <func> must be a function (not the integer 0)
+
+# Test some boundary cases
+gap> BindingsOfClosure(IsInt); # category
+fail
+gap> BindingsOfClosure(IsCommutative); # property
+fail
+gap> BindingsOfClosure(DerivedSubgroup); # attribute
+fail
+gap> BindingsOfClosure(ENVI_FUNC); # kernel function
+fail
+gap> BindingsOfClosure(INSTALL_METHOD); # gac compiled function
+rec(  )
+
+# function with no bindings
+gap> makeFun:=n -> x -> x + n;;
+gap> BindingsOfClosure(makeFun);
+rec(  )
+
+# simple binding
+gap> f:=makeFun(42);;
+gap> BindingsOfClosure(f);
+rec( n := 42 )
+gap> Display(f);
+function ( x )
+    return x + n;
+end
+
+# real world example from the library
+gap> f := ApplicableMethod( OrbitsDomain, [ SymmetricGroup(5), [1..5] ] );;
+gap> BindingsOfClosure(f);
+rec( NewAorP := function( name, filter, args... ) ... end, 
+  name := "OrbitsDomain", op := <Attribute "OrbitsDomain">, 
+  reqs := [ <Filter "(IsMagmaWithInverses and IsAssociative)">, 
+      <Category "IsListOrCollection">, <Category "IsList">, 
+      <Category "IsList">, <Category "IsFunction"> ], usetype := false )
+gap> Display(f);
+function ( G, D )
+    if D = MovedPoints( G ) then
+        return op( G );
+    else
+        TryNextMethod();
+    fi;
+    return;
+end
+
+#
+gap> STOP_TEST("BindingsOfClosure");