#############################################################################
##
##  This file is part of GAP, a system for computational discrete algebra.
##  This file's authors include Steve Linton.
##
##  Copyright of GAP belongs to its developers, whose names are too numerous
##  to list here. Please refer to the COPYRIGHT file for details.
##
##  SPDX-License-Identifier: GPL-2.0-or-later
##
##  Functions moved from oper.g, so as to be compiled in the default kernel
##


#############################################################################
##
#F  RunImmediateMethods( <obj>, <flags> )
##
##  applies immediate  methods  for the   object <obj>  for that  the  `true'
##  position in the Boolean list <flags> mean  that the corresponding filters
##  have been discovered recently.
##  So possible consequences of other filters are not checked.
##
RUN_IMMEDIATE_METHODS_RUNS   := 0;
RUN_IMMEDIATE_METHODS_CHECKS := 0;
RUN_IMMEDIATE_METHODS_HITS   := 0;

BIND_GLOBAL( "RunImmediateMethods", function ( obj, flags )

    local   flagspos,   # list of `true' positions in `flags'
            tried,      # list of numbers of methods that have been used
            type,       # type of `obj', used to notice type changes
            j,          # loop over `flagspos'
            imm,        # immediate methods for filter `j'
            i,          # loop over `imm'
            meth,
            res,        # result of an immediate method
            loc,
            newflags;   # newly  found filters

    # Avoid recursive calls from inside a setter,
    # permit complete switch-off of immediate methods,
    # ignore immediate methods for objects which have it turned off.
    if IGNORE_IMMEDIATE_METHODS then return; fi;

    # intersect the flags with those for which immediate methods
    # are installed.
    if IS_SUBSET_FLAGS( IMM_FLAGS, flags ) then return; fi;
    flags := SUB_FLAGS( flags, IMM_FLAGS );

    flagspos := SHALLOW_COPY_OBJ(TRUES_FLAGS(flags));
    tried    := [];
    type     := TYPE_OBJ( obj );
    flags    := type![2];

    RUN_IMMEDIATE_METHODS_RUNS := RUN_IMMEDIATE_METHODS_RUNS + 1;
    if TRACE_IMMEDIATE_METHODS  then
        Print( "#I RunImmediateMethods\n");
    fi;

    # Check the immediate methods for all in `flagspos'.
    # (Note that new information is handled via appending to that list.)
    for j  in flagspos  do

        # Loop over those immediate methods
        # - that require `flags[j]' to be `true',
        # - that are applicable to `obj',
        # - whose result is not yet known to `obj',
        # - that have not yet been tried in this call of
        #   `RunImmediateMethods'.

        if IsBound( IMMEDIATES[j] ) then
#T  the `if' statement can disappear when `IMM_FLAGS' is improved ...
            imm := IMMEDIATES[j];
            for i  in [ 0, SIZE_IMMEDIATE_METHOD_ENTRY .. LEN_LIST(imm)-SIZE_IMMEDIATE_METHOD_ENTRY ]  do

                if        IS_SUBSET_FLAGS( flags, imm[i+4] )
                  and not IS_SUBSET_FLAGS( flags, imm[i+3] )
                  and not imm[i+6] in tried
                then

                    # Call the method, and store that it was used.
                    meth := IMMEDIATE_METHODS[ imm[i+6] ];
                    res := meth( obj );
                    ADD_LIST( tried, imm[i+6] );
                    RUN_IMMEDIATE_METHODS_CHECKS :=
                        RUN_IMMEDIATE_METHODS_CHECKS+1;
                    if TRACE_IMMEDIATE_METHODS  then
                        Print( "#I  immediate: ", NAME_FUNC( imm[i+1] ));
                        if imm[i+7] <> false then
                            Print( ": ", imm[i+7] );
                        fi;
                        Print(" at ", imm[i+8][1], ":", imm[i+8][2], "\n");
                    fi;

                    if res <> TRY_NEXT_METHOD  then

                        # Call the setter, without running immediate methods.
                        IGNORE_IMMEDIATE_METHODS := true;
                        imm[i+2]( obj, res );
                        IGNORE_IMMEDIATE_METHODS := false;
                        RUN_IMMEDIATE_METHODS_HITS :=
                            RUN_IMMEDIATE_METHODS_HITS+1;

                        # If `obj' has noticed the new information,
                        # add the numbers of newly known filters to
                        # `flagspos', in order to call their immediate
                        # methods later.
                        if not IS_IDENTICAL_OBJ( TYPE_OBJ(obj), type ) then

                          type := TYPE_OBJ(obj);

                          newflags := SUB_FLAGS( type![2], IMM_FLAGS );
                          newflags := SUB_FLAGS( newflags, flags );
                          APPEND_LIST_INTR( flagspos,
                                            TRUES_FLAGS( newflags ) );

                          flags := type![2];

                        fi;
                    fi;
                fi;
            od;

        fi;
    od;
end );

#############################################################################
##
#V METHODS_OPERATION_REGION . . . . pseudo lock for updating method lists.
##
## We really just need one arbitrary lock here. Any globally shared
## region will do. This is to prevent concurrent SET_METHODS_OPERATION()
## calls to overwrite each other. Given that these normally only occur
## when loading a package, actual concurrent calls should be vanishingly
## rare.
if IsHPCGAP then
    BIND_GLOBAL("METHODS_OPERATION_REGION", NewSpecialRegion("operation methods"));
