diff --git a/hpcgap/lib/oper.g b/hpcgap/lib/oper.g index d678bb77ff..985dde8483 100644 --- a/hpcgap/lib/oper.g +++ b/hpcgap/lib/oper.g @@ -1095,7 +1095,7 @@ end ); ############################################################################# ## -#F NewAttribute( , [, "mutable"][, ] ) . . new attribute +#F NewAttribute( , [, ][, ] ) . . new attribute ## ## <#GAPDoc Label="NewAttribute"> ## @@ -1117,16 +1117,23 @@ end ); ## applicable to a character table, ## which is neither a list nor a collection. ##

-## If the optional third argument is given then there are two possibilities. -## Either it is an integer rank, -## then the attribute tester has this incremental rank -## (see ). -## Or it is the string "mutable", -## then the values of the attribute shall be mutable; -## more precisely, when a value of such a mutable attribute is set -## then this value itself is stored, not an immutable copy of it. -## (So it is the user's responsibility to set an object that is in fact -## mutable.) +## For the optional third and fourth arguments, there are the following +## possibilities. +## +## The integer argument rank causes the attribute tester to have +## this incremental rank (see ), +## +## If the argument mutable is the string "mutable" or +## the boolean true, then the values of the attribute are mutable. +## +## If the argument mutable is the boolean false, then +## the values of the attribute are immutable. +## +## +##

+## When a value of such mutable attribute is set +## then this value itself is stored, not an immutable copy of it, +## and it is the user's responsibility to set an object that is mutable. ## This is useful for an attribute whose value is some partial information ## that may be completed later. ## For example, there is an attribute ComputedSylowSubgroups @@ -1139,7 +1146,7 @@ end ); ## ## ##

-## If no third argument is given then the rank of the tester is 1. +## If no argument for rank is given, then the rank of the tester is 1. ##

