CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutSign UpSign In

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.

| Download

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

Views: 418346
#############################################################################
##
##                                               CAP package
##
##  Copyright 2015, Sebastian Gutsche, TU Kaiserslautern
##                  Sebastian Posur,   RWTH Aachen
##
#############################################################################

BindGlobal( "CAP_INTERNAL_CREATE_OTHER_PAIR_FUNC",
  
  function( record )
    local object_name, op_name, with_given_name;
    
    op_name := record.with_given_without_given_name_pair[ 1 ];
    with_given_name := record.with_given_without_given_name_pair[ 2 ];
    
    if record.is_with_given = false then
        
        return function( arg ) return CallFuncList( ValueGlobal( op_name ), arg{[ 1 .. Length( arg ) - 1 ]} ); end;
        
    else
        
        object_name := with_given_name{[ PositionSublist( with_given_name, "WithGiven" ) + 9 .. Length( with_given_name ) ]};
        
        return function( arg )
                    return CallFuncList( ValueGlobal( with_given_name ),
                                         Concatenation( arg, [ CallFuncList( ValueGlobal( object_name ), [ arg[ 1 ] ] ) ] ) ); end;
        
    fi;
    
end );

BindGlobal( "CAP_INTERNAL_ADD_MORPHISM_OR_FAIL",
  
  function( category, morphism_or_fail )
    
    if morphism_or_fail = fail then
        return;
    fi;
    
    AddMorphism( category, morphism_or_fail );
    
end );