fi;

#############################################################################
##
#F  INSTALL_METHOD_FLAGS( <opr>, <info>, <rel>, <flags>, <rank>, <method> ) .
##
BIND_GLOBAL( "INSTALL_METHOD_FLAGS",
    function( opr, info, rel, flags, baserank, method )
    local   methods,  narg,  i,  k,  tmp, replace, match, j, lk, rank;

    if IS_IDENTICAL_OBJ(opr, method) then
        Error("Cannot install an operation as a method for itself");
    fi;

    if IsHPCGAP then
        # TODO: once the GAP compiler supports 'atomic', use that
        # to replace the explicit locking and unlocking here.
        lk := WRITE_LOCK(METHODS_OPERATION_REGION);
    fi;
    # add the number of filters required for each argument
    if IS_FUNCTION(baserank) then
        rank := baserank();
    else
        rank := baserank;
    fi;
    if IS_CONSTRUCTOR(opr) then
        if 0 = LEN_LIST(flags)  then
            Error(NAME_FUNC(opr),": constructors must have at least one argument");
        fi;
        flags[1]:= WITH_IMPS_FLAGS( flags[1] );
        rank := rank - RankFilter( flags[ 1 ] );
    else
        for i  in flags  do
            rank := rank + RankFilter( i );
        od;
    fi;

    # get the methods list
    narg := LEN_LIST( flags );
    methods := METHODS_OPERATION( opr, narg );
    if IsHPCGAP then
        methods := methods{[1..LEN_LIST(methods)]};
    fi;

    # set the name
    if info = false  then
        info := NAME_FUNC(opr);
    else
        k := SHALLOW_COPY_OBJ(NAME_FUNC(opr));
        APPEND_LIST_INTR( k, ": " );
        APPEND_LIST_INTR( k, info );
        info := k;
        CONV_STRING(info);
    fi;

    # find the place to put the new method
    i := 0;
    while i < LEN_LIST(methods) and rank < methods[i+(narg+3)]  do
        i := i + (narg+BASE_SIZE_METHODS_OPER_ENTRY);
    od;

    # Now is a good time to see if the method is already there
    replace := false;
    if REREADING then
        k := i;
        while k < LEN_LIST(methods) and
          rank = methods[k+narg+3] do
            if info = methods[k+narg+4] then

                # ForAll not available
                match := true;
                for j in [1..narg] do
                    match := match and methods[k+j+1] = flags[j];
                od;
                if match then
                    replace := true;
                    i := k;
                    break;
                fi;
            fi;
            k := k+narg+BASE_SIZE_METHODS_OPER_ENTRY;
        od;
    fi;
    # push the other functions back
    if not REREADING or not replace then
        COPY_LIST_ENTRIES(methods, i+1, 1, methods, narg+BASE_SIZE_METHODS_OPER_ENTRY+i+1,1,
                LEN_LIST(methods)-i);
    fi;

    # check the family predicate
    if   rel = true  then
        rel := RETURN_TRUE;
    elif rel = false  then
        rel := RETURN_FALSE;
    elif IS_FUNCTION(rel)  then
        if CHECK_INSTALL_METHOD  then
            tmp := NARG_FUNC(rel);
            if tmp < -narg-1 or (tmp >= 0 and tmp <> narg)   then
                Error(NAME_FUNC(opr),": <famrel> must accept ",
                      narg, " arguments");
            fi;
        fi;
    else
        Error(NAME_FUNC(opr),
              ": <famrel> must be a function, `true', or `false'" );
    fi;

    # check the method
    if   method = true  then
        method := RETURN_TRUE;
    elif method = false  then
        method := RETURN_FALSE;
    elif IS_FUNCTION(method)  then
        if CHECK_INSTALL_METHOD and not IS_OPERATION( method ) then
            tmp := NARG_FUNC(method);
            if tmp < -narg-1 or (tmp >= 0 and tmp <> narg)  then
               Error(NAME_FUNC(opr),": <method> must accept ",
                     narg, " arguments");
            fi;
        fi;
    else
        Error(NAME_FUNC(opr),
              ": <method> must be a function, `true', or `false'" );
    fi;

    # install the family predicate
    methods[i+1] := rel;

    # install the filters
    for k  in [ 1 .. narg ]  do
        methods[i+k+1] := flags[k];
    od;

    # install the method
    methods[i+(narg+2)] := method;
    methods[i+(narg+3)] := rank;
    methods[i+(narg+4)] := IMMUTABLE_COPY_OBJ(info);
    methods[i+(narg+5)] := MakeImmutable([INPUT_FILENAME(), READEVALCOMMAND_LINENUMBER, INPUT_LINENUMBER()]);
    methods[i+(narg+6)] := baserank;

    # flush the cache
    if IsHPCGAP then
        SET_METHODS_OPERATION( opr, narg, MakeReadOnlySingleObj(methods) );
        UNLOCK(lk);
    else
        CHANGED_METHODS_OPERATION( opr, narg );
    fi;
end );


