diff --git a/doc/ref/language.xml b/doc/ref/language.xml index a8fda0090c..7c7c51073e 100644 --- a/doc/ref/language.xml +++ b/doc/ref/language.xml @@ -782,9 +782,11 @@ If it is not, ⪆ signals an error. Next ⪆ checks that the number of actual arguments arg-exprs agrees with the number of formal arguments as given in the function definition. If they do not agree ⪆ signals an error. -An exception is the case when there is exactly one formal argument -with the name arg, in which case any number of actual arguments is -allowed (see  for examples). +An exception is the case when the last formal argument +has the name arg. In this case there must be at least as many +actual arguments as there are formal arguments before the +arg and can be any larger number +(see  for examples).

Now ⪆ allocates for each formal argument and for each formal local (that is, the identifiers in the local declaration) a new variable. @@ -800,8 +802,9 @@ variable corresponding to the second formal argument, and so on. However, ⪆ does not make any guarantee about the order in which the arguments are evaluated. They might be evaluated left to right, right to left, or in any other order, but each argument is evaluated once. An -exception again occurs if the function has only one formal argument with -the name arg. In this case the values of all the actual arguments are +exception again occurs if the last formal argument has +the name arg. In this case the values of all the actual +arguments not assigned to the other formal parameters are stored in a list and this list is assigned to the new variable corresponding to the formal argument arg.

@@ -1732,10 +1735,13 @@ only needs about Log(n) steps. functions arg As noted in Section , -the case where a function is -defined with exactly one formal argument with the name arg, is special. +the case where a functions last formal argument has the name +arg, is special. It provides a way of defining a function with a variable number of -arguments; the values of all the actual arguments are stored in a list +arguments. The values of the actual arguments are computed and the +first ones are assigned to the new variables corresponding to the +formal arguments before the arg if any. The values of all the +remaining actual arguments are stored in a list and this list is assigned to the new variable corresponding to the formal argument arg. There are two typical scenarios for wanting such a possibility: having optional arguments and having any number of @@ -1746,14 +1752,12 @@ The following example shows one way that the function optional argument scenario.

position := function ( arg ) -> local list, obj, pos; -> list := arg[1]; -> obj := arg[2]; -> if 2 = Length(arg) then +gap> position := function ( list, obj, arg ) +> local pos; +> if 0 = Length(arg) then > pos := 0; > else -> pos := arg[3]; +> pos := arg[1]; > fi; > repeat > pos := pos + 1; @@ -1763,7 +1767,7 @@ gap> position := function ( arg ) > until list[pos] = obj; > return pos; > end; -function( arg ) ... end +function( list, obj, arg ) ... end gap> position([1, 4, 2], 4); 2 gap> position([1, 4, 2], 3); @@ -1797,9 +1801,10 @@ The user should compare the above with the ⪆ function which, for example, may take a list argument and optionally an initial element (which zero should the sum of an empty list return?).