InstallGlobalFunction( CapInternalInstallAdd,
  
  function( record )
    local function_name, install_name, add_name, pre_function,
          redirect_function, post_function, filter_list, caching,
          cache_name, nr_arguments, argument_list, add_function;
    
    function_name := record.function_name;
    
    if not IsBound( record.installation_name ) then
        
        install_name := function_name;
        
    else
        
        install_name := record.installation_name;
        
    fi;
    
    add_name := Concatenation( "Add", function_name );
    
    if IsBound( record.pre_function ) then
        pre_function := record.pre_function;
    else
        pre_function := function( arg ) return [ true ]; end;
    fi;
    
    if IsBound( record.redirect_function ) then
        redirect_function := record.redirect_function;
    else
        redirect_function := function( arg ) return [ false ]; end;
    fi;
    
    if IsBound( record.post_function ) then
        post_function := record.post_function;
    else
        post_function := ReturnTrue;
    fi;
    
    filter_list := record.filter_list;
    
    if IsBound( record.cache_name ) then
        caching := true;
        cache_name := record.cache_name;
        nr_arguments := Length( filter_list );
    else
        caching := false;
    fi;
    
    if IsBound( record.argument_list ) then
        argument_list := record.argument_list;
    else
        argument_list := [ 1 .. Length( filter_list ) ];
    fi;
    
    if record.return_type = "object" then
        add_function := AddObject;
    elif record.return_type = "morphism" then
        add_function := AddMorphism;
    elif record.return_type = "twocell" then
        add_function := AddTwoCell;
    elif record.return_type = "morphism_or_fail" then
        add_function := CAP_INTERNAL_ADD_MORPHISM_OR_FAIL;
    else
        add_function := ReturnTrue;
    fi;
    
    InstallMethod( ValueGlobal( add_name ),
                   [ IsCapCategory, IsFunction ],
                   
      function( category, func )
        
        ValueGlobal( add_name )( category, func, -1 );
        
    end );
    
    InstallMethod( ValueGlobal( add_name ),
                   [ IsCapCategory, IsFunction, IsInt ],
                   
      function( category, func, weight )
        
        ValueGlobal( add_name )( category, [ [ func, [ ] ] ], weight );
        
    end );
    
    InstallMethod( ValueGlobal( add_name ),
                   [ IsCapCategory, IsList ],
                   
      function( category, func )
        
        ValueGlobal( add_name )( category, func, -1 );
        
    end );
    
    InstallMethod( ValueGlobal( add_name ),
                   [ IsCapCategory, IsList, IsInt ],
      
      function( category, method_list, weight )
        local install_func, replaced_filter_list, install_method, popper, i, set_primitive, install_remaining_pair, is_derivation,
              install_pair_func, pair_name, pair_func, is_pair_func, pair_func_push, number_of_proposed_arguments, current_function_number,
              current_function_argument_number;
        
        if HasIsFinalized( category ) and IsFinalized( category ) then
            Error( "cannot add methods anymore, category is finalized" );
        fi;
        
        ## If there already is a faster method, do nothing!
        if weight > CurrentOperationWeight( category!.derivations_weight_list, function_name ) then
            return;
        fi;
        
        set_primitive := ValueOption( "SetPrimitive" );
        if set_primitive <> false then
            set_primitive := true;
        fi;
        
        is_derivation := ValueOption( "IsDerivation" );
        if is_derivation <> true then
            is_derivation := false;
        fi;
        
        is_pair_func := ValueOption( "IsPairFunc" );
        if is_pair_func <> true then
            is_pair_func := false;
        fi;
        
        pair_func_push := false;
        if is_pair_func then
            PushOptions( rec( IsPairFunc := false ) );
            pair_func_push := true;
        fi;
        
        if weight = -1 then
            weight := 100;
        fi;
        
        install_pair_func := false;
        
        if not is_derivation and record.with_given_without_given_name_pair <> fail then
            if record.is_with_given = false then
                pair_name := record.with_given_without_given_name_pair[ 2 ];
            else
                pair_name := record.with_given_without_given_name_pair[ 1 ];
            fi;
            
            if CurrentOperationWeight( category!.derivations_weight_list, pair_name ) > weight then
                install_pair_func := true;
                pair_func := CAP_INTERNAL_CREATE_OTHER_PAIR_FUNC( record );
                category!.redirects.( record.with_given_without_given_name_pair[ 1 ] ) := false;
            elif not is_pair_func then
                category!.redirects.( record.with_given_without_given_name_pair[ 1 ] ) := true;
            fi;
            
        fi;
        
        replaced_filter_list := CAP_INTERNAL_REPLACE_STRINGS_WITH_FILTERS( filter_list, category );
        
        if caching = true then
            install_method := InstallMethodWithCache;
            PushOptions( rec( Cache := GET_METHOD_CACHE( category, cache_name, nr_arguments )  ) );
            popper := true;
        else
            install_method := InstallMethod;
            popper := false;
        fi;
        
        ## Nr arguments sanity check
        
        number_of_proposed_arguments := Length( argument_list );
        
        for current_function_number in [ 1 .. Length( method_list ) ] do
            
            current_function_argument_number := NumberArgumentsFunction( method_list[ current_function_number ][ 1 ] );
            
            if current_function_argument_number = -1 then
                continue;
            fi;
            
            if current_function_argument_number <> number_of_proposed_arguments then
                Error( "In ", add_name, ": given function ", String( current_function_number ), " has ", String( current_function_argument_number ),
                       " arguments but should have ", String( number_of_proposed_arguments ) );
            fi;
            
        od;
        
        install_func := function( func_to_install, filter_list )
          local new_filter_list;
            
            new_filter_list := CAP_INTERNAL_MERGE_FILTER_LISTS( replaced_filter_list, filter_list );
            
            install_method( ValueGlobal( install_name ),
                            new_filter_list,
                            
              function( arg )
                local redirect_flag, pre_func_return, redirect_return, result, post_func_arguments;
                
                if not IsBound( category!.redirects.( function_name ) ) or category!.redirects.( function_name ) <> false then
                    redirect_return := CallFuncList( redirect_function, Concatenation( [ category ], arg ) );
                    if redirect_return[ 1 ] = true then
                        if category!.predicate_logic then
                            INSTALL_TODO_FOR_LOGICAL_THEOREMS( record.function_name, arg{ argument_list }, redirect_return[ 2 ], category );
                        fi;
                        return redirect_return[ 2 ];
                    fi;
                fi;
                
                if category!.prefunction_check then
                    
                    pre_func_return := CallFuncList( pre_function, arg );
                    if pre_func_return[ 1 ] = false then
                        Error( Concatenation( "in function \033[1m", record.function_name, 
                            "\033[0m\n       of category \033[1m",
                            Name( category ), ":\033[0m\n\033[1m       ", pre_func_return[ 2 ], "\033[0m\n" ) );
                    fi;
                    
                fi;
                
                result := CallFuncList( func_to_install, arg{ argument_list } );
                
                if category!.predicate_logic then
                    INSTALL_TODO_FOR_LOGICAL_THEOREMS( record.function_name, arg{ argument_list }, result, category );
                fi;
                
                ## Those three commands do not commute
                add_function( category, result );
                Add( arg, result );
                CallFuncList( post_function, Concatenation( [ category ], arg ) );
                
                return result;
                
            end );
            
        end;
        
        for i in method_list do
            install_func( i[ 1 ], i[ 2 ] );
        od;
        
        ## The following commands do NOT commute.
        if popper then
            PopOptions();
        fi;
        
        if pair_func_push then
            PopOptions();
        fi;
        
        if set_primitive then
            AddPrimitiveOperation( category!.derivations_weight_list, function_name, weight );
            
            if not is_pair_func and not ValueOption( "IsFinalDerivation" ) = true then
                category!.primitive_operations.( function_name ) := true;
            fi;
            
            if install_pair_func = true then
                PushOptions( rec( IsPairFunc := true ) );
                CallFuncList( ValueGlobal( Concatenation( "Add", pair_name ) ),[ category, [ [ pair_func, [ ] ] ], weight ] );
                PopOptions();
            fi;
            
        fi;
        
        
        
    end );
    
end );

