Add options record to CallFuncList

lib/function.g

@@ -317,11 +317,11 @@ BIND_GLOBAL( "EndlineFunc", ENDLINE_FUNC );
 
 #############################################################################
 ##
-#F  CallFuncList( <func>, <args> )  . . . . . . . . . . . . . call a function
+#F  CallFuncList( <func>, <args>, [<options>] )  . . . . call a function
 ##
 ##  <#GAPDoc Label="CallFuncList">
 ##  <ManSection>
-##  <Oper Name="CallFuncList" Arg='func, args'/>
+##  <Oper Name="CallFuncList" Arg='func, args, [options]'/>
 ##
 ##  <Description>
 ##  returns the result, when calling function <A>func</A> with the arguments
@@ -374,15 +374,31 @@ BIND_GLOBAL( "EndlineFunc", ENDLINE_FUNC );
 ##  gap> PrintDigits( 1, 9, 7, 3, 2 );
 ##  [ 1, 9, 7, 3, 2 ]
 ##  ]]></Example>
+##  The optional <A>options</A> record allows some advanced behaviour to be
+##  configured. The allowable option is given below:
+##  <List>
+##  <Mark><C>wrapreturn</C> (default false)</Mark>
+##  <Item>
+##      If <B>true</B>, then the return value is either a single element list
+##      (if the function returned a value), or an empty list (if no value
+##      was returned). This allows wrapping functions which may, or may not
+##      return a value.
+##  </Item>
+##  <Example><![CDATA[
+##  gap> CallFuncList( x -> x, [1], rec(wrapreturn := true) );
+##  [ 1 ]
+##  gap> CallFuncList( function(x) end, [1], rec(wrapreturn := true) );
+##  [ ]
+##  ]]></Example>
 ##  </Description>
 ##  </ManSection>
 ##  <#/GAPDoc>
 ##
 #T  If objects simulate functions this must become an operation.
 ##
 UNBIND_GLOBAL("CallFuncList"); # was declared 2b defined
-DeclareOperationKernel( "CallFuncList", [IS_OBJECT, IS_LIST], CALL_FUNC_LIST );
 
+BIND_GLOBAL("CallFuncList", CALL_FUNC_LIST);
 
 #############################################################################
 ##

src/calls.c

@@ -1569,19 +1569,65 @@ Obj CallFuncList ( Obj func, Obj list )
 
 }
 
+static UInt wrapreturnRNam;
+
 Obj FuncCALL_FUNC_LIST (
     Obj                 self,
-    Obj                 func,
-    Obj                 list )
+    Obj                 args )
 {
+    int wrap_return = 0;
+    Obj retval = 0;
+    Obj retlist = 0;
+
+    if ( LEN_LIST( args ) < 2 || LEN_LIST( args ) > 3 )
+    {
+        ErrorMayQuit("Usage: CallFuncList(func, args, [option record])",0,0);
+    }
+
   /* check that the second argument is a list                            */
-    while ( ! IS_SMALL_LIST( list ) ) {
-        list = ErrorReturnObj(
-            "CallFuncList: <list> must be a small list",
-            0L, 0L,
-            "you can replace <list> via 'return <list>;'" );
+    if( ! IS_SMALL_LIST( ELMV_LIST( args, 2 ) ) )
+    {
+        ErrorMayQuit("Second argument of CallFuncList must be a small list",0,0);
+    }
+
+    if( LEN_LIST(args) == 3 )
+    {
+        if(! IS_REC( ELMV_LIST( args, 3 )))
+        {
+            ErrorMayQuit("Third argument of CallFuncList must be a record",0,0);
+        }
+
+        if (wrapreturnRNam == 0)
+            wrapreturnRNam = RNamName("wrapreturn");
+
+        if( ISB_REC( ELMV_LIST( args, 3 ), wrapreturnRNam ) &&
+            ELM_REC( ELMV_LIST( args, 3 ), wrapreturnRNam ) != False )
+        {
+            wrap_return = 1;
+        }
+    }
+
+    retval = CallFuncList(ELMV_LIST( args, 1 ), ELMV_LIST( args, 2 ));
+
+    if( wrap_return )
+    {
+        if (retval == 0)
+        {
+            retlist = NEW_PLIST(T_PLIST_EMPTY + IMMUTABLE, 0);
+        }
+        else
+        {
+            retlist = NEW_PLIST(T_PLIST, 1);
+            SET_LEN_PLIST(retlist, 1);
+            SET_ELM_PLIST(retlist, 1, retval);
+            CHANGED_BAG(retlist);
+        }
+        return retlist;
+    }
+    else
+    {
+        return retval;
     }
-    return CallFuncList(func, list);
 }
 
 /****************************************************************************
@@ -2014,9 +2060,6 @@ static StructGVarOper GVarOpers [] = {
     { "CALL_FUNC", -1, "args", &CallFunctionOper,
       FuncCALL_FUNC, "src/calls.c:CALL_FUNC" },
 
-    { "CALL_FUNC_LIST", 2, "func, list", &CallFuncListOper,
-      FuncCALL_FUNC_LIST, "src/calls.c:CALL_FUNC_LIST" },
-
     { "NAME_FUNC", 1, "func", &NAME_FUNC_Oper,
       FuncNAME_FUNC, "src/calls.c:NAME_FUNC" },
 
@@ -2073,6 +2116,10 @@ static StructGVarFunc GVarFuncs [] = {
 
     { "ENDLINE_FUNC", 1, "func", 
       FuncENDLINE_FUNC, "src/calls.c:ENDLINE_FUNC" },
+
+    { "CALL_FUNC_LIST", -1, "func, list [, options]",
+      FuncCALL_FUNC_LIST, "src/calls.c:CALL_FUNC_LIST" },
+
     { 0 }
 
 };

tst/testinstall/callfunc.tst

@@ -0,0 +1,24 @@
+gap> START_TEST("callfunc.tst");
+
+# Union([1]) = 1 :(
+gap> ForAll([0,2..100], x -> [1..x] = CallFuncList(Union, List([1..x], y -> [y]) ) );
+true
+gap> CallFuncList(Group, [ (1,2) ]) = Group((1,2));
+true
+gap> ForAll([0,2..100], x -> [[1..x]] = CallFuncList(Union, List([1..x], y -> [y]), rec(wrapreturn := true) ) );
+true
+gap> CallFuncList(Group, [ (1,2) ], rec(wrapreturn := true)) = [ Group((1,2)) ];
+true
+gap> CallFuncList(Group, [ (1,2) ], rec(wrapreturn := false)) =  Group((1,2)) ;
+true
+gap> CallFuncList(Group, [ (1,2) ]) = Group((1,2)) ;
+true
+gap> l := [];;
+gap> CallFuncList(Add, [ l, 2 ] );
+gap> CallFuncList(Add, [ l, 3, 4] );
+gap> l = [2,,,3];
+true
+gap> swallow := function(x...) end;;
+gap> ForAll([0..100], x -> CallFuncList(swallow, List([1..x], y -> [y]), rec(wrapreturn := true) ) = [] );
+true
+gap> STOP_TEST( "callfunc.tst", 1);