Доступ к полям и свойствам в сложных структурах данных - PullRequest
7 голосов
/ 10 мая 2010

Как уже обсуждалось в Обработка и согласованность данных Rtti в Delphi 2010 согласованность между исходными данными и значениями rtti может быть достигнута путем доступа к членам с помощью пары TRttiField и указателя экземпляра. Это было бы очень легко в случае простого класса только с базовыми типами-членами (например, целыми числами или строками). Но что, если у нас есть структурированные типы полей?

Вот пример:

TIntArray = array [0..1] of Integer;

TPointArray = array [0..1] of Point;

TExampleClass = class
  private
    FPoint : TPoint;
    FAnotherClass : TAnotherClass;
    FIntArray : TIntArray;
    FPointArray : TPointArray;
  public  
    property Point : TPoint read FPoint write FPoint; 
    //.... and so on
end;

Для легкого доступа к Членам я хочу построить дерево узлов-членов, которое предоставляет интерфейс для получения и установки значений, получения атрибутов, сериализации / десериализации значений и т. Д.

TMemberNode = class
  private
    FMember : TRttiMember;
    FParent : TMemberNode;
    FInstance : Pointer;
  public
    property Value : TValue read GetValue write SetValue; //uses FInstance
end;

Таким образом, наиболее важным является получение / установка значений, что делается - как указано выше - с помощью функций GetValue и SetValue из TRttiField.

Так что такое Экземпляр для членов FPoint? Допустим, Parent - это класс Node for TExample, где экземпляр известен, а член является полем, тогда Instance будет:

FInstance := Pointer (Integer (Parent.Instance) + TRttiField (FMember).Offset);

Но что, если я захочу узнать экземпляр для свойства записи? В этом случае нет смещения. Так есть ли лучшее решение для получения указателя на данные?

Для члена FAnotherClass Экземпляр будет:

FInstance := Parent.Value.AsObject;  

Пока решение работает, и манипулирование данными может осуществляться с использованием rtti или исходных типов без потери информации.

Но все становится сложнее при работе с массивами. Особенно второй массив очков. Как я могу получить экземпляр для членов баллов в этом случае?

Ответы [ 3 ]

13 голосов
/ 11 мая 2010

TRttiField.GetValue, где тип поля является типом значения, и вы получите копию. Это по замыслу. TValue.MakeWithoutCopy для управления счетчиками ссылок на такие вещи, как интерфейсы и строки; это не для того, чтобы избежать такого поведения копирования. TValue специально не предназначен для имитации поведения ByRef Variant, где вы можете получить ссылки на (например) объекты стека внутри TValue, увеличивая риск устаревших указателей. Это также было бы нелогичным; когда вы говорите GetValue, вы должны ожидать значение, а не ссылку.

Вероятно, наиболее эффективный способ манипулирования значениями типов значений, когда они хранятся в других структурах, - это отступить назад и добавить еще один уровень косвенности: путем вычисления смещений, а не работы с TValue напрямую для всех шагов, введенных для промежуточных значений по пути к предмету.

Это может быть инкапсулировано довольно тривиально. Я провел последний час или около того, записывая небольшую запись TLocation, в которой для этого используется RTTI:

type
  TLocation = record
    Addr: Pointer;
    Typ: TRttiType;
    class function FromValue(C: TRttiContext; const AValue: TValue): TLocation; static;
    function GetValue: TValue;
    procedure SetValue(const AValue: TValue);
    function Follow(const APath: string): TLocation;
    procedure Dereference;
    procedure Index(n: Integer);
    procedure FieldRef(const name: string);
  end;

function GetPathLocation(const APath: string; ARoot: TLocation): TLocation; forward;

{ TLocation }

type
  PPByte = ^PByte;

procedure TLocation.Dereference;
begin
  if not (Typ is TRttiPointerType) then
    raise Exception.CreateFmt('^ applied to non-pointer type %s', [Typ.Name]);
  Addr := PPointer(Addr)^;
  Typ := TRttiPointerType(Typ).ReferredType;
end;

procedure TLocation.FieldRef(const name: string);
var
  f: TRttiField;
begin
  if Typ is TRttiRecordType then
  begin
    f := Typ.GetField(name);
    Addr := PByte(Addr) + f.Offset;
    Typ := f.FieldType;
  end
  else if Typ is TRttiInstanceType then
  begin
    f := Typ.GetField(name);
    Addr := PPByte(Addr)^ + f.Offset;
    Typ := f.FieldType;
  end
  else
    raise Exception.CreateFmt('. applied to type %s, which is not a record or class',
      [Typ.Name]);