BindGlobal( "CAP_INTERNAL_CREATE_REDIRECTION",
  
  function( with_given_name, object_name, has_arguments, with_given_arguments, cache_name )
    local return_func, has_name, has_function, object_function, with_given_name_function, is_attribute, attribute_tester;
    
    object_function := ValueGlobal( object_name );
    
    with_given_name_function := ValueGlobal( with_given_name );
    
    is_attribute := Tester( object_function ) <> false;
    
    if not is_attribute then
        
        return function( arg )
            local has_arg_list, has_return, category, cache;
            
            category := arg[ 1 ];
            
            arg := arg{[ 2 .. Length( arg ) ]};
            
            has_arg_list := arg{ has_arguments };
            
            cache := GET_METHOD_CACHE( category, cache_name, Length( has_arguments ) );
            
            has_return := CallFuncList( CacheValue,  [ cache, has_arg_list ] );
            
            if has_return = [ ] then
                
                return [ false ];
                
            fi;
            
            return [ true, CallFuncList( with_given_name_function, Concatenation( arg{ with_given_arguments }, [ has_return[ 1 ] ] ) ) ];
            
        end;
        
    else
        
        attribute_tester := Tester( object_function );
        
        return function( arg )
            local has_arg_list, has_return, category, cache;
            
            category := arg[ 1 ];
            
            arg := arg{[ 2 .. Length( arg ) ]};
            
            has_arg_list := arg{ has_arguments };
            
            if not attribute_tester( has_arg_list ) then
                
                cache := GET_METHOD_CACHE( category, cache_name, Length( has_arguments ) );
                
                has_return := CallFuncList( CacheValue,  [ cache, has_arg_list ] );
                
                if has_return = [ ] then
                    
                    return [ false ];
                    
                fi;
                
            else
                
                has_return := CallFuncList( object_function, has_arg_list );
                
            fi;
            
            return [ true, CallFuncList( with_given_name_function, Concatenation( arg{ with_given_arguments }, [ has_return[ 1 ] ] ) ) ];
            
        end;
        
    fi;
    
end );