#############################################################################
##
#F  InstallMethod( <opr>[,<info>][,<relation>],<filters>[,<rank>],<method> )
##
##  <#GAPDoc Label="InstallMethod">
##  <ManSection>
##  <Func Name="InstallMethod"
##   Arg="opr[,info][,famp],args-filts[,val],method"/>
##
##  <Description>
##  installs a function method <A>method</A> for the operation <A>opr</A>;
##  <A>args-filts</A> should be a list of requirements for the arguments,
##  each entry being a filter;
##  if supplied <A>info</A> should be a short but informative string
##  that describes for what situation the method is installed,
##  <A>famp</A> should be a function to be applied to the families
##  of the arguments.
##  <A>val</A> should be an integer that measures the priority of the
##  method, or a function of no arguments which should return such an
##  integer and will be called each time method order is being
##  recalculated (see <Ref Func="InstallTrueMethod"/>).
##  <P/>
##  The default values for <A>info</A>, <A>famp</A>, and <A>val</A> are
##  the empty string,
##  the function <Ref Func="ReturnTrue"/>,
##  and the integer zero, respectively.
##  <P/>
##  The exact meaning of the arguments <A>famp</A>, <A>args-filts</A>,
##  and <A>val</A> is explained in
##  Section&nbsp;<Ref Sect="Applicable Methods and Method Selection"/>.
##  <P/>
##  <A>opr</A> expects its methods to require certain filters for their
##  arguments.
##  For example, the argument of a method for the operation
##  <Ref Attr="Zero"/> must be
##  in the category <Ref Filt="IsAdditiveElementWithZero"/>.
##  It is not possible to use <Ref Func="InstallMethod"/> to install
##  a method for which the entries of <A>args-filts</A> do not imply
##  the respective requirements of the operation <A>opr</A>.
##  If one wants to override this restriction,
##  one has to use <Ref Func="InstallOtherMethod"/> instead.
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
BIND_GLOBAL( "InstallMethod",
    function( arg )
    INSTALL_METHOD( arg, true );
    end );