## Each method for the new attribute that does not require ## its argument to lie in filter must be installed using @@ -1179,21 +1186,36 @@ BIND_GLOBAL( "OPER_SetupAttribute", function(getter, flags, mutflag, filter, ran return; end); +# construct getter, setter and tester +BIND_GLOBAL( "NewAttribute", function ( name, filter, args... ) + local flags, mutflag, getter, rank; -BIND_GLOBAL( "NewAttribute", function ( arg ) - local name, filter, flags, mutflag, getter, rank; + if not IS_STRING( name ) then + Error( " must be a string"); + fi; - # construct getter, setter and tester - name := arg[1]; - filter := arg[2]; + if not IsFilter( filter ) then + Error( " must be a filter" ); + fi; - if not IS_OPERATION( filter ) then - Error( " must be an operation" ); + rank := 1; + mutflag := false; + if LEN_LIST(args) = 0 then + # this is fine, but does nothing + elif LEN_LIST(args) = 1 and args[1] in [ "mutable", true, false ] then + mutflag := args[1] in [ "mutable", true]; + elif LEN_LIST(args) = 1 and IS_INT(args[1]) then + rank := args[1]; + elif LEN_LIST(args) = 2 + and args[1] in [ "mutable", true, false ] + and IS_INT(args[2]) then + mutflag := args[1] in [ "mutable", true ]; + rank := args[2]; + else + Error("Usage: NewAttribute( , [, ][, ] )"); fi; - flags:= FLAGS_FILTER( filter ); - # the mutability flags is the third one (which can also be the rank) - mutflag := LEN_LIST(arg) = 3 and arg[3] = "mutable"; + flags:= FLAGS_FILTER( filter ); # construct a new attribute if mutflag then @@ -1201,11 +1223,6 @@ BIND_GLOBAL( "NewAttribute", function ( arg ) else getter := NEW_ATTRIBUTE( name ); fi; - if LEN_LIST(arg) = 3 and IS_INT(arg[3]) then - rank := arg[3]; - else - rank := 1; - fi; STORE_OPER_FLAGS(getter, [ flags ]); atomic FILTER_REGION do @@ -1237,102 +1254,103 @@ end ); ## <#/GAPDoc> ## -BIND_GLOBAL( "DeclareAttribute", function ( arg ) - local name, gvar, req, reqs, filter, setter, tester, - attr, nname, mutflag, flags, rank; +BIND_GLOBAL( "ConvertToAttribute", +function(name, op, filter, rank, mutable) + local req, reqs, flags, nname; + # `op' is not an attribute (tester) and not a property (tester), + # or `op' is a filter; in any case, `op' is not an attribute. - name:= arg[1]; + # if `op' has no one argument declarations we can turn it into + # an attribute + req := GET_OPER_FLAGS(op); + for reqs in req do + if LENGTH(reqs) = 1 then + Error( "operation `", name, "' has been declared as a one ", + "argument Operation and cannot also be an Attribute"); + fi; + od; - if ISB_GVAR( name ) then + flags := FLAGS_FILTER(filter); + STORE_OPER_FLAGS( op, [ FLAGS_FILTER( filter ) ] ); - atomic FILTER_REGION do - # The variable exists already. - gvar:= VALUE_GLOBAL( name ); + # kernel magic for the conversion + if mutable then + OPER_TO_MUTABLE_ATTRIBUTE(op); + else + OPER_TO_ATTRIBUTE(op); + fi; - # Check that the variable is in fact bound to an operation. - if not IS_OPERATION( gvar ) then - Error( "variable `", name, "' is not bound to an operation" ); - fi; + OPER_SetupAttribute(op, flags, mutable, filter, rank, name); - # The attribute has already been declared. - # If it was not created as an attribute - # then we may be able to convert it - if FLAG2_FILTER( gvar ) = 0 or IS_ELEMENTARY_FILTER(gvar) then + # and make the remaining assignments + nname:= "Set"; APPEND_LIST_INTR( nname, name ); + BIND_GLOBAL( nname, SETTER_FILTER(op) ); + nname:= "Has"; APPEND_LIST_INTR( nname, name ); + BIND_GLOBAL( nname, TESTER_FILTER(op) ); +end); - # `gvar' is not an attribute (tester) and not a property (tester), - # or `gvar' is a filter; - # in any case, `gvar' is not an attribute. - - # if `gvar' has no one argument declarations we can turn it into - # an attribute - req := GET_OPER_FLAGS(gvar); - for reqs in req do - if LENGTH(reqs) = 1 then - Error( "operation `", name, "' has been declared as a one ", - "argument Operation and cannot also be an Attribute"); - fi; - od; - mutflag := LEN_LIST(arg) = 3 and arg[3] = "mutable"; - - # add the new set of requirements - filter:= arg[2]; - if not IS_OPERATION( filter ) then - Error( " must be an operation" ); - fi; - - flags := FLAGS_FILTER(filter); - STORE_OPER_FLAGS( gvar, [ FLAGS_FILTER( filter ) ] ); - - # kernel magic for the conversion - if mutflag then - OPER_TO_MUTABLE_ATTRIBUTE(gvar); - else - OPER_TO_ATTRIBUTE(gvar); - fi; - - # now we have to adjust the data structures - - if LEN_LIST(arg) = 3 and IS_INT(arg[3]) then - rank := arg[3]; - else - rank := 1; - fi; - OPER_SetupAttribute(gvar, flags, mutflag, filter, rank, name); - # and make the remaining assignments - nname:= "Set"; APPEND_LIST_INTR( nname, name ); - BIND_GLOBAL( nname, SETTER_FILTER(gvar) ); - nname:= "Has"; APPEND_LIST_INTR( nname, name ); - BIND_GLOBAL( nname, TESTER_FILTER(gvar) ); - - return; - - - fi; +BIND_GLOBAL( "DeclareAttribute", function ( name, filter, args... ) + local gvar, req, reqs, setter, tester, + attr, nname, mutflag, flags, rank; - # Add the new requirements. - filter:= arg[2]; - if not IS_OPERATION( filter ) then - Error( " must be an operation" ); - fi; - STORE_OPER_FLAGS( gvar, [ FLAGS_FILTER( filter ) ] ); + if not IS_STRING( name ) then + Error( " must be a string"); + fi; - # also set the extended range for the setter - req := GET_OPER_FLAGS( Setter(gvar) ); - STORE_OPER_FLAGS( Setter(gvar), [ FLAGS_FILTER( filter), req[1][2] ] ); + if not IsFilter( filter ) then + Error( " must be a filter" ); + fi; - od; + rank := 1; + mutflag := false; + if LEN_LIST(args) = 0 then + # this is fine, but does nothing + elif LEN_LIST(args) = 1 and args[1] in [ "mutable", true, false ] then + mutflag := args[1] in [ "mutable", true]; + elif LEN_LIST(args) = 1 and IS_INT(args[1]) then + rank := args[1]; + elif LEN_LIST(args) = 2 + and args[1] in [ "mutable", true, false ] + and IS_INT(args[2]) then + mutflag := args[1] in [ "mutable", true ]; + rank := args[2]; else + Error("Usage: DeclareAttribute( , [, ][, ] )"); + fi; - # The attribute is new. - attr:= CALL_FUNC_LIST( NewAttribute, arg ); - BIND_GLOBAL( name, attr ); - - # and make the remaining assignments - nname:= "Set"; APPEND_LIST_INTR( nname, name ); - BIND_GLOBAL( nname, SETTER_FILTER(attr) ); - nname:= "Has"; APPEND_LIST_INTR( nname, name ); - BIND_GLOBAL( nname, TESTER_FILTER( attr ) ); + if ISB_GVAR( name ) then + atomic FILTER_REGION do + # The variable exists already. + gvar := VALUE_GLOBAL( name ); + # Check that the variable is in fact bound to an operation. + if not IS_OPERATION( gvar ) then + Error( "variable `", name, "' is not bound to an operation" ); + fi; + + # The attribute has already been declared. + # If it was not created as an attribute + # then we may be able to convert it + if FLAG2_FILTER( gvar ) = 0 or IS_ELEMENTARY_FILTER(gvar) then + ConvertToAttribute(name, gvar, filter, rank, mutflag); + else + STORE_OPER_FLAGS( gvar, [ FLAGS_FILTER( filter ) ] ); + + # also set the extended range for the setter + req := GET_OPER_FLAGS( Setter(gvar) ); + STORE_OPER_FLAGS( Setter(gvar), [ FLAGS_FILTER( filter), req[1][2] ] ); + fi; + od; + else + # The attribute is new. + attr := NewAttribute(name, filter, mutflag, rank); + BIND_GLOBAL( name, attr ); + + # and make the remaining assignments + nname := "Set"; APPEND_LIST_INTR( nname, name ); + BIND_GLOBAL( nname, SETTER_FILTER(attr) ); + nname := "Has"; APPEND_LIST_INTR( nname, name ); + BIND_GLOBAL( nname, TESTER_FILTER( attr ) ); fi; end ); diff --git a/lib/oper.g b/lib/oper.g index 709df0f3c9..e6443f8d0e 100644 --- a/lib/oper.g +++ b/lib/oper.g @@ -1064,7 +1064,7 @@ end ); ############################################################################# ## -#F NewAttribute( , [, "mutable"][, ] ) . . new attribute +#F NewAttribute( , [, ][, ] ) . . new attribute ## ## <#GAPDoc Label="NewAttribute"> ## @@ -1086,16 +1086,23 @@ end ); ## applicable to a character table, ## which is neither a list nor a collection. ##