BindGlobal( "CAP_INTERNAL_CREATE_POST_FUNCTION",
  
  function( source_range_object, object_function_name, object_function_argument_list, object_call_name, object_cache_name )
    local object_getter, set_object, diagram_name, setter_function, is_attribute, cache_key_length;
    
    if source_range_object = "Source" then
        object_getter := Source;
        set_object := true;
    elif source_range_object = "Range" then
        object_getter := Range;
        set_object := true;
    else
        object_getter := IdFunc;
        set_object := false;
    fi;
    
    diagram_name := Concatenation( object_call_name, "Diagram" );
    setter_function := Setter( ValueGlobal( object_function_name ) );
    is_attribute := setter_function <> false;
    cache_key_length := Length( object_function_argument_list );
    
    if not is_attribute then
    
        return function( arg )
            local result, object, category;
            
            category := arg[ 1 ];
            
            arg := arg{[ 2 .. Length( arg ) ]};
            
            result := arg[ Length( arg ) ];
            Remove( arg );
            object := object_getter( result );
            
            if set_object then
                  SET_VALUE_OF_CATEGORY_CACHE( category, object_cache_name, cache_key_length, arg{ object_function_argument_list }, object );
            fi;
            
        end;
        
    else
        
        return function( arg )
            local result, object, category;
            
            category := arg[ 1 ];
            
            arg := arg{[ 2 .. Length( arg ) ]};
            
            result := arg[ Length( arg ) ];
            Remove( arg );
            object := object_getter( result );
            
            if set_object then
                SET_VALUE_OF_CATEGORY_CACHE( category, object_cache_name, cache_key_length, arg{ object_function_argument_list }, object );
                CallFuncList( setter_function, Concatenation( arg{ object_function_argument_list }, [ object ] ) );
            fi;
            
        end;
        
    fi;
    
end );

BindGlobal( "CAP_INTERNAL_CREATE_NEW_FUNC_WITH_ONE_MORE_ARGUMENT_WITH_RETURN",
  
  function( func )
    
    return function( arg ) return CallFuncList( func, arg{[ 2 .. Length( arg ) ]} ); end;
    
end );

BindGlobal( "CAP_INTERNAL_CREATE_NEW_FUNC_WITH_ONE_MORE_ARGUMENT_WITHOUT_RETURN",
  
  function( func )
    
    return function( arg ) CallFuncList( func, arg{[ 2 .. Length( arg ) ]} ); end;
    
end );

