Add InstallEarlyMethod

This installs a special "early" function method for a given operation.
An early method is special in that it bypasses method dispatch, and is
always the first method to be called when invoking the operation. This
can be used to avoid method selection overhead for certain special
cases.

Unlike with regular methods, no checks are performed on the arguments.
Hence any operation can have at most one such early method for each
arity (i.e., one early method taking 1 argument, one early method taking
2 arguments, etc.).

If an early method detects that it is not applicable, it can resume
regular method dispatch by invoking `TryNextMethod`.

For example, we install early methods for `First` that deal with
internal lists, for which computing their types (and hence method
selection) can be very expensive.

doc/ref/methsel.xml

@@ -165,6 +165,7 @@ For declaring that a filter is implied by other filters there is
 
 <#Include Label="InstallMethod">
 <#Include Label="InstallOtherMethod">
+<#Include Label="InstallEarlyMethod">
 <#Include Label="InstallMethodWithRandomSource">
 
 </Section>

doc/tut/group.xml

@@ -303,7 +303,7 @@ method for conjugacy classes is slower than just explicit calculation of
 the elements. However, ⪆ is reluctant to construct explicit element
 lists, because for really large groups this direct method is infeasible.
 <P/>
-Note also the function <Ref Func="First" BookName="ref"/>,
+Note also the function <Ref Oper="First" BookName="ref"/>,
 used to find the first element in a list which passes some test.
 <P/>
 In this example,

etc/ctags_for_gap

