[Edited] For whoever is interested: An aspect to create Extension Fields (add storage to an existing class)

Elements Oxygene
1

Again, with lots of help from @ck

Edit: This aspect does only work on .Net, because it uses the .Net class System.WeakReference

With extensions, you can add methods and functional properties to a class.
But it is not possible to add storage to it, so no fields and no storage properties.

With this aspect you get the ability to add those fields to a class, with - according to @mh - a little black magic :wink:.

Usage in the code:

> type MyExtension = public extension(MyClass)
>     //Add an extension field
>     [ExtensionField]
>     public var MyExtensionField as MyType;
> end;

The code for the aspect (@mh, @ck - somthing for Cirrus?):

namespace builditAspects;

interface

uses 
  System.Linq,
  RemObjects.Elements.Cirrus.*;

type
    [AttributeUsage(AttributeTargets.Field)]
    ExtensionField = public class(Attribute, IFieldInterfaceDecorator)
private
public
    method HandleInterface(Services: IServices; aField: IFieldDefinition);
end;

implementation

method ExtensionField.HandleInterface(Services: IServices; aField: IFieldDefinition);
begin
//Needed in all of the code
    var SelfType := aField.Owner.ExtensionTypeFor;
    var WeakReferenceType :=  Services.FindType("System.WeakReference");
    var stmt: System.Collections.Generic.List<Statement>;

//Add the private storage dictionary
    var t := Services.FindType("System.Collections.Generic.Dictionary`2");
    var t1 := Services.CreateGenericInstance(t, WeakReferenceType, aField.Type);  //initialize the generic parameters of the dictionary                                        

    var StorageField := aField.Owner.AddField(aField.Name + "_Dict", t1, true);
    StorageField.Visibility := Visibility.Private;

    // -> this part does not work; no assignment is generated (also no error is raised)
    StorageField.InitialValue := new NewValue(t1);
    if aField.Owner.GetClassConstructor = nil then aField.Owner.AddConstructor(true);

//find key method (does also the clean up)
    var lFindKey := aField.Owner.AddMethod(aField.Name + "_GetKeyOnTarget", WeakReferenceType, true);
    lFindKey.AddParameter("self", ParameterModifier.In, SelfType);
    lFindKey.Virtual := VirtualMode.None;
    lFindKey.Visibility := Visibility.Private;

                                        
    stmt := new System.Collections.Generic.List<Statement>;

    //ToRemove := new System.Generic.List(System.WeakReference);
    var lt := Services.FindType("System.Collections.Generic.List`1");
    var lt1 := Services.CreateGenericInstance(lt, WeakReferenceType);  //initialize the generic parameters of the list
    stmt.Add(new AssignmentStatement(new IdentifierValue("ToRemove"), new NewValue(lt1)));

    //For each k: System.WeakReference in Test_Dict.Keys do
    //begin
    //    if k.Target = self then
    //        exit k
    //    else
    //        if k.Target = nil then
    //            ToRemove.Add(k);
    //end;
    var body:= new BeginStatement(
                    new IfStatement(
                        new BinaryValue(new IdentifierValue(new IdentifierValue("k"), "Target"), new ParamValue(0), BinaryOperator.Equal), 
                            new ExitStatement(new IdentifierValue("k")),
                            new IfStatement(
                                new BinaryValue(new IdentifierValue(new IdentifierValue("k"), "Target"), new NilValue, BinaryOperator.Equal),
                                    new StandaloneStatement(new ProcValue(new IdentifierValue("ToRemove"), "Add", [new IdentifierValue("k")]))
                                           )
                                       )
                              );
    stmt.Add(new ForInStatement( "k",                                                           //aName: String;      -> the var for the foreach
                                 WeakReferenceType,                                             //aType: IType;       -> type of the previous one
                                 false,                                                         //aMatching: Boolean; -> use matchin
                                 new IdentifierValue(new FieldValue(nil, StorageField), "Keys"),//aSource: Value;     -> the enummerable
                                 body,                                                          //aBody: Statement;   -> statement in the for
                                 nil,                                                           //aIndexName: String; -> indexname
                                 nil,                                                           //aIndexType: IType;  -> type of the previous, always int32
                                 false                                                          //aParallel: Boolean  -> use a parallel for
                                )
            ); 
    

    //For each k1: System.WeakReference in ToRemove do
    //    Test_Dict.Remove(k1);
    var body2:= new StandaloneStatement(new ProcValue(new FieldValue(nil, StorageField),"Remove", [new IdentifierValue("k1")]));
    stmt.Add(new ForInStatement( "k1",                                                          //aName: String;      -> the var for the foreach
                                 WeakReferenceType,                                             //aType: IType;       -> type of the previous one
                                 false,                                                         //aMatching: Boolean; -> use matchin
                                 new IdentifierValue("ToRemove"),                               //aSource: Value;     -> the enummerable
                                 body2,                                                         //aBody: Statement;   -> statement in the for
                                 nil,                                                           //aIndexName: String; -> indexname
                                 nil,                                                           //aIndexType: IType;  -> type of the previous, always int32
                                 false                                                          //aParallel: Boolean  -> use a parallel for
                                )
            ); 

    lFindKey.ReplaceMethodBody(new BeginStatement([new LocalVariable("ToRemove", lt1)],stmt.ToArray));
    
      