end;

function TLocation.Follow(const APath: string): TLocation;
begin
  Result := GetPathLocation(APath, Self);
end;

class function TLocation.FromValue(C: TRttiContext; const AValue: TValue): TLocation;
begin
  Result.Typ := C.GetType(AValue.TypeInfo);
  Result.Addr := AValue.GetReferenceToRawData;
end;

function TLocation.GetValue: TValue;
begin
  TValue.Make(Addr, Typ.Handle, Result);
end;

procedure TLocation.Index(n: Integer);
var
  sa: TRttiArrayType;
  da: TRttiDynamicArrayType;
begin
  if Typ is TRttiArrayType then
  begin
    // extending this to work with multi-dimensional arrays and non-zero
    // based arrays is left as an exercise for the reader ... :)
    sa := TRttiArrayType(Typ);
    Addr := PByte(Addr) + sa.ElementType.TypeSize * n;
    Typ := sa.ElementType;
  end
  else if Typ is TRttiDynamicArrayType then
  begin
    da := TRttiDynamicArrayType(Typ);
    Addr := PPByte(Addr)^ + da.ElementType.TypeSize * n;
    Typ := da.ElementType;
  end
  else
    raise Exception.CreateFmt('[] applied to non-array type %s', [Typ.Name]);
end;

procedure TLocation.SetValue(const AValue: TValue);
begin
  AValue.Cast(Typ.Handle).ExtractRawData(Addr);
end;

Этот тип может использоваться для навигации по местоположениям в пределах значений с использованием RTTI. Чтобы сделать его немного проще в использовании и немного веселее для написания, я также написал парсер - метод Follow:

function GetPathLocation(const APath: string; ARoot: TLocation): TLocation;

  { Lexer }

  function SkipWhite(p: PChar): PChar;
  begin
    while IsWhiteSpace(p^) do
      Inc(p);
    Result := p;
  end;

  function ScanName(p: PChar; out s: string): PChar;
  begin
    Result := p;
    while IsLetterOrDigit(Result^) do
      Inc(Result);
    SetString(s, p, Result - p);
  end;

  function ScanNumber(p: PChar; out n: Integer): PChar;
  var
    v: Integer;
  begin
    v := 0;
    while (p >= '0') and (p <= '9') do
    begin
      v := v * 10 + Ord(p^) - Ord('0');
      Inc(p);
    end;
    n := v;
    Result := p;
  end;

const
  tkEof = #0;
  tkNumber = #1;
  tkName = #2;
  tkDot = '.';
  tkLBracket = '[';
  tkRBracket = ']';

var
  cp: PChar;
  currToken: Char;
  nameToken: string;
  numToken: Integer;

  function NextToken: Char;
    function SetToken(p: PChar): PChar;
    begin
      currToken := p^;
      Result := p + 1;
    end;
  var
    p: PChar;
  begin
    p := cp;
    p := SkipWhite(p);
    if p^ = #0 then
    begin
      cp := p;
      currToken := tkEof;
      Exit(currToken);
    end;

    case p^ of
      '0'..'9':
      begin
        cp := ScanNumber(p, numToken);
        currToken := tkNumber;
      end;

      '^', '[', ']', '.': cp := SetToken(p);

    else
      cp := ScanName(p, nameToken);
      if nameToken = '' then
        raise Exception.Create('Invalid path - expected a name');
      currToken := tkName;
    end;

    Result := currToken;
  end;

  function Describe(tok: Char): string;
  begin
    case tok of
      tkEof: Result := 'end of string';
      tkNumber: Result := 'number';
      tkName: Result := 'name';
    else
      Result := '''' + tok + '''';
    end;
  end;

  procedure Expect(tok: Char);
  begin
    if tok <> currToken then
      raise Exception.CreateFmt('Expected %s but got %s', 
        [Describe(tok), Describe(currToken)]);
  end;

  { Semantic actions are methods on TLocation }
var
  loc: TLocation;

  { Driver and parser }