InstallGlobalFunction( CAP_INTERNAL_INSTALL_ADDS_FROM_RECORD,
    
  function( record )
    local recnames, current_recname, current_rec, arg_list, i, with_given_name, with_given_name_length,
          object_name, object_func;
    
    recnames := RecNames( record );
    
    AddOperationsToDerivationGraph( CAP_INTERNAL_DERIVATION_GRAPH, recnames );
    
    for current_recname in recnames do
        
        current_rec := record.( current_recname );
        
        ## keep track of it in method name rec
        CAP_INTERNAL_METHOD_NAME_RECORD.( current_recname ) := current_rec;
        
        if IsBound( current_rec.no_install ) and current_rec.no_install = true then
            
            continue;
            
        fi;
        
        if not IsBound( current_rec.cache_name ) then current_rec.cache_name := current_recname; fi;
        
        if IsBound( current_rec.redirect_function ) then
            
            current_rec.redirect_function := CAP_INTERNAL_CREATE_NEW_FUNC_WITH_ONE_MORE_ARGUMENT_WITH_RETURN( current_rec.redirect_function );
            
        fi;
        
        if IsBound( current_rec.post_function ) then
            
            current_rec.post_function := CAP_INTERNAL_CREATE_NEW_FUNC_WITH_ONE_MORE_ARGUMENT_WITHOUT_RETURN( current_rec.post_function );
            
        fi;
        
        current_rec.function_name := current_recname;
        
        current_rec!.with_given_without_given_name_pair := fail;
        
        if current_rec.filter_list[ 1 ] = IsList then
            
            arg_list := [ 1, Length( current_rec.filter_list ) ];
            
        else
            
            arg_list := [ 1 ];
            
        fi;
        
        current_rec!.universal_object_arg_list := arg_list;
        
        if current_rec!.is_with_given then
            
            current_rec!.with_given_without_given_name_pair := [ current_recname{[ 1 .. PositionSublist( current_recname, "WithGiven" ) - 1 ]}, current_recname ];
            
            current_rec!.universal_object :=
              current_recname{[ PositionSublist( current_recname, "WithGiven" ) + 9 .. Length( current_recname ) ]};
            
            CapInternalInstallAdd( current_rec );
            
            continue;
            
        elif not IsBound( current_rec.universal_type ) then
            
            CapInternalInstallAdd( current_rec );
            
            continue;
            
        fi;
        
        
#         if not IsBound( current_rec.argument_list ) then
#             if Length( current_rec.filter_list ) > 1 and
#               ForAll( [ 1 .. Length( current_rec.filter_list ) - 1 ], i -> current_rec.filter_list[ i ] = IsInt or current_rec.filter_list[ i ] = IsList ) then
#                 current_rec.argument_list := [ 1 .. Length( current_rec.filter_list ) - 1 ];
#             else
#                 current_rec.argument_list := [ 1 .. Length( current_rec.filter_list ) ];
#             fi;
#         fi;
        if not IsBound( current_rec.argument_list ) then
            current_rec.argument_list := [ 1 .. Length( current_rec.filter_list ) ];
        fi;
        
        if IsBound( current_rec.universal_type ) and not IsBound( current_rec.universal_object_position ) then
            
            if not IsBound( current_rec.post_function ) then
                current_rec.post_function := CAP_INTERNAL_CREATE_POST_FUNCTION( "id", current_rec.installation_name, arg_list, current_recname, "irrelevant" ); ##Please note that the third argument is not used
            fi;
            
            CapInternalInstallAdd( current_rec );
            
            continue;
            
        fi;
        
        if IsBound( current_rec.universal_object_position ) then
            
            ## find with given name
            
            ## FIXME: If the redirect function is already bound, then this part is superfluous
            
            with_given_name := Concatenation( current_recname, "WithGiven" );
            
            with_given_name_length := Length( with_given_name );
            
            for i in recnames do
                
                if PositionSublist( i, with_given_name ) <> fail then
                    
                    with_given_name := i;
                    
                    break;
                    
                fi;
                
            od;
            
            if Length( with_given_name ) = with_given_name_length then
                
                Error( Concatenation( "Name not found: ", with_given_name ) );
                
            fi;
            
            current_rec!.with_given_without_given_name_pair := [ current_recname, with_given_name ];
            
            object_name := with_given_name{[ with_given_name_length + 1 .. Length( with_given_name ) ]};
            
            object_func := record.( object_name ).installation_name;
            
            if not IsBound( current_rec.redirect_function ) then
              current_rec.redirect_function := CAP_INTERNAL_CREATE_REDIRECTION( with_given_name, object_func, arg_list, current_rec.argument_list, object_func );
            fi;
            
            if not IsBound( current_rec.post_function ) then
                current_rec.post_function := CAP_INTERNAL_CREATE_POST_FUNCTION( current_rec.universal_object_position, object_func, arg_list, object_name, object_func );
            fi;
            
            CapInternalInstallAdd( current_rec );
            
            continue;
            
        fi;
        
    od;
    
end );

CAP_INTERNAL_INSTALL_ADDS_FROM_RECORD( CAP_INTERNAL_METHOD_NAME_RECORD );

## These methods overwrite the automatically generated methods.
## The users do not have to give the category as an argument
## to their functions, but within derivations, the category has
## to be an argument (see any derivation of ZeroObject in DerivedMethods.gi)
##
InstallMethod( AddZeroObject,
               [ IsCapCategory, IsFunction, IsInt ],
               
  function( category, func, weight )
    local wrapped_func;
    
    wrapped_func := function( cat ) return func(); end;
    
    AddZeroObject( category, [ [ wrapped_func, [ ] ] ], weight );
    
end );

##
InstallMethod( AddInitialObject,
               [ IsCapCategory, IsFunction, IsInt ],
               
  function( category, func, weight )
    local wrapped_func;
    
    wrapped_func := function( cat ) return func(); end;
    
    AddInitialObject( category, [ [ wrapped_func, [ ] ] ], weight );
    
end );

##
InstallMethod( AddTerminalObject,
               [ IsCapCategory, IsFunction, IsInt ],
               
  function( category, func, weight )
    local wrapped_func;
    
    wrapped_func := function( cat ) return func(); end;
    
    AddTerminalObject( category, [ [ wrapped_func, [ ] ] ], weight );
    
end );