//private write method for field replacing property 
    var lWrite := aField.Owner.AddMethod('set_' + aField.Name, nil,  aField.Static);
    lWrite.AddParameter('self', ParameterModifier.In, SelfType).Prefix := '$mapped';
    lWrite.AddParameter('val', ParameterModifier.In, aField.Type);
    lWrite.Virtual := VirtualMode.None;
    lWrite.Visibility := aField.Visibility;

    stmt := new System.Collections.Generic.List<Statement>;

    //key := Test_GetKeyOnTarget(self);
    stmt.Add(new AssignmentStatement(new IdentifierValue("key"), new ProcValue(new TypeValue(aField.Owner), lFindKey, [new ParamValue(0)])));   
    //if key <> nil then
    //    Test_Dict.Keys[key] := val
    //else if val <> nil then
    //    Test_Dict.Add(self, val); 
    stmt.Add(new IfStatement(
                    new BinaryValue(new IdentifierValue("key"), new NilValue, BinaryOperator.NotEqual), 
                        new AssignmentStatement(new SubArrayValue(new IdentifierValue(new FieldValue(nil, StorageField), "Item"), new IdentifierValue("key")),new ParamValue(1)),
                        new IfStatement(
                            new BinaryValue(new ParamValue(1), new NilValue, BinaryOperator.NotEqual),
                                new StandaloneStatement(new ProcValue(new FieldValue(nil, StorageField),"Add", [new NewValue(WeakReferenceType, new ParamValue(0)), new ParamValue(1)]))
                                       )
                             )
             ); 

    lWrite.ReplaceMethodBody(new BeginStatement([new LocalVariable("key", WeakReferenceType)], stmt.ToArray));

//private read method for field replacing property
    var lRead := aField.Owner.AddMethod('get_' + aField.Name, aField.Type,  aField.Static);
    lRead.AddParameter('self', ParameterModifier.In, SelfType).Prefix := '$mapped';
    lRead.Virtual := VirtualMode.None;
    lRead.Visibility := aField.Visibility;

    stmt := new System.Collections.Generic.List<Statement>;

    //key := Test_GetKeyOnTarget(self);
    stmt.Add(new AssignmentStatement(new IdentifierValue("key"), new ProcValue(new TypeValue(aField.Owner), lFindKey, [new ParamValue(0)])));   
    //if key <> nil then
    //    exit Test_Dict[key]
    //else
    //    exit default;
    stmt.Add(new IfStatement(
                    new BinaryValue(new IdentifierValue("key"), new NilValue, BinaryOperator.NotEqual), 
                         new ExitStatement(new SubArrayValue(new IdentifierValue(new FieldValue(nil, StorageField), "Item"), new IdentifierValue("key"))),
                         new ExitStatement(new DefaultValue(aField.Type)))) ; 


    lRead.ReplaceMethodBody(new BeginStatement([new LocalVariable("key", WeakReferenceType)], stmt.ToArray));


//the field replacing property - visibility the same as the original field (works 100%)
    var lProp := aField.Owner.AddProperty(aField.Name, aField.Type, aField.Static);
    lProp.Locked := true;
    lProp.ReadMethod := lRead;
    lProp.WriteMethod := lWrite;
    lProp.Visibility := aField.Visibility;

//remove the original field (works 100%)
    aField.Owner.RemoveField(aField);
end;

end.
1 Like
2

A new, more simple version, using the Aspect code injection (edit: added the platform as it will only work on .Net):

namespace builditAspects;

interface

uses 
  System.Linq,
  RemObjects.Elements.Cirrus.*;

type
    [AttributeUsage(AttributeTargets.Field)]
    [AspectPlatformAttribute(platform.Echoes)]
    ExtensionField = public class(Attribute, IFieldInterfaceDecorator)
private
    method HandleInterface(Services: IServices; aField: IFieldDefinition);

