Turn NameFunction into a kernel attribute

Previously, it was an operation that kind of acted like an attribute,
but not quite. Now one may use HasNameFunction, and also provide
custom methods for it for custom function types.

lib/function.g

@@ -75,6 +75,48 @@ DeclareCategoryKernel( "IsOperation",
     IS_OPERATION );
 
 
+#############################################################################
+##
+#O  NameFunction( <func> )  . . . . . . . . . . . . . . .  name of a function
+##
+##  <#GAPDoc Label="NameFunction">
+##  <ManSection>
+##  <Attr Name="NameFunction" Arg='func'/>
+##
+##  <Description>
+##  returns the name of a function. For operations, this is the name used in
+##  their declaration. For functions, this is the variable name they were
+##  first assigned to. (For some internal functions, this might be a name
+##  <E>different</E> from the name that is documented.)
+##  If no such name exists, the string <C>"unknown"</C> is returned.
+##  <P/>
+##  <Example><![CDATA[
+##  gap> NameFunction(SylowSubgroup);
+##  "SylowSubgroup"
+##  gap> Blubberflutsch:=x->x;;
+##  gap> HasNameFunction(Blubberflutsch);
+##  true
+##  gap> NameFunction(Blubberflutsch);
+##  "Blubberflutsch"
+##  gap> a:=Blubberflutsch;;
+##  gap> NameFunction(a);
+##  "Blubberflutsch"
+##  gap> SetNameFunction(a, "f");
+##  gap> NameFunction(a);
+##  "f"
+##  gap> HasNameFunction(x->x);
+##  false
+##  gap> NameFunction(x->x);
+##  "unknown"
+##  ]]></Example>
+##  </Description>
+##  </ManSection>
+##  <#/GAPDoc>
+##
+##
+DeclareAttributeKernel("NameFunction", IS_OBJECT, NAME_FUNC);
+
+
 #############################################################################
 ##
 #V  FunctionsFamily . . . . . . . . . . . . . . . . . . . family of functions
@@ -105,6 +147,8 @@ BIND_GLOBAL( "FunctionsFamily", NewFamily( "FunctionsFamily", IsFunction ) );
 ##
 BIND_GLOBAL( "TYPE_FUNCTION", NewType( FunctionsFamily,
                           IsFunction and IsInternalRep ) );
+BIND_GLOBAL( "TYPE_FUNCTION_WITH_NAME", NewType( FunctionsFamily,
+                          IsFunction and IsInternalRep and HasNameFunction ) );
 
 
 #############################################################################
@@ -122,59 +166,9 @@ BIND_GLOBAL( "TYPE_OPERATION",
     NewType( FunctionsFamily,
              IsFunction and IsOperation and IsInternalRep ) );
 
-
-#############################################################################
-##
-#O  NameFunction( <func> )  . . . . . . . . . . . . . . .  name of a function
-##
-##  <#GAPDoc Label="NameFunction">
-##  <ManSection>
-##  <Oper Name="NameFunction" Arg='func'/>
-##
-##  <Description>
-##  returns the name of a function. For operations, this is the name used in
-##  their declaration. For functions, this is the variable name they were
-##  first assigned to. (For some internal functions, this might be a name
-##  <E>different</E> from the name that is documented.)
-##  If no such name exists, the string <C>"unknown"</C> is returned.
-##  <P/>
-##  <Example><![CDATA[
-##  gap> NameFunction(SylowSubgroup);
-##  "SylowSubgroup"
-##  gap> Blubberflutsch:=x->x;;
-##  gap> NameFunction(Blubberflutsch);
-##  "Blubberflutsch"
-##  gap> a:=Blubberflutsch;;
-##  gap> NameFunction(a);
-##  "Blubberflutsch"
-##  gap> NameFunction(x->x);
-##  "unknown"
-##  gap> NameFunction(NameFunction);
-##  "NameFunction"
-##  ]]></Example>
-##  </Description>
-##  </ManSection>
-##  <#/GAPDoc>
-##
-##
-DeclareOperationKernel("NameFunction", [IS_OBJECT], NAME_FUNC);
-
-
-#############################################################################
-##
-#O  SetNameFunction( <func>, <name> )  . . . . . . . .set  name of a function
-##
-##  <ManSection>
-##  <Oper Name="SetNameFunction" Arg='func, name'/>
-##
-##  <Description>
-##  changes the name of a function. This only changes the name stored in
-##  the function and used (for instance) in profiling. It does not change
-##  any assignments to global variables. 
-##  </Description>
-##  </ManSection>
-##
-DeclareOperationKernel( "SetNameFunction", [IS_OBJECT, IS_STRING], SET_NAME_FUNC );
+BIND_GLOBAL( "TYPE_OPERATION_WITH_NAME",
+    NewType( FunctionsFamily,
+             IsFunction and IsOperation and IsInternalRep and HasNameFunction ) );
 
 
 #############################################################################

lib/function.gi

@@ -112,3 +112,5 @@ InstallMethod( ViewString,
 function(op)
     return VIEW_STRING_OPERATION(op);
 end);
+
+InstallMethod( SetNameFunction, [IsFunction and IsInternalRep, IS_STRING], SET_NAME_FUNC );

src/calls.c