#############################################################################
##
#F  InstallOtherMethod( <opr>[,<info>][,<relation>],<filters>[,<rank>],
#F                      <method> )
##
##  <#GAPDoc Label="InstallOtherMethod">
##  <ManSection>
##  <Func Name="InstallOtherMethod"
##   Arg="opr[,info][,famp],args-filts[,val],method"/>
##
##  <Description>
##  installs a function method <A>method</A> for the operation <A>opr</A>,
##  in the same way as for <Ref Func="InstallMethod"/>,
##  but without the restriction that the number of arguments must match
##  a declaration of <A>opr</A>
##  and without the restriction that <A>args-filts</A> imply the respective
##  requirements of the operation <A>opr</A>.
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
BIND_GLOBAL( "InstallOtherMethod",
    function( arg )
    INSTALL_METHOD( arg, false );
    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.
##  <P/>
##  This can be used to avoid method selection overhead for certain special
##  cases, i.e., as an optimization. Overall, we recommend to use this
##  feature very sparingly, as it is tool with sharp edges: for example, any
##  inputs that are handled by an early method can not be intercepted by a
##  regular method, no matter how high its rank is; this can preclude other
##  kinds of optimizations.
##  <P/>
##  Also, unlike regular methods, no checks are performed on the arguments.
##  Not even the required filters for the operation are tested, so early
##  methods must be careful in validating their inputs.
##  This also means that 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 determines that it is not applicable, it can resume
##  regular method dispatch by invoking <Ref Func="TryNextMethod"/>.
##  <P/>
##  For an example application of early methods, they are used by
##  <Ref Oper="First"/> to deal with internal lists, for which computing
##  the exact type (needed for method selection) can be very expensive.
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
BIND_GLOBAL( "InstallEarlyMethod", INSTALL_EARLY_METHOD );
#TODO; store location info somehow
#MakeImmutable([INPUT_FILENAME(), READEVALCOMMAND_LINENUMBER, INPUT_LINENUMBER()])

#############################################################################
##
#F  INSTALL_METHOD( <arglist>, <check> )  . . . . . . . . .  install a method
##
DeclareGlobalFunction( "EvalString" );

Unbind(INSTALL_METHOD);
BIND_GLOBAL( "INSTALL_METHOD",
    function( arglist, check )
    local len,   # length of `arglist'
          opr,   # the operation
          info,
          pos,
          rel,
          filters,
          info1,
          isstr,
          flags,
          i,
          rank,
          method,
          oreqs,
          req, reqs, match, j, k, imp, notmatch, lk, funcname, alt_rank;

    if IsHPCGAP then
        # TODO: once the GAP compiler supports 'atomic', use that
        # to replace the explicit locking and unlocking here.
        lk := READ_LOCK( OPERATIONS_REGION );
    fi;

    # Check the arguments.
    len:= LEN_LIST( arglist );
    if len < 3 then
      Error( "too few arguments given in <arglist>" );
    fi;

    # The first argument must be an operation.
    opr:= arglist[1];
    if not IS_OPERATION( opr ) then
      Error( "<opr> is not an operation" );
    fi;

    # Check whether an info string is given,
    # or whether the list of argument filters is given by a list of strings.
    if IS_STRING_REP( arglist[2] ) or arglist[2] = false then
      info:= arglist[2];
      pos:= 3;
    else
      info:= false;
      pos:= 2;
    fi;

    # Check whether a family predicate (relation) is given.
    if arglist[ pos ] = true or IS_FUNCTION( arglist[ pos ] ) then
      rel:= arglist[ pos ];
      pos:= pos + 1;
    else
      rel:= true;
    fi;

    # Check the filters list.
    if not IsBound( arglist[ pos ] ) or not IS_LIST( arglist[ pos ] ) then
      Error( "<arglist>[", pos, "] must be a list of filters" );
    fi;
    filters:= arglist[ pos ];
    if GAPInfo.MaxNrArgsMethod < LEN_LIST( filters ) then
      Error( "methods can have at most ", GAPInfo.MaxNrArgsMethod,
             " arguments" );
    fi;

    # If the filters list is given by a list of strings then evaluate them
    # and set `info' if this is not set.
    if 0 < LEN_LIST( filters ) then
      info1:= "[ ";
      isstr:= true;
      for i in [ 1 .. LEN_LIST( filters ) ] do
        if IS_STRING_REP( filters[i] ) then
          APPEND_LIST_INTR( info1, filters[i] );
          APPEND_LIST_INTR( info1, ", " );
          filters[i]:= EvalString( filters[i] );
          if not IS_FUNCTION( filters[i] ) then
            Error( "string does not evaluate to a function" );
          fi;
        else
          isstr:= false;
          break;
        fi;
      od;
      if isstr and info = false then
        info1[ LEN_LIST( info1 ) - 1 ]:= ' ';
        info1[ LEN_LIST( info1 ) ]:= ']';
        info:= info1;
      fi;
    fi;
    pos:= pos + 1;

    # Compute the flags lists for the filters.
    flags:= [];
    for i in filters do
      ADD_LIST( flags, FLAGS_FILTER( i ) );
    od;

    # Check the rank.
    if not IsBound( arglist[ pos ] ) then
      Error( "the method is missing in <arglist>" );
    elif IS_INT( arglist[ pos ] ) or
         (IS_FUNCTION( arglist[ pos ] ) and NARG_FUNC( arglist[ pos ] ) = 0
           and pos < LEN_LIST(arglist)) then
        # An explicit incremental rank is given.
        rank := arglist[ pos ];
        pos := pos+1;
    elif IS_LIST( arglist[ pos ] ) and LEN_LIST( arglist[ pos ] ) <= 2
                                   and LEN_LIST( arglist[ pos ] ) >= 1
                                   and IS_LIST( arglist[ pos ][1] )
                                   and ( LEN_LIST( arglist[ pos ] ) = 1
                                         or IS_INT( arglist[ pos ][2] ) ) then
      # We want to compute the rank of the method w.r.t. a different list
      # of requirements, ignoring the ranks of the given filters.
      # In order to update this value later,
      # using 'RECALCULATE_ALL_METHOD_RANKS',
      # we construct a zero argument function that computes the incremental
      # rank relative to that of the given filters.
      alt_rank:= arglist[ pos ];

      # If this filters list is given by a list of strings then evaluate them.
      for i in [ 1 .. LEN_LIST( alt_rank[1] ) ] do
        if IS_STRING_REP( alt_rank[1][i] ) then
          alt_rank[1][i]:= EvalString( alt_rank[1][i] );
          if not IS_FUNCTION( alt_rank[1][i] ) then
            Error( "string does not evaluate to a function" );
          fi;
        fi;
      od;

      if LEN_LIST( alt_rank ) = 1 then
        rank:= RANK_SHIFT_FUNCTION( filters, alt_rank[1], 0 );
      else
        rank:= RANK_SHIFT_FUNCTION( filters, alt_rank[1], alt_rank[2] );
      fi;
      pos := pos+1;
    else
      rank:= 0;
    fi;

    # Get the method itself.
    if not IsBound( arglist[ pos ] ) then
      Error( "the method is missing in <arglist>" );
    fi;
    method:= arglist[ pos ];

    # For a property, check whether this in fact installs an implication.
    if FLAG1_FILTER( opr ) <> 0
       and ( rel = true or rel = RETURN_TRUE )
       and LEN_LIST( filters ) = 1
       and ( method = true or method = RETURN_TRUE ) then
      Error( NAME_FUNC( opr ), ": use `InstallTrueMethod' for <opr>" );
    fi;

    # Test if `check' is `true'.
    if CHECK_INSTALL_METHOD and check then

      # Signal a warning if the operation is only a wrapper operation.
      if opr in WRAPPER_OPERATIONS then
        INFO_DEBUG( 1,
              "a method is installed for the wrapper operation ",
              NAME_FUNC( opr ), " in ",
              INPUT_FILENAME(), ":", STRING_INT(INPUT_LINENUMBER()),
              "\n",
              "#I  it should probably be installed for (one of) its\n",
              "#I  underlying operation(s)" );
      fi;

      # find the operation
      req := GET_OPER_FLAGS(opr);
      if req = fail  then
        Error( "unknown operation ", NAME_FUNC(opr) );
      fi;

      # do check with implications
      imp := [];
      for i in flags  do
        if not GAPInfo.CommandLineOptions.N then
          ADD_LIST( imp, WITH_HIDDEN_IMPS_FLAGS( i ) );
        else
          ADD_LIST( imp, WITH_IMPS_FLAGS( i ) );
        fi;
      od;

      # Check that the requirements of the method match
      # (at least) one declaration.
      j:= 0;
      match:= false;
      notmatch:=0;
      while j < LEN_LIST( req ) and not match do
        j:= j+1;
        reqs:= req[j];
        if LEN_LIST( reqs ) = LEN_LIST( imp ) then
          match:= true;
          for i  in [ 1 .. LEN_LIST(reqs) ]  do
            if not IS_SUBSET_FLAGS( imp[i], reqs[i] )  then
              match:= false;
              notmatch:=i;
              break;
            fi;
          od;
          if match then
            break;
          fi;
        fi;
      od;

      if not match then

        # If the requirements do not match any of the declarations
        # then something is wrong or `InstallOtherMethod' should be used.
        if notmatch=0 then
          if not GAPInfo.CommandLineOptions.N then
            Error("the number of arguments does not match a declaration of ",
                  NAME_FUNC(opr) );
          else
            Print("InstallMethod warning:  nr of args does not ",
                  "match a declaration of ", NAME_FUNC(opr), "\n" );
          fi;
        else
          if not GAPInfo.CommandLineOptions.N then
            Error("required filters ", NamesFilter(imp[notmatch]),"\nfor ",
                  Ordinal(notmatch)," argument do not match a declaration of ",
                  NAME_FUNC(opr) );
          else
            Print("InstallMethod warning: ",  NAME_FUNC(opr), " at \c",INPUT_FILENAME(),":",
                  INPUT_LINENUMBER()," \c","required filter \c",
                  NAME_FUNC(filters[notmatch]),
                  " for ",Ordinal(notmatch)," argument does not match any ",
                  "declaration\n");
          fi;
        fi;

      else

        oreqs:=reqs;

        # If the requirements match *more than one* declaration
        # then a warning is raised by `INFO_DEBUG'.
        for k in [ j+1 .. LEN_LIST( req ) ] do
          reqs:= req[k];
          if LEN_LIST( reqs ) = LEN_LIST( imp ) then
            match:= true;
            for i  in [ 1 .. LEN_LIST(reqs) ]  do
              if not IS_SUBSET_FLAGS( imp[i], reqs[i] )  then
                match:= false;
                break;
              fi;
            od;
            if match and reqs<>oreqs then
              INFO_DEBUG( 1,
                    "method installed for ", NAME_FUNC(opr),
                    " matches more than one declaration in ",
                    INPUT_FILENAME(), ":", STRING_INT(INPUT_LINENUMBER()));
            fi;
          fi;
        od;

      fi;
    fi;

    if IS_FUNCTION(method) and IsBound(HasNameFunction) and
      IsBound(TYPE_FUNCTION_WITH_NAME) and IsBound(TYPE_OPERATION_WITH_NAME) and
      not VAL_GVAR("HasNameFunction")(method) then
        funcname := SHALLOW_COPY_OBJ(NAME_FUNC(opr));
        APPEND_LIST_INTR(funcname, " ");
        if info <> false then
            APPEND_LIST_INTR(funcname, info);
        else
            APPEND_LIST_INTR(funcname, "method");
        fi;
        SET_NAME_FUNC(method, funcname);
    fi;

    if IS_FUNCTION(rank) and IsBound(HasNameFunction) and
       IsBound(TYPE_FUNCTION_WITH_NAME) and IsBound(TYPE_OPERATION_WITH_NAME) and
       not VAL_GVAR("HasNameFunction")(rank) then
        funcname := "Priority calculation for ";
        APPEND_LIST_INTR(funcname, NAME_FUNC(opr));
        if info <> false then
            APPEND_LIST_INTR(funcname, " ");
            APPEND_LIST_INTR(funcname, info);
        fi;
        SET_NAME_FUNC(rank, funcname);
    fi;

    # Install the method in the operation.
    INSTALL_METHOD_FLAGS( opr, info, rel, flags, rank, method );

    if IsHPCGAP then
        UNLOCK( lk );
    fi;
end );


#############################################################################
##
#M  default attribute getter and setter methods
##
##  The default getter method requires the category part of the attribute's
##  requirements, tests the property getters of the requirements,
##  and --if they are `true' and afterwards stored in the object--
##  calls the attribute operation again.
##  Note that we do *not* install this method for an attribute
##  that requires only categories.
##
##  The default setter method does nothing.
##
LENGTH_SETTER_METHODS_2 := LENGTH_SETTER_METHODS_2 + (BASE_SIZE_METHODS_OPER_ENTRY+2);  # one method

InstallAttributeFunction(
    function ( name, filter, getter, setter, tester, mutflag )

    local flags, rank, cats, props, i, lk;

    if not IS_IDENTICAL_OBJ( filter, IS_OBJECT ) then

        flags := FLAGS_FILTER( filter );
        rank  := 0;
        cats  := IS_OBJECT;
        props := [];
        if IsHPCGAP then
            # TODO: once the GAP compiler supports 'atomic', use that
            # to replace the explicit locking and unlocking here.
            lk := READ_LOCK(FILTER_REGION);
        fi;
        for i in TRUES_FLAGS( flags ) do
            if INFO_FILTERS[i] in FNUM_CATS_AND_REPS  then
                cats := cats and FILTERS[i];
                rank := rank - RankFilter( FILTERS[i] );
            elif INFO_FILTERS[i] in FNUM_PROS  then
                ADD_LIST( props, FILTERS[i] );
            fi;
        od;
        if IsHPCGAP then
            UNLOCK(lk);
        fi;

        # Because the getter function may be called from other
        # threads, <props> needs to be immutable or atomic.
        MakeImmutable(props);

        if 0 < LEN_LIST( props ) then

          # It might be that an object fits to the *first* declaration
          # of the attribute, but that some properties are not yet known.
#T change this, look for *all* declarations of the attribute!
          # If this is the case then we redispatch,
          # otherwise we give up.
          InstallOtherMethod( getter,
              "default method requiring categories and checking properties",
              true,
              [ cats ], rank,
              function ( obj )
              local found, prop;

              found:= false;
              for prop in props do
                if not Tester( prop )( obj ) then
                  found:= true;
                  if not ( prop( obj ) and Tester( prop )( obj ) ) then
                    TryNextMethod();
                  fi;
                fi;
              od;

              if found then
                return getter( obj );
              else
                TryNextMethod();
              fi;
              end );

        fi;
    fi;
    end );

InstallAttributeFunction(
    function ( name, filter, getter, setter, tester, mutflag )
    InstallOtherMethod( setter,
        "default method, does nothing",
        true,
        [ IS_OBJECT, IS_OBJECT ], 0,
            DO_NOTHING_SETTER );
    end );

#############################################################################
##
#F  PositionSortedOddPositions( <list>, <elm> )
##
##  works like PositionSorted, but only looks at odd positions
##  compared with the original algorithm, this translates
##  indices i -> 2*i - 1
##
##  keep function here so it will be compiled
##
BIND_GLOBAL ("PositionSortedOddPositions",
function (list, elm)

    local i, j, k;

    k := LEN_LIST( list ) + 1;
    if k mod 2 = 0 then
        k := k + 1;
    fi;

    i := -1;

    while i + 2 < k do

        # (i < 0 or list[i] < elm) and (k > Length( list ) or list[k] >= elm)

        j := 2 * QUO_INT( i+k+2, 4 ) - 1;
        if list[j] < elm then
            i := j;
        else
            k := j;
        fi;
    od;

    return k;
end);

#############################################################################
##
#F  KeyDependentOperation( <name>, <dom-req>, <key-req>, <key-test> )
##
##  <#GAPDoc Label="KeyDependentOperation">
##  <ManSection>
##  <Func Name="KeyDependentOperation"
##   Arg='name, dom-req, key-req, key-test'/>
##
##  <Description>
##  There are several functions that require as first argument a domain,
##  e.g., a  group, and as second argument something much simpler,
##  e.g., a prime.
##  <Ref Oper="SylowSubgroup"/> is an example.
##  Since its value depends on two arguments, it cannot be an attribute,
##  yet one would like to store the Sylow subgroups once they have been
##  computed.
##  <P/>
##  The idea is to provide an attribute of the group,
##  called <C>ComputedSylowSubgroups</C>,
##  and to store the groups in this list.
##  The name implies that the value of this attribute may change in the
##  course of a &GAP; session,
##  whenever a newly-computed Sylow subgroup is put into the list.
##  Therefore, this is a <E>mutable attribute</E>
##  (see <Ref Sect="Attributes"/>).
##  The list contains primes in each bound odd position and a corresponding
##  Sylow subgroup in the following even position.
##  More precisely, if
##  <C><A>p</A> = ComputedSylowSubgroups( <A>G</A> )[ <A>even</A> - 1 ]</C>
##  then <C>ComputedSylowSubgroups( <A>G</A> )[ <A>even</A> ]</C> holds the
##  value of <C>SylowSubgroup( <A>G</A>, <A>p</A> )</C>.
##  The pairs are sorted in increasing order of <A>p</A>,
##  in particular at most one Sylow <A>p</A> subgroup of <A>G</A> is stored
##  for each prime <A>p</A>.
##  This attribute value is maintained by the function
##  <Ref Oper="SylowSubgroup"/>,
##  which calls the operation <C>SylowSubgroupOp( <A>G</A>, <A>p</A> )</C>
##  to do the real work, if the prime <A>p</A> cannot be found in the list.
##  So methods that do the real work should be installed
##  for <C>SylowSubgroupOp</C>
##  and not for <Ref Oper="SylowSubgroup"/>.
##  <P/>
##  The same mechanism works for other functions as well,
##  e.g., for <Ref Oper="PCore"/>,
##  but also for <Ref Oper="HallSubgroup"/>,
##  where the second argument is not a prime but a set of primes.
##  <P/>
##  <Ref Func="KeyDependentOperation"/> declares the two operations and the
##  attribute as described above,
##  with names <A>name</A>, <A>name</A><C>Op</C>,
##  and <C>Computed</C><A>name</A><C>s</C>, as well as tester and setter operations
##  <C>Has</C><A>name</A> and <C>Set</C><A>name</A>, respectively. Note, however,
##  that the tester is not a filter.
##  <A>dom-req</A> and <A>key-req</A> specify the required filters for the
##  first and second argument of the operation <A>name</A><C>Op</C>,
##  which are needed to create this operation with
##  <Ref Func="DeclareOperation"/>.
##  <A>dom-req</A> is also the required filter for the corresponding
##  attribute <C>Computed</C><A>name</A><C>s</C>.
##  The fourth argument <A>key-test</A> is in general a function to which the
##  second argument
##  <A>info</A> of <C><A>name</A>( <A>D</A>, <A>info</A> )</C> will be
##  passed.
##  This function can perform tests on <A>info</A>,
##  and raise an error if appropriate.
##  <P/>
##  For example, to set up the three objects
##  <Ref Oper="SylowSubgroup"/>,
##  <C>SylowSubgroupOp</C>,
##  <C>ComputedSylowSubgroups</C> together,
##  the declaration file <F>lib/grp.gd</F> contains the following line of
##  code.
##  <Log><![CDATA[
##  KeyDependentOperation( "SylowSubgroup", IsGroup, IsPosInt, "prime" );
##  ]]></Log>
##  In this example, <A>key-test</A> has the value <C>"prime"</C>,
##  which is silently replaced by a function that tests whether its argument
##  is a prime.
##  <P/>
##  <Example><![CDATA[
##  gap> s4 := Group((1,2,3,4),(1,2));;
##  gap> SylowSubgroup( s4, 7 );;  ComputedSylowSubgroups( s4 );
##  [ 7, Group(()) ]
##  gap> SylowSubgroup( s4, 2 );;  ComputedSylowSubgroups( s4 );
##  [ 2, Group([ (3,4), (1,4)(2,3), (1,3)(2,4) ]), 7, Group(()) ]
##  gap> HasSylowSubgroup( s4, 5 );
##  false
##  gap> SetSylowSubgroup( s4, 5, Group(()));; ComputedSylowSubgroups( s4 );
##  [ 2, Group([ (3,4), (1,4)(2,3), (1,3)(2,4) ]), 5, Group(()), 7, Group(()) ]
##  ]]></Example>
##  <P/>
##  <Log><![CDATA[
##  gap> SylowSubgroup( s4, 6 );
##  Error, SylowSubgroup: <p> must be a prime called from
##  <compiled or corrupted call value>  called from
##  <function>( <arguments> ) called from read-eval-loop
##  Entering break read-eval-print loop ...
##  you can 'quit;' to quit to outer loop, or
##  you can 'return;' to continue
##  brk> quit;
##  ]]></Log>
##  <P/>
##  Thus the prime test need not be repeated in the methods for the operation
##  <C>SylowSubgroupOp</C> (which are installed to do
##  the real work).
##  Note that no methods need be installed for
##  <Ref Oper="SylowSubgroup"/> and
##  <C>ComputedSylowSubgroups</C>.
##  If a method is installed with <Ref Func="InstallMethod"/>
##  for a wrapper operation such as
##  <Ref Oper="SylowSubgroup"/> then a warning is signalled
##  provided the <Ref InfoClass="InfoWarning"/> level
##  is at least <C>1</C>.
##  (Use <Ref Func="InstallMethod"/> in order to suppress the
##  warning.)
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
IsPrimeInt := "2b defined";

BIND_GLOBAL( "KeyDependentOperation",
    function( name, domreq, keyreq, keytest )
    local str, oper, attr, lk;

    if keytest = "prime"  then
      keytest := function( key )
          if not IsPrimeInt( key ) then
            Error( name, ": <p> must be a prime" );
          fi;
      end;
    fi;

    # Create the two-argument operation.
    str:= SHALLOW_COPY_OBJ( name );
    APPEND_LIST_INTR( str, "Op" );

    DeclareOperation( str, [ domreq, keyreq ] );
    oper:= VALUE_GLOBAL( str );

    # Create the mutable attribute and install its default method.
    str:= "Computed";
    APPEND_LIST_INTR( str, name );
    APPEND_LIST_INTR( str, "s" );
    DeclareAttribute( str, domreq, "mutable" );
    attr:= VALUE_GLOBAL( str );

    InstallMethod( attr, "default method", true, [ domreq ], 0, D -> [] );

    # Create the wrapper operation that mainly calls the operation.
    DeclareOperation( name, [ domreq, keyreq ] );

    if IsHPCGAP then
        # TODO: once the GAP compiler supports 'atomic', use that
        # to replace the explicit locking and unlocking here.
        lk := WRITE_LOCK( OPERATIONS_REGION );
    fi;
    ADD_LIST( WRAPPER_OPERATIONS, VALUE_GLOBAL( name ) );
    if IsHPCGAP then
        UNLOCK( lk );
    fi;

    # Install the default method that uses the attribute.
    # (Use `InstallOtherMethod' in order to avoid the warning
    # that is signalled whenever a method is installed for a wrapper.)
    InstallOtherMethod( VALUE_GLOBAL( name ),
        "default method",
        true,
        [ domreq, keyreq ], 0,
        function( D, key )
        local known, i, erg;

        keytest( key );
        known:= attr( D );

        i:= PositionSortedOddPositions( known, key );

        if LEN_LIST( known ) < i or known[i] <> key then
            erg := oper( D, key );

            # re-compute position, just in case the call to oper added to known
            # including the possibility that the result is already stored
            # don't use setter because erg isn't necessarily equal to the stored result
            i:= PositionSortedOddPositions( known, key );
            if LEN_LIST( known ) < i or known[i] <> key then
                known{ [ i + 2 .. LEN_LIST( known ) + 2 ] }:=
                    known{ [ i .. LEN_LIST( known ) ] };
                known[  i  ]:= IMMUTABLE_COPY_OBJ(key);
                known[ i+1 ]:= IMMUTABLE_COPY_OBJ(erg);
            fi;
        fi;
        return known[ i+1 ];
        end );

    # define tester function
    str:= "Has";
    APPEND_LIST_INTR( str, name );
    DeclareOperation( str, [ domreq, keyreq ] );
    InstallOtherMethod( VALUE_GLOBAL( str ),
        "default method",
        true,
        [ domreq, keyreq ], 0,
        function( D, key )

            local known, i;

            keytest( key );
            known:= attr( D );
            i:= PositionSortedOddPositions( known, key );
            return i <= LEN_LIST( known ) and known[i] = key;
        end );
    # define tester function
    str:= "Set";
    APPEND_LIST_INTR( str, name );
    DeclareOperation( str, [ domreq, keyreq, IS_OBJECT ] );
    InstallOtherMethod( VALUE_GLOBAL( str ),
        "default method",
        true,
        [ domreq, keyreq, IS_OBJECT ], 0,
        function( D, key, obj )

            local known, i;

            keytest( key );
            known:= attr( D );
            i:= PositionSortedOddPositions( known, key );
            if LEN_LIST( known ) < i or known[i] <> key then
                known{ [ i + 2 .. LEN_LIST( known ) + 2 ] }:=
                known{ [ i .. LEN_LIST( known ) ] };
                known[  i  ]:= IMMUTABLE_COPY_OBJ(key);
                known[ i+1 ]:= IMMUTABLE_COPY_OBJ(obj);
            fi;
        end );
end );


#############################################################################
##
#F  RedispatchOnCondition( <oper>, <fampred>[, <info>], <reqs>, <cond>, <val> )
##
##  <#GAPDoc Label="RedispatchOnCondition">
##  <ManSection>
##  <Func Name="RedispatchOnCondition" Arg="oper[, info], fampred, reqs, cond, val"/>
##
##  <Description>
##  This function installs a method for the operation <A>oper</A> under the
##  conditions <A>fampred</A> and <A>reqs</A> which has absolute value
##  <A>val</A>;
##  that is, the value of the filters <A>reqs</A> is disregarded.
##  <A>cond</A> is a list of filters.
##  If not all the values of properties involved in these filters are already
##  known for actual arguments of the method,
##  they are explicitly tested and if they are fulfilled <E>and</E> stored
##  after this test, the operation is dispatched again.
##  Otherwise the method exits with <Ref Func="TryNextMethod"/>.
##  If supplied, <A>info</A> should be a short but informative string
##  that describes these conditions.
##  This can be used to enforce tests like
##  <Ref Prop="IsFinite"/> in situations when all
##  existing methods require this property.
##  The list <A>cond</A> may have unbound entries in which case
##  the corresponding argument is ignored for further tests.
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
CallFuncList:="2b defined";

BIND_GLOBAL( "RedispatchOnCondition", function(arg)
    local oper,info,fampred,reqs,cond,val,re,i;

    if LEN_LIST(arg) = 5 then
        oper := arg[1];
        info :=" fallback method to test conditions";
        fampred := arg[2];
        reqs := arg[3];
        cond := arg[4];
        val := arg[5];
    elif LEN_LIST(arg) = 6 then
        oper := arg[1];
        info := arg[2];
        fampred := arg[3];
        reqs := arg[4];
        cond := arg[5];
        val := arg[6];
    else
        Error("Usage: RedispatchOnCondition(oper[,info],fampred,reqs,cond,val)");
    fi;

    # force value 0 (unless offset).
    for i in reqs do
      val:=val-RankFilter(i);
    od;

    InstallOtherMethod( oper,
      info,
      fampred,
      reqs, val,
      function( arg )
        re:= false;
        for i in [1..LEN_LIST(reqs)] do
          re:= re or
            (     IsBound( cond[i] )                  # there is a condition,
              and ( not Tester( cond[i] )( arg[i] ) ) # partially unknown,
              and cond[i]( arg[i] )                   # in fact true (here
                                                      # the test is forced),
              and Tester( cond[i] )( arg[i] ) );      # stored after the test
        od;
        if re then
          # at least one property was found out, redispatch
          return CallFuncList(oper,arg);
        else
          TryNextMethod(); # all filters hold already, go away
        fi;
      end);
end);


#############################################################################
##
#M  ViewObj( <obj> )  . . . . . . . . . . . .  default method uses `PrintObj'
##
InstallMethod( ViewObj,
    "default method using `PrintObj'",
    true,
    [ IS_OBJECT ],
    0,
    PRINT_OBJ );

# A dummy version of this function is installed here, the full version
# is defined in attr.gi, after Info-related functionality is set up.
CHECK_REPEATED_ATTRIBUTE_SET := function(obj, name, val) end;