diff --git a/lib/function.g b/lib/function.g index 8499739664..c05e0c32f1 100644 --- a/lib/function.g +++ b/lib/function.g @@ -317,11 +317,11 @@ BIND_GLOBAL( "EndlineFunc", ENDLINE_FUNC ); ############################################################################# ## -#F CallFuncList( , ) . . . . . . . . . . . . . call a function +#F CallFuncList( , , [] ) . . . . call a function ## ## <#GAPDoc Label="CallFuncList"> ## -## +## ## ## ## returns the result, when calling function func with the arguments @@ -374,6 +374,23 @@ BIND_GLOBAL( "EndlineFunc", ENDLINE_FUNC ); ## gap> PrintDigits( 1, 9, 7, 3, 2 ); ## [ 1, 9, 7, 3, 2 ] ## ]]> +## The optional options record allows some advanced behaviour to be +## configured. The allowable option is given below: +## +## wrapreturn (default false) +## +## If true, 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. +## +## +## CallFuncList( x -> x, [1], rec(wrapreturn := true) ); +## [ 1 ] +## gap> CallFuncList( function(x) end, [1], rec(wrapreturn := true) ); +## [ ] +## ]]> ## ## ## <#/GAPDoc> @@ -381,8 +398,8 @@ BIND_GLOBAL( "EndlineFunc", ENDLINE_FUNC ); #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); ############################################################################# ## diff --git a/src/calls.c b/src/calls.c index 83e0d0ae0c..585f04107a 100644 --- a/src/calls.c +++ b/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: must be a small list", - 0L, 0L, - "you can replace via 'return ;'" ); + 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 } }; diff --git a/tst/testinstall/callfunc.tst b/tst/testinstall/callfunc.tst new file mode 100644 index 0000000000..bfda189b6f --- /dev/null +++ b/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);