@@ -5,6 +5,7 @@
 --regex-GAP=/BIND_GLOBAL *\( *"([a-zA-Z0-9_]+)"/\1/v,value/
 --regex-GAP=/InstallMethod *\( *"?([a-zA-Z0-9_]+)"? *,/\1/m,method/
 --regex-GAP=/InstallOtherMethod *\( *"?([a-zA-Z0-9_]+)"? *,/\1/m,method/
+--regex-GAP=/InstallEarlyMethod *\( *"?([a-zA-Z0-9_]+)"? *,/\1/m,method/
 --regex-GAP=/InstallMethodWithRandomSource *\( *"?([a-zA-Z0-9_]+)"? *,/\1/m,method/
 --regex-GAP=/InstallGlobalFunction *\( *"?([a-zA-Z0-9_]+)"? *,/\1/g,gfunction/
 --regex-GAP=/InstallValue *\( *([a-zA-Z0-9_]+) *,/\1/v,value/

lib/list.gd

@@ -961,7 +961,7 @@ DeclareGlobalFunction( "PositionSet" );
 ## 490
 ## ]]></Example>
 ## <P/>
-## <Ref Func="First"/> allows you to extract the first element of a list
+## <Ref Oper="First"/> allows you to extract the first element of a list
 ## that satisfies a certain property.
 ## </Description>
 ## </ManSection>
@@ -2061,25 +2061,26 @@ DeclareGlobalFunction( "IteratorList" );
 ##
 ## <#GAPDoc Label="First">
 ## <ManSection>
-## <Func Name="First" Arg='list[, func]'/>
+## <Oper Name="First" Arg='list[, func]'/>
 ##
 ## <Description>
-## <Ref Func="First"/> returns the first element of the list <A>list</A>
+## <Ref Oper="First"/> returns the first element of the list <A>list</A>
 ## for which the unary function <A>func</A> returns <K>true</K>;
 ## if <A>func</A> is not given, the first element is returned.
 ## <A>list</A> may contain holes.
 ## <A>func</A> must return either <K>true</K> or <K>false</K> for each
 ## element of <A>list</A>, otherwise an error is signalled.
 ## If <A>func</A> returns <K>false</K> for all elements of <A>list</A>
-## then <Ref Func="First"/> returns <K>fail</K>.
+## then <Ref Oper="First"/> returns <K>fail</K>.
 ## <P/>
 ## <Ref Oper="PositionProperty"/> allows you to find the
 ## position of the first element in a list that satisfies a certain
 ## property.
 ## <P/>
-## Developers who wish to adapt this for custom list types need to
-## install suitable methods for the operation <C>FirstOp</C>.
-## <Index Key="FirstOp"><C>FirstOp</C></Index>
+## Before &GAP; 4.12, developers who wished to adapt this for custom
+## list types needed to install suitable methods for the operation
+## <C>FirstOp</C>. This is still possible for backwards compatibility,
+## but <C>FirstOp</C> now is just a synonym for <Ref Oper="First"/>.
 ## <P/>
 ## <Example><![CDATA[
 ## gap> First( [10^7..10^8], IsPrime );
@@ -2095,11 +2096,8 @@ DeclareGlobalFunction( "IteratorList" );
 ## </Description>
 ## </ManSection>
 ## <#/GAPDoc>
-##
-## We catch internal lists by a function to avoid method selection:
-DeclareGlobalFunction( "First" );
-DeclareOperation( "FirstOp", [ IsListOrCollection ] );
-DeclareOperation( "FirstOp", [ IsListOrCollection, IsFunction ] );
+DeclareOperation( "First", [ IsListOrCollection ] );
+DeclareOperation( "First", [ IsListOrCollection, IsFunction ] );
 
 
 #############################################################################

lib/list.gi

@@ -2811,38 +2811,40 @@ InstallMethod( Permuted,
 ##
 #F First( <C>, <func> ) . . . find first element in a list with a property
 ##
-InstallGlobalFunction( First,
- function ( C, func... )
+InstallEarlyMethod( First, 
+ function ( C )
  local tnum, elm;
- if Length( func ) > 1 then
- Error( "too many arguments" );
+ tnum:= TNUM_OBJ( C );
+ if FIRST_LIST_TNUM <= tnum and tnum <= LAST_LIST_TNUM then
+ for elm in C do
+ return elm;
+ od;
+ return fail;
  fi;
+ TryNextMethod();
+ end );
+
+InstallEarlyMethod( First,
+ function ( C, func )
+ local tnum, elm;
  tnum:= TNUM_OBJ( C );
  if FIRST_LIST_TNUM <= tnum and tnum <= LAST_LIST_TNUM then
- if Length( func ) = 0 then
- func := ReturnTrue;
- else
- func := func[1];
- fi;
  for elm in C do
-  if func( elm ) then
-  return elm;
-  fi;
+ if func( elm ) then
+ return elm;
+ fi;
  od;
  return fail;
- elif Length( func ) = 0 then
- return FirstOp( C );
- else
- return FirstOp( C, func[1] );
  fi;
-end );
+ TryNextMethod();
+ end );
 
 
 #############################################################################
 ##
-#M FirstOp( <C>, <func> ) . . find first element in a list with a property
+#M First( <C>, <func> ) . . . . find first element in a list with a property
 ##
-InstallMethod( FirstOp,
+InstallMethod( First,
  "for a list or collection and a function",
  [ IsListOrCollection, IsFunction ],
  function ( C, func )
@@ -2855,7 +2857,7 @@ InstallMethod( FirstOp,
  return fail;
  end );
 
-InstallMethod( FirstOp,
+InstallMethod( First,
  "for a list or collection",
  [ IsListOrCollection ],
  function ( C )

lib/obsolete.gd

@@ -747,3 +747,12 @@ DeclareObsoleteSynonym("FORCE_QUIT_GAP", "ForceQuitGap", 2);
 ##
 ## Not used in any redistributed package (05/2021)
 DeclareObsoleteSynonym( "IsLexicographicallyLess", "<" );
+
+
+#############################################################################
+##
+## We can't use DeclareObsoleteSynonym for FirstOp, because this would break
+## code installing methods for it, and the `fr` package does just that.
+##
+## Still used in fr (06/2021)
+DeclareObsoleteSynonym( "FirstOp", "First" );

lib/oper1.g

@@ -360,6 +360,39 @@ BIND_GLOBAL( "InstallOtherMethod",
  end );
 
 
+#############################################################################
+##
+#F InstallEarlyMethod( <opr>,<method> )
+##
+## <#GAPDoc Label="InstallEarlyMethod">
+## <ManSection>
+## <Func Name="InstallEarlyMethod" Arg="opr,method"/>
+##
+## <Description>
+## installs a special "early" function method <A>method</A> for the
+## operation <A>opr</A>. An early method is special in that it bypasses
+## method dispatch, and is always the first method to be called when
+## invoking the operation. This can be used to avoid method selection
+## overhead for certain special cases.
+## <P/>
+## Unlike with regular methods, no checks are performed on the
+## arguments. Hence any operation can have at most one such early
+## method for each arity (i.e., one early method taking 1 argument, one
+## early method taking 2 arguments, etc.).
+## <P/>
+## If an early method detects that it is not applicable, it can resume
+## regular method dispatch by invoking <Ref Func="TryNextMethod"/>.
+## <P/>
+## For example, we install early methods for <Ref Oper="First"/> that
+## deal with internal lists, for which computing their types (and hence
+## method selection) can be very expensive.
+## </Description>
+## </ManSection>
+## <#/GAPDoc>
+##
+BIND_GLOBAL( "InstallEarlyMethod", INSTALL_EARLY_METHOD );
+
+
 #############################################################################
 ##
 #F INSTALL_METHOD( <arglist>, <check> ) . . . . . . . . . install a method

src/opers.cc

@@ -1812,6 +1812,37 @@ static Int OperationMiss;
 static Int OperationNext;
 #endif
 
+template <Int n>
+static Obj
+CallNArgs(Obj method, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5, Obj a6)
+{
+ switch (n) {
+ case 0:
+ return CALL_0ARGS(method);
+ break;
+ case 1:
+ return CALL_1ARGS(method, a1);
+ break;
+ case 2:
+ return CALL_2ARGS(method, a1, a2);
+ break;
+ case 3:
+ return CALL_3ARGS(method, a1, a2, a3);
+ break;
+ case 4:
+ return CALL_4ARGS(method, a1, a2, a3, a4);
+ break;
+ case 5:
+ return CALL_5ARGS(method, a1, a2, a3, a4, a5);
+ break;
+ case 6:
+ return CALL_6ARGS(method, a1, a2, a3, a4, a5, a6);
+ break;
+ default:
+ GAP_ASSERT(0);
+ }
+ return 0; // redundant, but silences a warning
+}
 
 template <Int n, BOOL verbose, BOOL constructor>
 static Obj
@@ -1827,6 +1858,13 @@ DoOperationNArgs(Obj oper, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5, Obj a6)
  Obj method;
  Obj res;
 
+ Obj earlyMethod = CONST_OPER(oper)->earlyMethod[n];
+ if (earlyMethod) {
+ res = CallNArgs<n>(earlyMethod, a1, a2, a3, a4, a5, a6);
+ if (res != TRY_NEXT_METHOD)
+ return res;
+ }
+
  switch (n) {
  case 6:
  types[5] = TYPE_OBJ_FEO(a6);
@@ -1943,32 +1981,7 @@ DoOperationNArgs(Obj oper, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5, Obj a6)
  }
 
  /* call this method */
- switch (n) {
- case 0:
- res = CALL_0ARGS(method);
- break;
- case 1:
- res = CALL_1ARGS(method, a1);
- break;
- case 2:
- res = CALL_2ARGS(method, a1, a2);
- break;
- case 3:
- res = CALL_3ARGS(method, a1, a2, a3);
- break;
- case 4:
- res = CALL_4ARGS(method, a1, a2, a3, a4);
- break;
- case 5:
- res = CALL_5ARGS(method, a1, a2, a3, a4, a5);
- break;
- case 6:
- res = CALL_6ARGS(method, a1, a2, a3, a4, a5, a6);
- break;
- default:
- res = 0; // redundant, but silences a warning later on
- GAP_ASSERT(0);
- }
+ res = CallNArgs<n>(method, a1, a2, a3, a4, a5, a6);
  } while (res == TRY_NEXT_METHOD);
 
  return res;
@@ -3208,6 +3221,48 @@ static Obj FuncSET_METHODS_OPERATION(Obj self, Obj oper, Obj narg, Obj meths)
 }
 
 
+/****************************************************************************
+**
+*F FuncINSTALL_EARLY_METHOD( <self>, <oper>, <func> ) . install early method
+*/
+static Obj FuncINSTALL_EARLY_METHOD(Obj self, Obj oper, Obj func)
+{
+ RequireOperation(oper);
+ RequireFunction(SELF_NAME, func);
+ if ( IS_OPERATION(func) ) {
+ ErrorQuit("<func> must not be an operation", 0, 0);
+ }
+
+ int n = NARG_FUNC(func);
+ if (n < 0)
+ ErrorQuit("<func> must not be variadic", 0, 0);
+ if (n > MAX_OPER_ARGS)
+ ErrorQuit("<func> must take at most %d arguments", MAX_OPER_ARGS, 0);
+
+ if ( (REREADING != True) &&
+ (CONST_OPER(oper)->earlyMethod[n] != 0) ) {
+ ErrorQuit("early method already installed", 0, 0);
+ }
+
+
+ OPER(oper)->earlyMethod[n] = func;
+ CHANGED_BAG(oper);
+ return 0;
+}
+
+
+/****************************************************************************
+**
+*F FuncEARLY_METHOD( <self>, <oper>, <narg> ) . . . . . . . get early method
+*/
+static Obj FuncEARLY_METHOD(Obj self, Obj oper, Obj narg)
+{
+ RequireOperation(oper);
+ int n = GetBoundedInt(SELF_NAME, narg, 0, MAX_OPER_ARGS);
+ Obj method = CONST_OPER(oper)->earlyMethod[n];
+ return method ? method : Fail;
+}
+
 /****************************************************************************
 **
 *F FuncSETTER_FUNCTION( <self>, <name>, <filter> ) default attribute setter
@@ -3570,6 +3625,8 @@ static StructGVarFunc GVarFuncs [] = {
  GVAR_FUNC_2ARGS(METHODS_OPERATION, oper, narg),
  GVAR_FUNC_3ARGS(SET_METHODS_OPERATION, oper, narg, meths),
  GVAR_FUNC_2ARGS(CHANGED_METHODS_OPERATION, oper, narg),
+ GVAR_FUNC_2ARGS(INSTALL_EARLY_METHOD, oper, func),
+ GVAR_FUNC_2ARGS(EARLY_METHOD, oper, narg),
  GVAR_FUNC_1ARGS(NEW_FILTER, name),
  GVAR_FUNC_1ARGS(NEW_OPERATION, name),
  GVAR_FUNC_1ARGS(NEW_CONSTRUCTOR, name),

src/opers.h

@@ -52,6 +52,9 @@ typedef struct {
  // cache of an operation
  Obj cache[MAX_OPER_ARGS+1];
 
+ //
+ Obj earlyMethod[MAX_OPER_ARGS+1];
+
  // small integer encoding a set of bit flags with information about the
  // operation, see OperExtras below
  //

tst/testinstall/boolean.tst

@@ -79,13 +79,13 @@ gap> IsAssociative and true;
 Error, <oper2> must be a filter (not the value 'true')
 gap> IsAssociative and Center;
 Error, <oper2> must be a filter (not a function)
-gap> IsAssociative and FirstOp;
+gap> IsAssociative and First;
 Error, <oper2> must be a filter (not a function)
 gap> true and IsAssociative;
 Error, <expr> must be 'true' or 'false' (not a function)
 gap> Center and IsAssociative;
 Error, <expr> must be 'true' or 'false' or a filter (not a function)
-gap> FirstOp and IsAssociative;
+gap> First and IsAssociative;
 Error, <expr> must be 'true' or 'false' or a filter (not a function)
 gap> IsAssociative and IsAssociative;
 <Property "IsAssociative">
@@ -111,13 +111,13 @@ gap> function() return IsAssociative and true; end();
 Error, <oper2> must be a filter (not the value 'true')
 gap> function() return IsAssociative and Center; end();
 Error, <oper2> must be a filter (not a function)
-gap> function() return IsAssociative and FirstOp; end();
+gap> function() return IsAssociative and First; end();
 Error, <oper2> must be a filter (not a function)
 gap> function() return true and IsAssociative; end();
 Error, <expr> must be 'true' or 'false' (not a function)
 gap> function() return Center and IsAssociative; end();
 Error, <expr> must be 'true' or 'false' or a filter (not a function)
-gap> function() return FirstOp and IsAssociative; end();
+gap> function() return First and IsAssociative; end();
 Error, <expr> must be 'true' or 'false' or a filter (not a function)
 gap> function() return IsAssociative and IsAssociative; end();
 <Property "IsAssociative">