begin
  cp := PChar(APath);
  NextToken;

  loc := ARoot;

  // Syntax:
  // path ::= ( '.' <name> | '[' <num> ']' | '^' )+ ;;

  // Semantics:

  // '<name>' are field names, '[]' is array indexing, '^' is pointer
  // indirection.

  // Parser continuously calculates the address of the value in question, 
  // starting from the root.

  // When we see a name, we look that up as a field on the current type,
  // then add its offset to our current location if the current location is 
  // a value type, or indirect (PPointer(x)^) the current location before 
  // adding the offset if the current location is a reference type. If not
  // a record or class type, then it's an error.

  // When we see an indexing, we expect the current location to be an array
  // and we update the location to the address of the element inside the array.
  // All dimensions are flattened (multiplied out) and zero-based.

  // When we see indirection, we expect the current location to be a pointer,
  // and dereference it.

  while True do
  begin
    case currToken of
      tkEof: Break;

      '.':
      begin
        NextToken;
        Expect(tkName);
        loc.FieldRef(nameToken);
        NextToken;
      end;

      '[':
      begin
        NextToken;
        Expect(tkNumber);
        loc.Index(numToken);
        NextToken;
        Expect(']');
        NextToken;
      end;

      '^':
      begin
        loc.Dereference;
        NextToken;
      end;

    else
      raise Exception.Create('Invalid path syntax: expected ".", "[" or "^"');
    end;
  end;

  Result := loc;
end;

Вот пример типа и подпрограмма (P), которая управляет им:

type
  TPoint = record
    X, Y: Integer;
  end;
  TArr = array[0..9] of TPoint;

  TFoo = class
  private
    FArr: TArr;
    constructor Create;
    function ToString: string; override;
  end;

{ TFoo }

constructor TFoo.Create;
var
  i: Integer;
begin
  for i := Low(FArr) to High(FArr) do
  begin
    FArr[i].X := i;
    FArr[i].Y := -i;
  end;
end;

function TFoo.ToString: string;
var
  i: Integer;
begin
  Result := '';
  for i := Low(FArr) to High(FArr) do
    Result := Result + Format('(%d, %d) ', [FArr[i].X, FArr[i].Y]);
end;

procedure P;
var
  obj: TFoo;
  loc: TLocation;
  ctx: TRttiContext;
begin
  obj := TFoo.Create;
  Writeln(obj.ToString);

  ctx := TRttiContext.Create;

  loc := TLocation.FromValue(ctx, obj);
  Writeln(loc.Follow('.FArr[2].X').GetValue.ToString);
  Writeln(obj.FArr[2].X);

  loc.Follow('.FArr[2].X').SetValue(42);
  Writeln(obj.FArr[2].X); // observe value changed

  // alternate syntax, not using path parser, but location destructive updates
  loc.FieldRef('FArr');
  loc.Index(2);
  loc.FieldRef('X');
  loc.SetValue(24);
  Writeln(obj.FArr[2].X); // observe value changed again

  Writeln(obj.ToString);
end;

Этот принцип можно распространить на другие типы и синтаксис выражений Delphi, или TLocation можно изменить, чтобы он возвращал новые TLocation экземпляры, а не разрушительные самообновления, или может поддерживаться индексация не плоских массивов и т. Д.

4 голосов
/ 11 мая 2010

Этот вопрос затрагивает несколько концепций и проблем. Прежде всего, вы смешали несколько типов записей и некоторые свойства, и я хотел бы сначала разобраться с этим. Затем я дам вам краткую информацию о том, как читать поля «Left» и «Top» записи, когда эта запись является частью поля в классе ... Затем я дам вам советы о том, как сделать эта работа в общем. Я, вероятно, собираюсь объяснить немного больше, чем требуется, но здесь полночь, и я не могу спать!

Пример:

TPoint = record
  Top: Integer;
  Left: Integer;
end;

TMyClass = class
protected
  function GetMyPoint: TPoint;
  procedure SetMyPoint(Value:TPoint);
public
  AnPoint: TPoint;           
  property MyPoint: TPoint read GetMyPoint write SetMyPoint;
end;

function TMyClass.GetMyPoint:Tpoint;
begin
  Result := AnPoint;
end;

procedure TMyClass.SetMyPoint(Value:TPoint);
begin
  AnPoint := Value;
end;

Вот сделка. Если вы напишите этот код, во время выполнения он будет делать то, что, кажется, будет делать:

var X:TMyClass;
x.AnPoint.Left := 7;

Но этот код не будет работать так же:

var X:TMyClass;
x.MyPoint.Left := 7;

Потому что этот код эквивалентен:

var X:TMyClass;
var tmp:TPoint;

tmp := X.GetMyPoint;
tmp.Left := 7;

Способ исправить это - сделать что-то вроде этого:

var X:TMyClass;
var P:TPoint;

P := X.MyPoint;
P.Left := 7;
X.MyPoint := P;