-Note that if a function f is defined as above with the single formal +Note that if a function f is defined as above with its last formal argument arg then NumberArgumentsFunction(f) returns --1 (see ). +minus the number of formal arguments (including the arg +(see ).

The argument arg when used as the single argument name of some function f tells ⪆ that when it encounters f that it should form a list diff --git a/lib/function.g b/lib/function.g index 7a81692819..0ab1145031 100644 --- a/lib/function.g +++ b/lib/function.g @@ -190,8 +190,9 @@ DeclareOperationKernel( "SetNameFunction", [IS_OBJECT, IS_STRING], SET_NAME_FUNC ## ## ## returns the number of arguments the function func accepts. +## -1 is returned for all operations. ## For functions that use arg to take a variable number of arguments, -## as well as for operations, -1 is returned. +## the number returned is - the total number of parameters including the arg. ## For attributes, 1 is returned. ##

## NumberArgumentsFunction(Sum); ## -1 +## gap> NumberArgumentsFunction(function(a,arg) return 1; end); +## -2 ## ]]> ## ## @@ -501,16 +504,19 @@ InstallMethod( ViewObj, "for a function", true, [IsFunction], 0, Print("function( "); nams := NAMS_FUNC(func); narg := NARG_FUNC(func); - if nams = fail then - Print( "<",narg," unnamed arguments>" ); - elif narg = -1 then - Print("arg"); - elif narg > 0 then - Print(nams[1]); - for i in [2..narg] do - Print(", ",nams[i]); - od; + if narg < 0 then + narg := -narg; fi; + if narg <> 0 then + if nams = fail then + Print( "<",narg," unnamed arguments>" ); + else + Print(nams[1]); + for i in [2..narg] do + Print(", ",nams[i]); + od; + fi; + fi; Print(" ) ... end"); end); diff --git a/lib/thread1.g b/lib/thread1.g index 3ad03ee454..ff2c978606 100644 --- a/lib/thread1.g +++ b/lib/thread1.g @@ -21,56 +21,56 @@ AtomicRecord := function(r) return r; end; IsShared := function(obj) return true; end; IsLockable := IsShared; -ShareObjWithPrecedence := function(arg, precedence) - return arg; +ShareObjWithPrecedence := function(arg1, precedence) + return arg1; end; -ShareObj := function(arg) - return arg; +ShareObj := function(arg1) + return arg1; end; -ShareUserObj := function(arg) - return arg; +ShareUserObj := function(arg1) + return arg1; end; -ShareLibraryObj := function(arg) - return arg; +ShareLibraryObj := function(arg1) + return arg1; end; -ShareKernelObj := function(arg) - return arg; +ShareKernelObj := function(arg1) + return arg1; end; -ShareInternalObj := function(arg) - return arg; +ShareInternalObj := function(arg1) + return arg1; end; -ShareSpecialObj := function(arg) - return arg; +ShareSpecialObj := function(arg1) + return arg1; end; -ShareSingleObjWithPrecedence := function(arg, precedence) - return arg; +ShareSingleObjWithPrecedence := function(arg1, precedence) + return arg1; end; -ShareSingleObj := function(arg) - return arg; +ShareSingleObj := function(arg1) + return arg1; end; -ShareSingleLibraryObj := function(arg) - return arg; +ShareSingleLibraryObj := function(arg1) + return arg1; end; -ShareSingleKernelObj := function(arg) - return arg; +ShareSingleKernelObj := function(arg1) + return arg1; end; -ShareSingleInternalObj := function(arg) - return arg; +ShareSingleInternalObj := function(arg1) + return arg1; end; -ShareSingleSpecialObj := function(arg) - return arg; +ShareSingleSpecialObj := function(arg1) + return arg1; end; MigrateObj := function(obj,target) @@ -92,11 +92,11 @@ RegionSubObjects := function(x) return x; end; -NewRegionWithPrecedence := function(arg, precedence) +NewRegionWithPrecedence := function(arg1, precedence) return 0; end; -NewRegion := function(arg) +NewRegion := function(arg1) return 0; end; @@ -116,7 +116,7 @@ AutoReadLock := function(obj) return obj; end; -NewAutoReadRegion := function(arg) +NewAutoReadRegion := function(arg1) return 0; end; diff --git a/src/calls.c b/src/calls.c index a45ddbe801..94e52df281 100644 --- a/src/calls.c +++ b/src/calls.c @@ -66,6 +66,7 @@ #include "saveload.h" /* saving and loading */ +#include /**************************************************************************** ** @@ -274,19 +275,38 @@ Obj DoWrap6args ( *F DoFail0args( ) . . . . . . fail a function call with 0 arguments ** -** 'DoWrapargs' accepts the arguments , , and so on, and +** 'DoFailargs' accepts the arguments , , and so on, and ** signals an error, because the function for which they are installed ** expects another number of arguments. 'DoFailargs' are the handlers in ** the other slots of a function. */ + +/* Pull this out to avoid repetition, since it gets a little more complex in + the presence of partially variadic functions */ + +Obj NargError( Obj func, Int actual) { + Int narg = NARG_FUNC(func); + + if (narg >= 0) { + assert(narg != actual); + return ErrorReturnObj( + "Function: number of arguments must be %d (not %d)", + narg, actual, + "you can replace the argument list via 'return ;'" ); + } else { + assert(-narg-1 > actual); + return ErrorReturnObj( + "Function: number of arguments must be at least %d (not %d)", + -narg-1, actual, + "you can replace the argument list via 'return ;'" ); + } +} + Obj DoFail0args ( Obj self ) { Obj argx; /* arguments list (to continue) */ - argx = ErrorReturnObj( - "Function: number of arguments must be %d (not %d)", - (Int)NARG_FUNC( self ), 0L, - "you can replace the argument list via 'return ;'" ); + argx =NargError(self, 0); return FuncCALL_FUNC_LIST( (Obj)0, self, argx ); } @@ -300,10 +320,7 @@ Obj DoFail1args ( Obj arg1 ) { Obj argx; /* arguments list (to continue) */ - argx = ErrorReturnObj( - "Function: number of arguments must be %d (not %d)", - (Int)NARG_FUNC( self ), 1L, - "you can replace the argument list via 'return ;'" ); + argx =NargError(self, 1); return FuncCALL_FUNC_LIST( (Obj)0, self, argx ); } @@ -318,10 +335,7 @@ Obj DoFail2args ( Obj arg2 ) { Obj argx; /* arguments list (to continue) */ - argx = ErrorReturnObj( - "Function: number of arguments must be %d (not %d)", - (Int)NARG_FUNC( self ), 2L, - "you can replace the argument list via 'return ;'" ); + argx =NargError(self, 2); return FuncCALL_FUNC_LIST( (Obj)0, self, argx ); } @@ -337,10 +351,7 @@ Obj DoFail3args ( Obj arg3 ) { Obj argx; /* arguments list (to continue) */ - argx = ErrorReturnObj( - "Function: number of arguments must be %d (not %d)", - (Int)NARG_FUNC( self ), 3L, - "you can replace the argument list via 'return ;'" ); + argx =NargError(self, 3); return FuncCALL_FUNC_LIST( (Obj)0, self, argx ); } @@ -357,10 +368,7 @@ Obj DoFail4args ( Obj arg4 ) { Obj argx; /* arguments list (to continue) */ - argx = ErrorReturnObj( - "Function: number of arguments must be %d (not %d)", - (Int)NARG_FUNC( self ), 4L, - "you can replace the argument list via 'return ;'" ); + argx =NargError(self, 4); return FuncCALL_FUNC_LIST( (Obj)0, self, argx ); } @@ -378,10 +386,7 @@ Obj DoFail5args ( Obj arg5 ) { Obj argx; /* arguments list (to continue) */ - argx = ErrorReturnObj( - "Function: number of arguments must be %d (not %d)", - (Int)NARG_FUNC( self ), 5L, - "you can replace the argument list via 'return ;'" ); + argx =NargError(self, 5); return FuncCALL_FUNC_LIST( (Obj)0, self, argx ); } @@ -400,10 +405,7 @@ Obj DoFail6args ( Obj arg6 ) { Obj argx; /* arguments list (to continue) */ - argx = ErrorReturnObj( - "Function: number of arguments must be %d (not %d)", - (Int)NARG_FUNC( self ), 6L, - "you can replace the argument list via 'return ;'" ); + argx =NargError(self, 6); return FuncCALL_FUNC_LIST( (Obj)0, self, argx ); } @@ -417,10 +419,7 @@ Obj DoFailXargs ( Obj args ) { Obj argx; /* arguments list (to continue) */ - argx = ErrorReturnObj( - "Function: number of arguments must be %d (not %d)", - (Int)NARG_FUNC( self ), LEN_LIST( args ), - "you can replace the argument list via 'return ;'" ); + argx =NargError(self, LEN_LIST(args)); return FuncCALL_FUNC_LIST( (Obj)0, self, argx ); } @@ -1140,7 +1139,7 @@ Obj NewFunctionT ( func = NewBag( type, size ); /* create a function with a fixed number of arguments */ - if ( narg != -1 ) { + if ( narg >= 0 ) { HDLR_FUNC(func,0) = DoFail0args; HDLR_FUNC(func,1) = DoFail1args; HDLR_FUNC(func,2) = DoFail2args; @@ -1154,14 +1153,14 @@ Obj NewFunctionT ( /* create a function with a variable number of arguments */ else { - HDLR_FUNC(func,0) = DoWrap0args; - HDLR_FUNC(func,1) = DoWrap1args; - HDLR_FUNC(func,2) = DoWrap2args; - HDLR_FUNC(func,3) = DoWrap3args; - HDLR_FUNC(func,4) = DoWrap4args; - HDLR_FUNC(func,5) = DoWrap5args; - HDLR_FUNC(func,6) = DoWrap6args; - HDLR_FUNC(func,7) = hdlr; + HDLR_FUNC(func,0) = (narg >= -1) ? DoWrap0args : DoFail0args; + HDLR_FUNC(func,1) = (narg >= -2) ? DoWrap1args : DoFail1args; + HDLR_FUNC(func,2) = (narg >= -3) ? DoWrap2args : DoFail2args; + HDLR_FUNC(func,3) = (narg >= -4) ? DoWrap3args : DoFail3args; + HDLR_FUNC(func,4) = (narg >= -5) ? DoWrap4args : DoFail4args; + HDLR_FUNC(func,5) = (narg >= -6) ? DoWrap5args : DoFail5args; + HDLR_FUNC(func,6) = (narg >= -7) ? DoWrap6args : DoFail6args; + HDLR_FUNC(func,7) = hdlr; } /* enter the arguments and the names */ @@ -1308,7 +1307,9 @@ void PrintFunction ( Pr("%5>function%< ( %>",0L,0L); /* print the arguments */ - narg = (NARG_FUNC(func) == -1 ? 1 : NARG_FUNC(func)); + narg = NARG_FUNC(func); + if (narg < 0) + narg = -narg; for ( i = 1; i <= narg; i++ ) { if ( NAMS_FUNC(func) != 0 ) Pr( "%I", (Int)NAMI_FUNC( func, (Int)i ), 0L ); @@ -1339,7 +1340,7 @@ void PrintFunction ( Pr("<>",0L,0L); } else { - SWITCH_TO_NEW_LVARS( func, NARG_FUNC(func), NLOC_FUNC(func), + SWITCH_TO_NEW_LVARS( func, narg, NLOC_FUNC(func), oldLVars ); PrintStat( FIRST_STAT_CURR_FUNC ); SWITCH_TO_OLD_LVARS( oldLVars ); diff --git a/src/calls.h b/src/calls.h index d547eb233f..8b272a9be1 100644 --- a/src/calls.h +++ b/src/calls.h @@ -127,6 +127,7 @@ typedef Obj (* ObjFunc_6ARGS) (Obj self, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5, #define HDLR_6ARGS(func) ((ObjFunc_6ARGS)HDLR_FUNC(func,6)) #define HDLR_XARGS(func) ((ObjFunc_1ARGS)HDLR_FUNC(func,7)) +extern Obj NargError(Obj func, Int actual); /**************************************************************************** ** diff --git a/src/code.c b/src/code.c index 530e94b651..8082e1685f 100644 --- a/src/code.c +++ b/src/code.c @@ -697,7 +697,7 @@ void CodeFuncExprBegin ( CHANGED_BAG( fexp ); /* switch to this function */ - SWITCH_TO_NEW_LVARS( fexp, (narg != -1 ? narg : 1), nloc, old ); + SWITCH_TO_NEW_LVARS( fexp, (narg >0 ? narg : -narg), nloc, old ); (void) old; /* please picky compilers. */ /* allocate the top level statement sequence */ diff --git a/src/funcs.c b/src/funcs.c index 7a4155c13d..8ac698a695 100644 --- a/src/funcs.c +++ b/src/funcs.c @@ -1145,6 +1145,59 @@ Obj DoExecFuncXargs ( } + +Obj DoPartialUnWrapFunc(Obj func, Obj args) { + + Bag oldLvars; /* old values bag */ + OLD_BRK_CURR_STAT /* old executing statement */ + UInt named; /* number of arguments */ + UInt i; /* loop variable */ + UInt len; + Obj argx; + + + named = ((UInt)-NARG_FUNC(func))-1; + len = LEN_PLIST(args); + + if (named > len) { /* Can happen for > 6 arguments */ + argx = NargError(func, len); + return DoOperation2Args(CallFuncListOper, func, argx); + } + + CHECK_RECURSION_BEFORE + SWITCH_TO_NEW_LVARS( func, named+1, NLOC_FUNC(func), oldLvars ); + + for (i = 1; i <= named; i++) { + ASS_LVAR(i, ELM_PLIST(args,i)); + } + for (i = named+1; i <= len; i++) { + SET_ELM_PLIST(args, i-named, ELM_PLIST(args,i)); + } + SET_LEN_PLIST(args, len-named); + ASS_LVAR(named+1, args); + /* execute the statement sequence */ + REM_BRK_CURR_STAT(); + EXEC_STAT( FIRST_STAT_CURR_FUNC ); + RES_BRK_CURR_STAT(); + + /* remove the link to the calling function, in case this values bag + stays alive due to higher variable reference */ + SET_BRK_CALL_FROM( ((Obj) 0)); + + /* switch back to the old values bag */ + SWITCH_TO_OLD_LVARS( oldLvars ); + + CHECK_RECURSION_AFTER + + /* return the result */ + { + Obj returnObjStat; + returnObjStat = ReturnObjStat; + ReturnObjStat = (Obj)0; + return returnObjStat; + } +} + /**************************************************************************** ** *F MakeFunction() . . . . . . . . . . . . . . . . . . make a function @@ -1166,7 +1219,8 @@ Obj MakeFunction ( else if ( NARG_FUNC(fexp) == 5 ) hdlr = DoExecFunc5args; else if ( NARG_FUNC(fexp) == 6 ) hdlr = DoExecFunc6args; else if ( NARG_FUNC(fexp) >= 7 ) hdlr = DoExecFuncXargs; - else /* NARG_FUNC(fexp) == -1 */ hdlr = DoExecFunc1args; + else if ( NARG_FUNC(fexp) == -1 ) hdlr = DoExecFunc1args; + else /* NARG_FUNC(fexp) < -1 */ hdlr = DoPartialUnWrapFunc; /* make the function */ func = NewFunctionT( T_FUNCTION, SIZE_FUNC, @@ -1441,6 +1495,7 @@ static Int InitKernel ( InitHandlerFunc( DoExecFunc5args, "i5"); InitHandlerFunc( DoExecFunc6args, "i6"); InitHandlerFunc( DoExecFuncXargs, "iX"); + InitHandlerFunc( DoPartialUnWrapFunc, "pUW"); /* install the evaluators and executors */ InstallExecStatFunc( T_PROCCALL_0ARGS , ExecProccall0args); diff --git a/src/read.c b/src/read.c index 8255afbe1e..dafaa37ed1 100644 --- a/src/read.c +++ b/src/read.c @@ -180,7 +180,7 @@ UInt GlobalComesFromEnclosingForLoop (UInt var) ** := a|b|..|z|A|B|..|Z { a|b|..|z|A|B|..|Z|0|..|9|_ } ** ** := -** | '[' ']' +** | '[' ]' ** | '{' '}' ** | '.' ** | '(' [ { ',' } ] [':' [ ]] ')' @@ -1168,6 +1168,8 @@ void ReadFuncExpr ( Match(S_IDENT,"identifier",S_RPAREN|S_LOCAL|STATBEGIN|S_END|follow); } while ( Symbol == S_COMMA ) { + if (narg > 0 && !strcmp(CSTR_STRING(ELM_LIST(nams,narg)),"arg")) + SyntaxError("arg can only be the last argument"); Match( S_COMMA, ",", follow ); lockmode = 0; switch (Symbol) { @@ -1236,8 +1238,10 @@ void ReadFuncExpr ( } /* 'function( arg )' takes a variable number of arguments */ - if ( narg == 1 && ! strcmp( "arg", CSTR_STRING( ELM_LIST(nams,1) ) ) ) - narg = -1; + if (narg >= 1 && ! strcmp( "arg", CSTR_STRING( ELM_LIST(nams, narg) ) ) ) + narg = -narg; + /* if ( narg == 1 && ! strcmp( "arg", CSTR_STRING( ELM_LIST(nams,1) ) ) ) + narg = -1; */ /* remember the current variables in case of an error */ currLVars = CurrLVars;