//needed functions, will be injected into the extension class

    [AutoInjectIntoTarget]
    class method GetKeyOnTarget(findKey: Object; Dictionary: System.Collections.Generic.Dictionary<WeakReference, Object>): WeakReference;
    begin
        For each k: System.WeakReference in Dictionary.Keys.ToArray do
        begin
            if k.Target = findKey then
            begin
                result := k;
                break;
            end
            else if k.Target = nil then                                      
                Dictionary.Remove(k);
        end;
    end;

    [AutoInjectIntoTarget]
    class method Get_Field_Value(key: Object; Dictionary: System.Collections.Generic.Dictionary<WeakReference, Object>): Object;
    begin
        var WeakKey := GetKeyOnTarget(key, Dictionary);
        if WeakKey <> nil then
            exit Dictionary[WeakKey]
        else
            exit nil;
    end;

    [AutoInjectIntoTarget]
    class method Set_Field_Value(key: Object; val: Object; Dictionary: System.Collections.Generic.Dictionary<WeakReference, Object>);
    begin
        var WeakKey := GetKeyOnTarget(key, Dictionary);
        if WeakKey <> nil then
            Dictionary[WeakKey] := val
        else if val <> nil then
            Dictionary.Add(new WeakReference(key), val)
        else
            Dictionary.Remove(WeakKey);
    end;

end;

implementation

method ExtensionField.HandleInterface(Services: IServices; aField: IFieldDefinition);
begin

//if it is not an extension type do nothing
    var SelfType := aField.Owner.ExtensionTypeFor;
    if SelfType = nil then 
        exit; //is not an extension type (it will still inject the code above, but that wont be used)

//Needed in all of the code
    var WeakReferenceType :=  Services.FindType("System.WeakReference");
    var ObjectType :=  Services.FindType("System.Object");

//Add the private storage dictionary
    var t := Services.FindType("System.Collections.Generic.Dictionary`2");
    var t1 := Services.CreateGenericInstance(t, WeakReferenceType, ObjectType);  //initialize the generic parameters of the dictionary                                        

    var StorageField := aField.Owner.AddField(aField.Name + "_Dict", t1, true);
    StorageField.Visibility := Visibility.Private;
    StorageField.InitialValue := new NewValue(t1);

//create a contructor where the initial value is assigned
    if aField.Owner.GetClassConstructor = nil then aField.Owner.AddConstructor(true);
      
//private write method for field replacing property 
    var lWrite := aField.Owner.AddMethod('set_' + aField.Name, nil,  aField.Static);
    lWrite.AddParameter('self', ParameterModifier.In, SelfType).Prefix := '$mapped';
    lWrite.AddParameter('val', ParameterModifier.In, aField.Type);
    lWrite.Virtual := VirtualMode.None;
    lWrite.Visibility := aField.Visibility;

    var WritePar := new System.Collections.Generic.List<Value>;
    WritePar.Add(new ParamValue(0));
    WritePar.Add(new ParamValue(1));
    WritePar.Add(new FieldValue(nil, StorageField));

    lWrite.ReplaceMethodBody(
        new BeginStatement(
            [new StandaloneStatement(
                new ProcValue(new TypeValue(aField.Owner), "Set_Field_Value", WritePar.ToArray)
                                    )]
                             ));

//private read method for field replacing property
    var lRead := aField.Owner.AddMethod('get_' + aField.Name, aField.Type,  aField.Static);
    lRead.AddParameter('self', ParameterModifier.In, SelfType).Prefix := '$mapped';
    lRead.Virtual := VirtualMode.None;
    lRead.Visibility := aField.Visibility;

    var ReadPar := new System.Collections.Generic.List<Value>;
    ReadPar.Add(new ParamValue(0));
    ReadPar.Add(new FieldValue(nil, StorageField));

    lRead.ReplaceMethodBody(
    new BeginStatement(
        [new ExitStatement(
            new UnaryValue(
                new ProcValue(new TypeValue(aField.Owner), "Get_Field_Value", ReadPar.ToArray)
                                , UnaryOperator.Cast, aField.Type)
                                )]
                            ));


//the field replacing property - visibility the same as the original field
    var lProp := aField.Owner.AddProperty(aField.Name, aField.Type, aField.Static);
    lProp.Locked := true;
    lProp.ReadMethod := lRead;
    lProp.WriteMethod := lWrite;
    lProp.Visibility := aField.Visibility;

//remove the original field as it is not needed anymore (replaced by a property)
    aField.Owner.RemoveField(aField);

//inject the needed functions (wont do it automatically because of the field removal)
    (self as IAutoGenMethodImplementationDecorator).AutoGenHandleImplementation(Services, aField.Owner);

end;

end.
1 Like