Продолжая, вы хотите сделать то же самое с RTTI. Вы можете получить RTTI как для поля «AnPoint: TPoint», так и для поля «MyPoint: TPoint». Поскольку при использовании RTTI вы, по сути, используете функцию для получения значения, вам нужно использовать технику «Создание локального копирования, изменения, обратной записи» с обоими (код того же типа, что и для примера X.MyPoint).

При выполнении с RTTI мы всегда будем начинать с «корня» (экземпляра TExampleClass или TMyClass) и использовать только серию методов Rtti GetValue и SetValue, чтобы получить значение глубокого поля или набора значение того же глубокого поля.

Предположим, у нас есть следующее:

AnPointFieldRtti: TRttiField; // This is RTTI for the AnPoint field in the TMyClass class
LeftFieldRtti: TRttiField; // This is RTTI for the Left field of the TPoint record

Мы хотим подражать этому:

var X:TMyClass;
begin
  X.AnPoint.Left := 7;
end;

Мы будем разбивать это на шаги, мы стремимся к этому:

var X:TMyClass;
    V:TPoint;
begin
  V := X.AnPoint;
  V.Left := 7;
  X.AnPoint := V;
end;

Поскольку мы хотим сделать это с RTTI и хотим, чтобы оно работало с чем-либо, мы не будем использовать тип «TPoint». Итак, как и следовало ожидать, мы сначала делаем это:

var X:TMyClass;
    V:TValue; // This will hide a TPoint value, but we'll pretend we don't know
begin
  V := AnPointFieldRtti.GetValue(X);
end;

Для следующего шага мы будем использовать GetReferenceToRawData, чтобы получить указатель на запись TPoint, скрытую в V: TValue (вы знаете, ту, о которой мы притворяемся, мы ничего не знаем - кроме факта, что это ЗАПИСЬ). Как только мы получим указатель на эту запись, мы можем вызвать метод SetValue, чтобы переместить «7» внутрь записи.

LeftFieldRtti.SetValue(V.GetReferenceToRawData, 7);

Вот и все. Теперь нам просто нужно переместить TValue обратно в X: TMyClass:

AnPointFieldRtti.SetValue(X, V)

С головы до хвоста это будет выглядеть так:

var X:TMyClass;
    V:TPoint;
begin
  V := AnPointFieldRtti.GetValue(X);
  LeftFieldRtti.SetValue(V.GetReferenceToRawData, 7);
  AnPointFieldRtti.SetValue(X, V);
end;

Это, очевидно, может быть расширено для обработки конструкций любой глубины. Просто помните, что вам нужно сделать это шаг за шагом: первый GetValue использует «корневой» экземпляр, затем следующий GetValue использует экземпляр, извлеченный из предыдущего результата GetValue. Для записей мы можем использовать TValue.GetReferenceToRawData, для объектов мы можем использовать TValue.AsObject!

Следующий сложный момент заключается в том, что вы можете реализовать свою двунаправленную древовидную структуру. Для этого я бы порекомендовал сохранить путь от «root» к вашему полю в виде массива TRttiMember (приведение будет использовано для поиска фактического типа runtype, поэтому мы можем вызывать GetValue и SetValue). Узел будет выглядеть примерно так:

TMemberNode = class
  private
    FMember : array of TRttiMember; // path from root
    RootInstance:Pointer;
  public
    function GetValue:TValue;
    procedure SetValue(Value:TValue);
end;

Реализация GetValue очень проста:

function TMemberNode.GetValue:TValue;
var i:Integer;    
begin
  Result := FMember[0].GetValue(RootInstance);
  for i:=1 to High(FMember) do
    if FMember[i-1].FieldType.IsRecord then
      Result := FMember[i].GetValue(Result.GetReferenceToRawData)
    else
      Result := FMember[i].GetValue(Result.AsObject);
end;

Реализация SetValue будет немного более сложной. Из-за этих (надоедливых?) Записей нам нужно будет сделать все , что делает процедура GetValue (потому что нам нужен указатель Instance для самого последнего элемента FMember), тогда мы сможем вызвать SetValue, но нам может потребоваться вызвать SetValue для его родителя, а затем для родителя его родителя и т. д. Это, очевидно, означает, что нам нужно СОХРАНИТЬ все неповрежденные промежуточные значения TValue, на тот случай, если они нам понадобятся. Итак, поехали:

procedure TMemberNode.SetValue(Value:TValue);
var Values:array of TValue;
    i:Integer;