-## If the optional third argument is given then there are two possibilities. -## Either it is an integer rank, -## then the attribute tester has this incremental rank -## (see ). -## Or it is the string "mutable", -## then the values of the attribute shall be mutable; -## more precisely, when a value of such a mutable attribute is set -## then this value itself is stored, not an immutable copy of it. -## (So it is the user's responsibility to set an object that is in fact -## mutable.) +## For the optional third and fourth arguments, there are the following +## possibilities. +## +## The integer argument rank causes the attribute tester to have +## this incremental rank (see ), +## +## If the argument mutable is the string "mutable" or +## the boolean true, then the values of the attribute are mutable. +## +## If the argument mutable is the boolean false, then +## the values of the attribute are immutable. +## +## +##

+## When a value of such mutable attribute is set +## then this value itself is stored, not an immutable copy of it, +## and it is the user's responsibility to set an object that is mutable. ## This is useful for an attribute whose value is some partial information ## that may be completed later. ## For example, there is an attribute ComputedSylowSubgroups @@ -1108,7 +1115,7 @@ end ); ## ## ##

-## If no third argument is given then the rank of the tester is 1. +## If no argument for rank is given, then the rank of the tester is 1. ##

## Each method for the new attribute that does not require ## its argument to lie in filter must be installed using @@ -1148,21 +1155,36 @@ BIND_GLOBAL( "OPER_SetupAttribute", function(getter, flags, mutflag, filter, ran return; end); +# construct getter, setter and tester +BIND_GLOBAL( "NewAttribute", function ( name, filter, args... ) + local flags, mutflag, getter, rank; -BIND_GLOBAL( "NewAttribute", function ( arg ) - local name, filter, flags, mutflag, getter, rank; + if not IS_STRING( name ) then + Error( " must be a string"); + fi; - # construct getter, setter and tester - name := arg[1]; - filter := arg[2]; + if not IsFilter( filter ) then + Error( " must be a filter" ); + fi; - if not IS_OPERATION( filter ) then - Error( " must be an operation" ); + rank := 1; + mutflag := false; + if LEN_LIST(args) = 0 then + # this is fine, but does nothing + elif LEN_LIST(args) = 1 and args[1] in [ "mutable", true, false ] then + mutflag := args[1] in [ "mutable", true]; + elif LEN_LIST(args) = 1 and IS_INT(args[1]) then + rank := args[1]; + elif LEN_LIST(args) = 2 + and args[1] in [ "mutable", true, false ] + and IS_INT(args[2]) then + mutflag := args[1] in [ "mutable", true ]; + rank := args[2]; + else + Error("Usage: NewAttribute( , [, ][, ] )"); fi; - flags:= FLAGS_FILTER( filter ); - # the mutability flags is the third one (which can also be the rank) - mutflag := LEN_LIST(arg) = 3 and arg[3] = "mutable"; + flags:= FLAGS_FILTER( filter ); # construct a new attribute if mutflag then @@ -1170,11 +1192,6 @@ BIND_GLOBAL( "NewAttribute", function ( arg ) else getter := NEW_ATTRIBUTE( name ); fi; - if LEN_LIST(arg) = 3 and IS_INT(arg[3]) then - rank := arg[3]; - else - rank := 1; - fi; STORE_OPER_FLAGS(getter, [ flags ]); OPER_SetupAttribute(getter, flags, mutflag, filter, rank, name); @@ -1204,100 +1221,101 @@ end ); ## <#/GAPDoc> ## -BIND_GLOBAL( "DeclareAttribute", function ( arg ) - local name, gvar, req, reqs, filter, setter, tester, - attr, nname, mutflag, flags, rank; +BIND_GLOBAL( "ConvertToAttribute", +function(name, op, filter, rank, mutable) + local req, reqs, flags, nname; + # `op' is not an attribute (tester) and not a property (tester), + # or `op' is a filter; in any case, `op' is not an attribute. - name:= arg[1]; + # if `op' has no one argument declarations we can turn it into + # an attribute + req := GET_OPER_FLAGS(op); + for reqs in req do + if LENGTH(reqs) = 1 then + Error( "operation `", name, "' has been declared as a one ", + "argument Operation and cannot also be an Attribute"); + fi; + od; - if ISB_GVAR( name ) then + flags := FLAGS_FILTER(filter); + STORE_OPER_FLAGS( op, [ FLAGS_FILTER( filter ) ] ); - # The variable exists already. - gvar:= VALUE_GLOBAL( name ); + # kernel magic for the conversion + if mutable then + OPER_TO_MUTABLE_ATTRIBUTE(op); + else + OPER_TO_ATTRIBUTE(op); + fi; - # Check that the variable is in fact bound to an operation. - if not IS_OPERATION( gvar ) then - Error( "variable `", name, "' is not bound to an operation" ); - fi; + OPER_SetupAttribute(op, flags, mutable, filter, rank, name); - # The attribute has already been declared. - # If it was not created as an attribute - # then we may be able to convert it - if FLAG2_FILTER( gvar ) = 0 or IS_ELEMENTARY_FILTER(gvar) then + # and make the remaining assignments + nname:= "Set"; APPEND_LIST_INTR( nname, name ); + BIND_GLOBAL( nname, SETTER_FILTER(op) ); + nname:= "Has"; APPEND_LIST_INTR( nname, name ); + BIND_GLOBAL( nname, TESTER_FILTER(op) ); +end); - # `gvar' is not an attribute (tester) and not a property (tester), - # or `gvar' is a filter; - # in any case, `gvar' is not an attribute. - - # if `gvar' has no one argument declarations we can turn it into - # an attribute - req := GET_OPER_FLAGS(gvar); - for reqs in req do - if LENGTH(reqs) = 1 then - Error( "operation `", name, "' has been declared as a one ", - "argument Operation and cannot also be an Attribute"); - fi; - od; - mutflag := LEN_LIST(arg) = 3 and arg[3] = "mutable"; - - # add the new set of requirements - filter:= arg[2]; - if not IS_OPERATION( filter ) then - Error( " must be an operation" ); - fi; - - flags := FLAGS_FILTER(filter); - STORE_OPER_FLAGS( gvar, [ FLAGS_FILTER( filter ) ] ); - - # kernel magic for the conversion - if mutflag then - OPER_TO_MUTABLE_ATTRIBUTE(gvar); - else - OPER_TO_ATTRIBUTE(gvar); - fi; - - # now we have to adjust the data structures - - if LEN_LIST(arg) = 3 and IS_INT(arg[3]) then - rank := arg[3]; - else - rank := 1; - fi; - OPER_SetupAttribute(gvar, flags, mutflag, filter, rank, name); - # and make the remaining assignments - nname:= "Set"; APPEND_LIST_INTR( nname, name ); - BIND_GLOBAL( nname, SETTER_FILTER(gvar) ); - nname:= "Has"; APPEND_LIST_INTR( nname, name ); - BIND_GLOBAL( nname, TESTER_FILTER(gvar) ); - - return; - - - fi; +BIND_GLOBAL( "DeclareAttribute", function ( name, filter, args... ) + local gvar, req, reqs, setter, tester, + attr, nname, mutflag, flags, rank; - # Add the new requirements. - filter:= arg[2]; - if not IS_OPERATION( filter ) then - Error( " must be an operation" ); - fi; - STORE_OPER_FLAGS( gvar, [ FLAGS_FILTER( filter ) ] ); + if not IS_STRING( name ) then + Error( " must be a string"); + fi; - # also set the extended range for the setter - req := GET_OPER_FLAGS( Setter(gvar) ); - STORE_OPER_FLAGS( Setter(gvar), [ FLAGS_FILTER( filter), req[1][2] ] ); + if not IsFilter( filter ) then + Error( " must be a filter" ); + fi; + rank := 1; + mutflag := false; + if LEN_LIST(args) = 0 then + # this is fine, but does nothing + elif LEN_LIST(args) = 1 and args[1] in [ "mutable", true, false ] then + mutflag := args[1] in [ "mutable", true]; + elif LEN_LIST(args) = 1 and IS_INT(args[1]) then + rank := args[1]; + elif LEN_LIST(args) = 2 + and args[1] in [ "mutable", true, false ] + and IS_INT(args[2]) then + mutflag := args[1] in [ "mutable", true ]; + rank := args[2]; else + Error("Usage: DeclareAttribute( , [, ][, ] )"); + fi; - # The attribute is new. - attr:= CALL_FUNC_LIST( NewAttribute, arg ); - BIND_GLOBAL( name, attr ); - - # and make the remaining assignments - nname:= "Set"; APPEND_LIST_INTR( nname, name ); - BIND_GLOBAL( nname, SETTER_FILTER(attr) ); - nname:= "Has"; APPEND_LIST_INTR( nname, name ); - BIND_GLOBAL( nname, TESTER_FILTER( attr ) ); + if ISB_GVAR( name ) then + # The variable exists already. + gvar := VALUE_GLOBAL( name ); + + # Check that the variable is in fact bound to an operation. + if not IS_OPERATION( gvar ) then + Error( "variable `", name, "' is not bound to an operation" ); + fi; + # The attribute has already been declared. + # If it was not created as an attribute + # then we may be able to convert it + if FLAG2_FILTER( gvar ) = 0 or IS_ELEMENTARY_FILTER(gvar) then + ConvertToAttribute(name, gvar, filter, rank, mutflag); + else + STORE_OPER_FLAGS( gvar, [ FLAGS_FILTER( filter ) ] ); + + # also set the extended range for the setter + req := GET_OPER_FLAGS( Setter(gvar) ); + STORE_OPER_FLAGS( Setter(gvar), [ FLAGS_FILTER( filter), req[1][2] ] ); + fi; + else + # The attribute is new. + attr := NewAttribute(name, filter, mutflag, rank); + BIND_GLOBAL( name, attr ); + + # and make the remaining assignments + nname := "Set"; APPEND_LIST_INTR( nname, name ); + BIND_GLOBAL( nname, SETTER_FILTER(attr) ); + nname := "Has"; APPEND_LIST_INTR( nname, name ); + BIND_GLOBAL( nname, TESTER_FILTER( attr ) ); fi; end ); diff --git a/tst/testinstall/attribute.tst b/tst/testinstall/attribute.tst new file mode 100644 index 0000000000..bda3d76c02 --- /dev/null +++ b/tst/testinstall/attribute.tst @@ -0,0 +1,49 @@ +gap> START_TEST("attribute.tst"); +gap> DeclareAttribute(); +Error, Function: number of arguments must be at least 2 (not 0) +gap> DeclareAttribute("banana"); +Error, Function: number of arguments must be at least 2 (not 1) +gap> DeclareAttribute((), IsFinite); +Error, must be a string +gap> DeclareAttribute("IsBanana", ()); +Error, must be a filter +gap> DeclareAttribute("IsBanana", IsGroup); +gap> DeclareAttribute("IsBanana", IsGroup, ()); +Error, Usage: DeclareAttribute( , [, ][, ] ) +gap> DeclareAttribute("IsBanana", IsGroup, "mutable"); +gap> DeclareAttribute("IsBanana", IsGroup, true); +gap> DeclareAttribute("IsBanana", IsGroup, false); +gap> DeclareAttribute("IsBanana", IsGroup, true, "shark"); +Error, Usage: DeclareAttribute( , [, ][, ] ) +gap> DeclareAttribute("IsBanana", IsGroup, true, 15); +gap> DeclareAttribute("IsBanana", IsGroup, "mutable", 15, "Hello, world"); +Error, Usage: DeclareAttribute( , [, ][, ] ) + +# +gap> NewAttribute(); +Error, Function: number of arguments must be at least 2 (not 0) +gap> NewAttribute("banana"); +Error, Function: number of arguments must be at least 2 (not 1) +gap> NewAttribute((), IsFinite); +Error, must be a string +gap> NewAttribute("IsBanana", ()); +Error, must be a filter +gap> NewAttribute("IsBanana", IsGroup); + +gap> NewAttribute("IsBanana", IsGroup, ()); +Error, Usage: NewAttribute( , [, ][, ] ) +gap> NewAttribute("IsBanana", IsGroup, "mutable"); + +gap> NewAttribute("IsBanana", IsGroup, true); + +gap> NewAttribute("IsBanana", IsGroup, false); + +gap> NewAttribute("IsBanana", IsGroup, true, "shark"); +Error, Usage: NewAttribute( , [, ][, ] ) +gap> NewAttribute("IsBanana", IsGroup, true, 15); + +gap> NewAttribute("IsBanana", IsGroup, "mutable", 15, "Hello, world"); +Error, Usage: NewAttribute( , [, ][, ] ) + +# +gap> STOP_TEST("attribute.tst", 1);