@@ -965,14 +965,18 @@ Obj ArgStringToList(const Char *nams_c) {
 */
 static Obj TYPE_FUNCTION;
 static Obj TYPE_OPERATION;
+static Obj TYPE_FUNCTION_WITH_NAME;
+static Obj TYPE_OPERATION_WITH_NAME;
 
 static Obj TypeFunction(Obj func)
 {
-    return ( IS_OPERATION(func) ? TYPE_OPERATION : TYPE_FUNCTION );
+    if (NAME_FUNC(func) == 0)
+        return (IS_OPERATION(func) ? TYPE_OPERATION : TYPE_FUNCTION);
+    else
+        return (IS_OPERATION(func) ? TYPE_OPERATION_WITH_NAME : TYPE_FUNCTION_WITH_NAME);
 }
 
 
-
 /****************************************************************************
 **
 *F  PrintFunction( <func> )   . . . . . . . . . . . . . . .  print a function
@@ -1224,12 +1228,12 @@ static Obj FuncCALL_FUNC_LIST_WRAP(Obj self, Obj func, Obj list)
 
 /****************************************************************************
 **
-*F  FuncNAME_FUNC( <self>, <func> ) . . . . . . . . . . .  name of a function
+*F  AttrNAME_FUNC( <self>, <func> ) . . . . . . . . . . .  name of a function
 */
-static Obj NAME_FUNC_Oper;
+static Obj NameFuncAttr;
 static Obj SET_NAME_FUNC_Oper;
 
-static Obj FuncNAME_FUNC(Obj self, Obj func)
+static Obj AttrNAME_FUNC(Obj self, Obj func)
 {
     Obj                 name;
 
@@ -1243,7 +1247,7 @@ static Obj FuncNAME_FUNC(Obj self, Obj func)
         return name;
     }
     else {
-        return DoOperation1Args( self, func );
+        return DoAttribute( self, func );
     }
 }
 
@@ -1659,6 +1663,18 @@ static StructGVarFilt GVarFilts [] = {
 };
 
 
+/****************************************************************************
+**
+*V  GVarAttrs . . . . . . . . . . . . . . . . .  list of attributes to export
+*/
+static StructGVarAttr GVarAttrs [] = {
+
+    GVAR_ATTR(NAME_FUNC, "func", &NameFuncAttr),
+    { 0, 0, 0, 0, 0 }
+
+};
+
+
 /****************************************************************************
 **
 *V  GVarOpers . . . . . . . . . . . . . . . . .  list of operations to export
@@ -1667,7 +1683,6 @@ static StructGVarOper GVarOpers [] = {
 
     GVAR_OPER(CALL_FUNC_LIST, 2, "func, list", &CallFuncListOper),
     GVAR_OPER(CALL_FUNC_LIST_WRAP, 2, "func, list", &CallFuncListWrapOper),
-    GVAR_OPER(NAME_FUNC, 1, "func", &NAME_FUNC_Oper),
     GVAR_OPER(SET_NAME_FUNC, 2, "func, name", &SET_NAME_FUNC_Oper),
     GVAR_OPER(NARG_FUNC, 1, "func", &NARG_FUNC_Oper),
     GVAR_OPER(NAMS_FUNC, 1, "func", &NAMS_FUNC_Oper),
@@ -1722,10 +1737,13 @@ static Int InitKernel (
     /* install the type functions                                          */
     ImportGVarFromLibrary( "TYPE_FUNCTION",  &TYPE_FUNCTION  );
     ImportGVarFromLibrary( "TYPE_OPERATION", &TYPE_OPERATION );
+    ImportGVarFromLibrary( "TYPE_FUNCTION_WITH_NAME",  &TYPE_FUNCTION_WITH_NAME  );
+    ImportGVarFromLibrary( "TYPE_OPERATION_WITH_NAME", &TYPE_OPERATION_WITH_NAME );
     TypeObjFuncs[ T_FUNCTION ] = TypeFunction;
 
     /* init filters and functions                                          */
     InitHdlrFiltsFromTable( GVarFilts );
+    InitHdlrAttrsFromTable( GVarAttrs );
     InitHdlrOpersFromTable( GVarOpers );
     InitHdlrFuncsFromTable( GVarFuncs );
 
@@ -1777,10 +1795,11 @@ static Int InitKernel (
 **
 *F  InitLibrary( <module> ) . . . . . . .  initialise library data structures
 */
-static Int InitLibrary (
-    StructInitInfo *    module ){
+static Int InitLibrary(StructInitInfo * module)
+{
     /* init filters and functions                                          */
     InitGVarFiltsFromTable( GVarFilts );
+    InitGVarAttrsFromTable( GVarAttrs );
     InitGVarOpersFromTable( GVarOpers );
     InitGVarFuncsFromTable( GVarFuncs );
 

tst/testinstall/callfunc.tst

@@ -32,19 +32,23 @@ true
 # test overloading CallFuncList
 gap> fam := NewFamily("CustomFunctionFamily");;
 gap> cat := NewCategory("IsCustomFunction", IsFunction);;
-gap> type := NewType(fam, cat and IsPositionalObjectRep);;
+gap> type := NewType(fam, cat and IsAttributeStoringRep);;
 gap> result := fail;;
 gap> InstallMethod(CallFuncList,[cat,IsList],function(func,args) result:=args; return args; end);
-gap> InstallMethod(NameFunction, [cat], f -> f![1]);
+gap> InstallMethod(NameFunction, [cat], f -> "myName");
 gap> InstallMethod(NamesLocalVariablesFunction, [cat], f -> ["arg"]);
 gap> InstallMethod(NumberArgumentsFunction, [cat], f -> -1);
 
 #
-gap> o := Objectify(type,["myName"]);;
+gap> o := Objectify(type, rec());;
 gap> Display(o);
 <object>
+gap> HasNameFunction(o);
+false
 gap> NameFunction(o);
 "myName"
+gap> HasNameFunction(o);
+true
 gap> NamesLocalVariablesFunction(o);
 [ "arg" ]
 gap> NumberArgumentsFunction(o);