begin
  if Length(FMember) = 1 then
    FMember[0].SetValue(RootInstance, Value) // this is the trivial case
  else
    begin
      // We've got an strucutred case! Let the fun begin.
      SetLength(Values, Length(FMember)-1); // We don't need space for the last FMember

      // Initialization. The first is being read from the RootInstance
      Values[0] := FMember[0].GetValue(RootInstance);

      // Starting from the second path element, but stoping short of the last
      // path element, we read the next value
      for i:=1 to Length(FMember)-2 do // we'll stop before the last FMember element
        if FMember[i-1].FieldType.IsRecord then
          Values[i] := FMember[i].GetValue(Values[i-1].GetReferenceToRawData)
        else
          Values[i] := FMember[i].GetValue(Values[i-1].AsObject);

      // We now know the instance to use for the last element in the path
      // so we can start calling SetValue.
      if FMember[High(FMember)-1].FieldType.IsRecord then
        FMember[High(FMember)].SetValue(Values[High(FMember)-1].GetReferenceToRawData, Value)
      else
        FMember[High(FMember)].SetValue(Values[High(FMember)-1].AsObject, Value);

      // Any records along the way? Since we're dealing with classes or records, if
      // something is not a record then it's a instance. If we reach a "instance" then
      // we can stop processing.
      i := High(FMember)-1;
      while (i >= 0) and FMember[i].FieldType.IsRecord do
      begin
        if i = 0 then
          FMember[0].SetValue(RootInstance, Values[0])
        else
          if FMember[i-1].FieldType.IsRecord then
            FMember[i].SetValue(FMember[i-1].GetReferenceToRawData, Values[i])
          else
            FMember[i].SetValue(FMember[i-1].AsObject, Values[i]);
        // Up one level (closer to the root):
        Dec(i)
      end;
    end;
end;

... И так и должно быть. Теперь несколько предупреждений:

  • НЕ ожидайте, что это скомпилируется! Я написал каждый кусочек кода в этом посте в веб-браузере. По техническим причинам у меня был доступ к исходному файлу Rtti.pas для поиска имен методов и полей, но у меня нет доступа к компилятору.
  • Я был бы ОЧЕНЬ осторожен с этим кодом, особенно если включены СВОЙСТВА. Свойство может быть реализовано без вспомогательного поля, процедура установки может не выполнить то, что вы ожидаете. Вы можете столкнуться с циклическими ссылками!
0 голосов
/ 10 мая 2010

Вы, похоже, неправильно понимаете, как работает указатель экземпляра. Вы не сохраняете указатель на поле, вы сохраняете указатель на класс или запись, для которой это поле. Ссылки на объекты уже являются указателями, поэтому там не требуется приведение. Для записей необходимо получить указатель на них с символом @.

Когда у вас есть указатель и объект TRttiField, который ссылается на это поле, вы можете вызвать SetValue или GetValue для TRttiField и передать указатель вашего экземпляра, и он позаботится обо всех вычислениях смещения для вас.

В конкретном случае массивов GetValue даст вам TValue, представляющий массив. Вы можете проверить это, позвонив TValue.IsArray, если хотите. Если у вас есть TValue, представляющий массив, вы можете получить длину массива с помощью TValue.GetArrayLength и получить отдельные элементы с помощью TValue.GetArrayElement.

РЕДАКТИРОВАТЬ: Вот как поступить с записями членов в классе.

Записи также являются типами, и у них есть собственный RTTI. Вы можете изменить их, не выполняя «GetValue, modify, SetValue» следующим образом:

procedure ModifyPoint(example: TExampleClass; newXValue, newYValue: integer);
var
  context: TRttiContext;
  value: TValue;
  field: TRttiField;
  instance: pointer;
  recordType: TRttiRecordType;
begin
  field := context.GetType(TExampleClass).GetField('FPoint');
  //TValue that references the TPoint
  value := field.GetValue(example);
  //Extract the instance pointer to the TPoint within your object
  instance := value.GetReferenceToRawData;
  //RTTI for the TPoint type
  recordType := context.GetType(value.TypeInfo) as TRttiRecordType;
  //Access the individual members of the TPoint
  recordType.GetField('X').SetValue(instance, newXValue);
  recordType.GetField('Y').SetValue(instance, newYValue);
end;

Похоже, часть, о которой вы не знали, это TValue.GetReferenceToRawData. Это даст вам указатель на поле, без необходимости беспокоиться о вычислении смещений и приведении указателей к целым числам.

...