Ignore:
Timestamp:
Apr 22, 2020, 12:02:17 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Implemented generic access to fields in source tree.
  • Added: Generator to XML.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/interpreter2/USource.pas

    r207 r208  
    1313  TBeginEnd = class;
    1414
     15  TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,
     16    dtTime, dtDate, dtDateTime, dtEnumeration, dtObject);
     17
     18  { TField }
     19
     20  TField = class
     21    Index: Integer;
     22    DataType: TDataType;
     23    Name: string;
     24    constructor Create(ADataType: TDataType; AName: string);
     25  end;
     26
     27  TFields = class(TObjectList)
     28  end;
     29
    1530  { TSourceNode }
    1631
    1732  TSourceNode = class
    1833  private
    19     function GetNode(Index: Integer): TSourceNode; virtual;
    20     function GetNodesCount: Integer; virtual;
    21     procedure SetNode(Index: Integer; AValue: TSourceNode); virtual;
    22   public
    23     property NodesCount: Integer read GetNodesCount;
    24     property Nodes[Index: Integer]: TSourceNode read GetNode write SetNode;
     34    function GetFieldsCount: Integer; virtual;
     35  public
     36    function GetField(Index: Integer): TField; virtual;
     37    procedure GetValue(Index: Integer; out Value); virtual;
     38    function GetValueInteger(Index: Integer): Integer;
     39    function GetValueString(Index: Integer): string;
     40    function GetValueBoolean(Index: Integer): Boolean;
     41    function GetValueObject(Index: Integer): TObject;
     42    function GetValueAsText(Index: Integer): string;
     43    procedure SetValue(Index: Integer; var Value); virtual;
     44    procedure SetValueInteger(Index: Integer; Value: Integer);
     45    procedure SetValueString(Index: Integer; Value: string);
     46    procedure SetValueBoolean(Index: Integer; Value: Boolean);
     47    procedure SetValueObject(Index: Integer; Value: TObject);
     48    function GetFields: TFields;
     49    property FieldsCount: Integer read GetFieldsCount;
    2550  end;
    2651
    … …  
    7499
    75100  TType = class(TSourceNode)
     101  private
     102    function GetFieldsCount: Integer; override;
     103  public
    76104    Name: string;
    77105    Functions: TFunctions;
    78106    ValueClass: TValueClass;
     107    procedure GetValue(Index: Integer; out Value); override;
     108    function GetField(Index: Integer): TField; override;
     109    procedure SetValue(Index: Integer; var Value); override;
    79110    constructor Create;
    80111    destructor Destroy; override;
    … …  
    92123  TVariable = class(TSourceNode)
    93124  private
    94     function GetNode(Index: Integer): TSourceNode; override;
    95     function GetNodesCount: Integer; override;
    96     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     125    function GetFieldsCount: Integer; override;
    97126  public
    98127    Name: string;
    99128    TypeRef: TType;
     129    procedure GetValue(Index: Integer; out Value); override;
     130    function GetField(Index: Integer): TField; override;
     131    procedure SetValue(Index: Integer; var Value); override;
    100132  end;
    101133
    … …  
    110142  TConstant = class(TSourceNode)
    111143  private
    112     function GetNode(Index: Integer): TSourceNode; override;
    113     function GetNodesCount: Integer; override;
    114     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     144    function GetFieldsCount: Integer; override;
    115145  public
    116146    Name: string;
    117147    TypeRef: TType;
    118148    Value: TValue;
     149    procedure GetValue(Index: Integer; out Value); override;
     150    function GetField(Index: Integer): TField; override;
     151    procedure SetValue(Index: Integer; var Value); override;
    119152  end;
    120153
    … …  
    142175  TFunction = class(TSourceNode)
    143176  private
    144     function GetNode(Index: Integer): TSourceNode; override;
    145     function GetNodesCount: Integer; override;
    146     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     177    function GetFieldsCount: Integer; override;
    147178  public
    148179    Name: string;
    … …  
    151182    ResultType: TType;
    152183    BeginEnd: TBeginEnd;
     184    procedure GetValue(Index: Integer; out Value); override;
     185    function GetField(Index: Integer): TField; override;
     186    procedure SetValue(Index: Integer; var Value); override;
    153187    constructor Create;
    154188    destructor Destroy; override;
    … …  
    175209  TFunctionCall = class(TCommand)
    176210  private
    177     function GetNode(Index: Integer): TSourceNode; override;
    178     function GetNodesCount: Integer; override;
    179     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     211    function GetFieldsCount: Integer; override;
    180212  public
    181213    FunctionDef: TFunction;
    182214    Params: TExpressions;
     215    procedure GetValue(Index: Integer; out Value); override;
     216    function GetField(Index: Integer): TField; override;
     217    procedure SetValue(Index: Integer; var Value); override;
    183218    constructor Create;
    184219    destructor Destroy; override;
    … …  
    189224  TBeginEnd = class(TCommand)
    190225  private
    191     function GetNode(Index: Integer): TSourceNode; override;
    192     function GetNodesCount: Integer; override;
    193     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     226    function GetFieldsCount: Integer; override;
    194227  public
    195228    Commands: TCommands;
     229    procedure GetValue(Index: Integer; out Value); override;
     230    function GetField(Index: Integer): TField; override;
     231    procedure SetValue(Index: Integer; var Value); override;
    196232    procedure Clear;
    197233    constructor Create;
    … …  
    212248  TExpressionOperation = class(TExpression)
    213249  private
    214     function GetNode(Index: Integer): TSourceNode; override;
    215     function GetNodesCount: Integer; override;
    216     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     250    function GetFieldsCount: Integer; override;
    217251  public
    218252    TypeRef: TType;
    219253    Operation: TExpressionOperator;
    220254    Items: TExpressions;
     255    procedure GetValue(Index: Integer; out Value); override;
     256    function GetField(Index: Integer): TField; override;
     257    procedure SetValue(Index: Integer; var Value); override;
    221258    constructor Create;
    222259    destructor Destroy; override;
    … …  
    230267  TExpressionOperand = class(TExpression)
    231268  private
    232     function GetNode(Index: Integer): TSourceNode; override;
    233     function GetNodesCount: Integer; override;
    234     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     269    function GetFieldsCount: Integer; override;
    235270  public
    236271    OperandType: TExpressionOperandType;
    … …  
    239274    ConstantDirect: TConstant;
    240275    FunctionCall: TFunctionCall;
     276    procedure GetValue(Index: Integer; out Value); override;
     277    function GetField(Index: Integer): TField; override;
     278    procedure SetValue(Index: Integer; var Value); override;
    241279    function GetType: TType; override;
    242280    constructor Create;
    … …  
    251289  TAssignment = class(TCommand)
    252290  private
    253     function GetNode(Index: Integer): TSourceNode; override;
    254     function GetNodesCount: Integer; override;
    255     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     291    function GetFieldsCount: Integer; override;
    256292  public
    257293    Variable: TVariable;
    258294    Expression: TExpression;
     295    procedure GetValue(Index: Integer; out Value); override;
     296    function GetField(Index: Integer): TField; override;
     297    procedure SetValue(Index: Integer; var Value); override;
    259298    constructor Create;
    260299    destructor Destroy; override;
    … …  
    265304  TIfThenElse = class(TCommand)
    266305  private
    267     function GetNode(Index: Integer): TSourceNode; override;
    268     function GetNodesCount: Integer; override;
    269     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     306    function GetFieldsCount: Integer; override;
    270307  public
    271308    Expression: TExpression;
    272309    CommandThen: TCommand;
    273310    CommandElse: TCommand;
     311    procedure GetValue(Index: Integer; out Value); override;
     312    function GetField(Index: Integer): TField; override;
     313    procedure SetValue(Index: Integer; var Value); override;
    274314    constructor Create;
    275315    destructor Destroy; override;
    … …  
    280320  TWhileDo = class(TCommand)
    281321  private
    282     function GetNode(Index: Integer): TSourceNode; override;
    283     function GetNodesCount: Integer; override;
    284     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     322    function GetFieldsCount: Integer; override;
    285323  public
    286324    Expression: TExpression;
    287325    Command: TCommand;
     326    procedure GetValue(Index: Integer; out Value); override;
     327    function GetField(Index: Integer): TField; override;
     328    procedure SetValue(Index: Integer; var Value); override;
    288329    constructor Create;
    289330    destructor Destroy; override;
    … …  
    294335  TRepeatUntil = class(TCommand)
    295336  private
    296     function GetNode(Index: Integer): TSourceNode; override;
    297     function GetNodesCount: Integer; override;
    298     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     337    function GetFieldsCount: Integer; override;
    299338  public
    300339    Expression: TExpression;
    301340    Commands: TCommands;
     341    procedure GetValue(Index: Integer; out Value); override;
     342    function GetField(Index: Integer): TField; override;
     343    procedure SetValue(Index: Integer; var Value); override;
    302344    constructor Create;
    303345    destructor Destroy; override;
    … …  
    314356  TForToDo = class(TCommand)
    315357  private
    316     function GetNode(Index: Integer): TSourceNode; override;
    317     function GetNodesCount: Integer; override;
    318     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     358    function GetFieldsCount: Integer; override;
    319359  public
    320360    VariableRef: TVariable;
    … …  
    322362    ExpressionTo: TExpression;
    323363    Command: TCommand;
     364    procedure GetValue(Index: Integer; out Value); override;
     365    function GetField(Index: Integer): TField; override;
     366    procedure SetValue(Index: Integer; var Value); override;
    324367    constructor Create;
    325368    destructor Destroy; override;
    … …  
    330373  TBlock = class(TSourceNode)
    331374  private
    332     function GetNode(Index: Integer): TSourceNode; override;
    333     function GetNodesCount: Integer; override;
    334     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     375    function GetFieldsCount: Integer; override;
    335376  public
    336377    Parent: TBlock;
    … …  
    340381    Types: TTypes;
    341382    BeginEnd: TBeginEnd;
     383    procedure GetValue(Index: Integer; out Value); override;
     384    function GetField(Index: Integer): TField; override;
     385    procedure SetValue(Index: Integer; var Value); override;
    342386    procedure Clear;
    343387    function GetType(Name: string): TType;
    … …  
    353397  TProgram = class(TSourceNode)
    354398  private
    355     function GetNode(Index: Integer): TSourceNode; override;
    356     function GetNodesCount: Integer; override;
    357     procedure SetNode(Index: Integer; AValue: TSourceNode); override;
     399    function GetFieldsCount: Integer; override;
    358400  public
    359401    Name: string;
    360402    SystemBlock: TBlock;
    361403    Block: TBlock;
     404    procedure GetValue(Index: Integer; out Value); override;
     405    function GetField(Index: Integer): TField; override;
     406    procedure SetValue(Index: Integer; var Value); override;
    362407    procedure Clear;
    363408    constructor Create;
    … …  
    365410  end;
    366411
     412  const
     413    DataTypeStr: array[TDataType] of string = ('None', 'String', 'Boolean',
     414      'Integer', 'Float', 'Color', 'Time', 'Date', 'DateTime', 'Enumeration',
     415      'Reference');
     416
    367417
    368418implementation
    … …  
    370420resourcestring
    371421  SIndexError = 'Index error';
     422  SUnsupportedValueIndex = 'Unsupported value index %d';
     423  SUnsupportedDataType = 'Unsupported field value data type %s';
     424  SYes = 'Yes';
     425  SNo = 'No';
     426
     427{ TField }
     428
     429constructor TField.Create(ADataType: TDataType; AName: string);
     430begin
     431  DataType := ADataType;
     432  Name := AName;
     433end;
    372434
    373435{ TSourceNodes }
    … …  
    411473{ TVariable }
    412474
    413 function TVariable.GetNode(Index: Integer): TSourceNode;
    414 begin
    415   if Index = 0 then Result := TypeRef
    416   else raise Exception.Create(SIndexError);
    417 end;
    418 
    419 function TVariable.GetNodesCount: Integer;
    420 begin
    421   Result := 1;
    422 end;
    423 
    424 procedure TVariable.SetNode(Index: Integer; AValue: TSourceNode);
    425 begin
    426   if Index = 0 then TypeRef := TType(AValue)
    427   else raise Exception.Create(SIndexError);
     475procedure TVariable.GetValue(Index: Integer; out Value);
     476begin
     477  if Index = 0 then string(Value) := Name
     478  else if Index = 1 then TType(Value) := TypeRef
     479  else inherited;
     480end;
     481
     482function TVariable.GetField(Index: Integer): TField;
     483begin
     484  if Index = 0 then Result := TField.Create(dtString, 'Name')
     485  else if Index = 1 then Result := TField.Create(dtObject, 'Type')
     486  else inherited;
     487end;
     488
     489function TVariable.GetFieldsCount: Integer;
     490begin
     491  Result := 2;
     492end;
     493
     494procedure TVariable.SetValue(Index: Integer; var Value);
     495begin
     496  if Index = 0 then Name := string(Value)
     497  else if Index = 1 then TypeRef := TType(Value)
     498  else inherited;
    428499end;
    429500
    430501{ TConstant }
    431502
    432 function TConstant.GetNode(Index: Integer): TSourceNode;
    433 begin
    434   if Index = 0 then Result := TypeRef
    435   else raise Exception.Create(SIndexError);
    436 end;
    437 
    438 function TConstant.GetNodesCount: Integer;
    439 begin
    440   Result := 1;
    441 end;
    442 
    443 procedure TConstant.SetNode(Index: Integer; AValue: TSourceNode);
    444 begin
    445   if Index = 0 then TypeRef := TType(AValue)
    446   else raise Exception.Create(SIndexError);
     503procedure TConstant.GetValue(Index: Integer; out Value);
     504begin
     505  if Index = 0 then string(Value) := Name
     506  else if Index = 1 then TType(Value) := TypeRef
     507  else inherited;
     508end;
     509
     510function TConstant.GetField(Index: Integer): TField;
     511begin
     512  if Index = 0 then Result := TField.Create(dtString, 'Name')
     513  else if Index = 1 then Result := TField.Create(dtObject, 'Type')
     514  else inherited;
     515end;
     516
     517function TConstant.GetFieldsCount: Integer;
     518begin
     519  Result := 2;
     520end;
     521
     522procedure TConstant.SetValue(Index: Integer; var Value);
     523begin
     524  if Index = 0 then Name := string(Value)
     525  else if Index = 1 then TypeRef := TType(Value)
     526  else inherited;
    447527end;
    448528
    449529{ TSourceNode }
    450530
    451 function TSourceNode.GetNode(Index: Integer): TSourceNode;
    452 begin
    453   raise Exception.Create(SIndexError);
    454 end;
    455 
    456 function TSourceNode.GetNodesCount: Integer;
     531procedure TSourceNode.GetValue(Index: Integer; out Value);
     532begin
     533  raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
     534end;
     535
     536function TSourceNode.GetFieldsCount: Integer;
    457537begin
    458538  Result := 0;
    459539end;
    460540
    461 procedure TSourceNode.SetNode(Index: Integer; AValue: TSourceNode);
    462 begin
    463   raise Exception.Create(SIndexError);
     541function TSourceNode.GetField(Index: Integer): TField;
     542begin
     543  Result := nil;
     544  raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
     545end;
     546
     547procedure TSourceNode.SetValue(Index: Integer; var Value);
     548begin
     549  raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
     550end;
     551
     552function TSourceNode.GetValueInteger(Index: Integer): Integer;
     553begin
     554  GetValue(Index, Result);
     555end;
     556
     557function TSourceNode.GetValueString(Index: Integer): string;
     558begin
     559  GetValue(Index, Result);
     560end;
     561
     562function TSourceNode.GetValueBoolean(Index: Integer): Boolean;
     563begin
     564  GetValue(Index, Result);
     565end;
     566
     567function TSourceNode.GetValueObject(Index: Integer): TObject;
     568begin
     569  GetValue(Index, Result);
     570end;
     571
     572function TSourceNode.GetValueAsText(Index: Integer): string;
     573var
     574  Field: TField;
     575  Item: TObject;
     576begin
     577  Field := GetField(Index);
     578  try
     579    if Field.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index))
     580    else if Field.DataType = dtString then Result := GetValueString(Index)
     581    //else if Field.DataType = dtEnumeration then Result := Field.EnumStates[Integer(GetValueEnumeration(Index))]
     582    else if Field.DataType = dtObject then begin
     583      Item := TObject(GetValueObject(Index));
     584      if Assigned(Item) then Result := Item.ClassName
     585        else Result := '';
     586    end else if Field.DataType = dtBoolean then begin
     587      if GetValueBoolean(Index) then Result := SYes else Result := SNo;
     588    end else
     589      raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
     590  finally
     591    Field.Free;
     592  end;
     593end;
     594
     595
     596procedure TSourceNode.SetValueInteger(Index: Integer; Value: Integer);
     597begin
     598  SetValue(Index, Value);
     599end;
     600
     601procedure TSourceNode.SetValueString(Index: Integer; Value: string);
     602begin
     603  SetValue(Index, Value);
     604end;
     605
     606procedure TSourceNode.SetValueBoolean(Index: Integer; Value: Boolean);
     607begin
     608  SetValue(Index, Value);
     609end;
     610
     611procedure TSourceNode.SetValueObject(Index: Integer; Value: TObject);
     612begin
     613  SetValue(Index, Value);
     614end;
     615
     616function TSourceNode.GetFields: TFields;
     617var
     618  I: Integer;
     619begin
     620  Result := TFields.Create;
     621  for I := 0 to GetFieldsCount - 1 do
     622    Result.Add(GetField(I));
    464623end;
    465624
    466625{ TRepeatUntil }
    467626
    468 function TRepeatUntil.GetNode(Index: Integer): TSourceNode;
    469 begin
    470   if Index = 0 then Result := Expression
    471   else if Index = 1 then Result := Commands
    472   else raise Exception.Create(SIndexError);
    473 end;
    474 
    475 function TRepeatUntil.GetNodesCount: Integer;
     627procedure TRepeatUntil.GetValue(Index: Integer; out Value);
     628begin
     629  if Index = 0 then TExpression(Value) := Expression
     630  else if Index = 1 then TCommands(Value) := Commands
     631  else inherited;
     632end;
     633
     634function TRepeatUntil.GetField(Index: Integer): TField;
     635begin
     636  if Index = 0 then Result := TField.Create(dtObject, 'Expression')
     637  else if Index = 1 then Result := TField.Create(dtObject, 'Commands')
     638  else inherited;
     639end;
     640
     641function TRepeatUntil.GetFieldsCount: Integer;
    476642begin
    477643  Result := 2;
    478644end;
    479645
    480 procedure TRepeatUntil.SetNode(Index: Integer; AValue: TSourceNode);
    481 begin
    482   if Index = 0 then Expression := TExpression(AValue)
    483   else if Index = 1 then Commands := TCommands(AValue)
    484   else raise Exception.Create(SIndexError);
     646procedure TRepeatUntil.SetValue(Index: Integer; var Value);
     647begin
     648  if Index = 0 then Expression := TExpression(Value)
     649  else if Index = 1 then Commands := TCommands(Value)
     650  else inherited;
    485651end;
    486652
    … …  
    531697{ TForToDo }
    532698
    533 function TForToDo.GetNode(Index: Integer): TSourceNode;
    534 begin
    535   if Index = 0 then Result := VariableRef
    536   else if Index = 1 then Result := ExpressionFrom
    537   else if Index = 2 then Result := ExpressionTo
    538   else if Index = 3 then Result := Command
    539   else raise Exception.Create(SIndexError);
    540 end;
    541 
    542 function TForToDo.GetNodesCount: Integer;
     699procedure TForToDo.GetValue(Index: Integer; out Value);
     700begin
     701  if Index = 0 then TVariable(Value) := VariableRef
     702  else if Index = 1 then TExpression(Value) := ExpressionFrom
     703  else if Index = 2 then TExpression(Value) := ExpressionTo
     704  else if Index = 3 then TCommand(Value) := Command
     705  else inherited;
     706end;
     707
     708function TForToDo.GetField(Index: Integer): TField;
     709begin
     710  if Index = 0 then Result := TField.Create(dtObject, 'Variable')
     711  else if Index = 1 then Result := TField.Create(dtObject, 'To')
     712  else if Index = 2 then Result := TField.Create(dtObject, 'From')
     713  else if Index = 3 then Result := TField.Create(dtObject, 'Do')
     714  else inherited;
     715end;
     716
     717function TForToDo.GetFieldsCount: Integer;
    543718begin
    544719  Result := 4;
    545720end;
    546721
    547 procedure TForToDo.SetNode(Index: Integer; AValue: TSourceNode);
    548 begin
    549   if Index = 0 then VariableRef := TVariable(AValue)
    550   else if Index = 1 then ExpressionFrom := TExpression(AValue)
    551   else if Index = 2 then ExpressionTo := TExpression(AValue)
    552   else if Index = 3 then Command := TCommand(AValue)
    553   else raise Exception.Create(SIndexError);
     722procedure TForToDo.SetValue(Index: Integer; var Value);
     723begin
     724  if Index = 0 then VariableRef := TVariable(Value)
     725  else if Index = 1 then ExpressionFrom := TExpression(Value)
     726  else if Index = 2 then ExpressionTo := TExpression(Value)
     727  else if Index = 3 then Command := TCommand(Value)
     728  else inherited;
    554729end;
    555730
    … …  
    578753{ TExpressionOperand }
    579754
    580 function TExpressionOperand.GetNode(Index: Integer): TSourceNode;
     755procedure TExpressionOperand.GetValue(Index: Integer; out Value);
    581756begin
    582757  if Index = 0 then begin
    583758    case OperandType of
    584       otConstantDirect: Result := ConstantDirect;
    585       otConstantRef: Result := ConstantRef;
    586       otFunctionCall: Result := FunctionCall;
    587       otVariableRef: Result := VariableRef;
     759      otConstantDirect: TConstant(Value) := ConstantDirect;
     760      otConstantRef: TConstant(Value) := ConstantRef;
     761      otFunctionCall: TFunctionCall(Value) := FunctionCall;
     762      otVariableRef: TVariable(Value) := VariableRef;
    588763    end;
    589764  end
    590   else raise Exception.Create(SIndexError);
    591 end;
    592 
    593 function TExpressionOperand.GetNodesCount: Integer;
     765  else inherited;
     766end;
     767
     768function TExpressionOperand.GetField(Index: Integer): TField;
     769begin
     770  if Index = 0 then Result := TField.Create(dtObject, 'Value')
     771  else inherited;
     772end;
     773
     774function TExpressionOperand.GetFieldsCount: Integer;
    594775begin
    595776  Result := 1;
    596777end;
    597778
    598 procedure TExpressionOperand.SetNode(Index: Integer; AValue: TSourceNode);
     779procedure TExpressionOperand.SetValue(Index: Integer; var Value);
    599780begin
    600781  if Index = 0 then begin
    601782    case OperandType of
    602       otConstantDirect: ConstantDirect := TConstant(AValue);
    603       otConstantRef: ConstantRef := TConstant(AValue);
    604       otFunctionCall: FunctionCall := TFunctionCall(AValue);
    605       otVariableRef: VariableRef := TVariable(AValue);
     783      otConstantDirect: ConstantDirect := TConstant(Value);
     784      otConstantRef: ConstantRef := TConstant(Value);
     785      otFunctionCall: FunctionCall := TFunctionCall(Value);
     786      otVariableRef: VariableRef := TVariable(Value);
    606787    end;
    607788  end
    608   else raise Exception.Create(SIndexError);
     789  else inherited;
    609790end;
    610791
    … …  
    649830{ TFunction }
    650831
    651 function TFunction.GetNode(Index: Integer): TSourceNode;
    652 begin
    653   if Index = 0 then Result := BeginEnd
    654   else if Index = 1 then Result := Params
    655   else if Index = 2 then Result := ResultType
    656   else raise Exception.Create(SIndexError);
    657 end;
    658 
    659 function TFunction.GetNodesCount: Integer;
    660 begin
    661   Result := 3;
    662 end;
    663 
    664 procedure TFunction.SetNode(Index: Integer; AValue: TSourceNode);
    665 begin
    666   if Index = 0 then BeginEnd := TBeginEnd(AValue)
    667   else if Index = 1 then Params := TFunctionParameters(AValue)
    668   else if Index = 2 then ResultType := TType(AValue)
    669   else raise Exception.Create(SIndexError);
     832procedure TFunction.GetValue(Index: Integer; out Value);
     833begin
     834  if Index = 0 then TBeginEnd(Value) := BeginEnd
     835  else if Index = 1 then TFunctionParameters(Value) := Params
     836  else if Index = 2 then TType(Value) := ResultType
     837  else if Index = 3 then string(Value) := Name
     838  else inherited;
     839end;
     840
     841function TFunction.GetField(Index: Integer): TField;
     842begin
     843  if Index = 0 then Result := TField.Create(dtObject, 'Block')
     844  else if Index = 1 then Result := TField.Create(dtObject, 'Parameters')
     845  else if Index = 2 then Result := TField.Create(dtObject, 'ResultType')
     846  else if Index = 3 then Result := TField.Create(dtString, 'Name')
     847  else inherited;
     848end;
     849
     850function TFunction.GetFieldsCount: Integer;
     851begin
     852  Result := 4;
     853end;
     854
     855procedure TFunction.SetValue(Index: Integer; var Value);
     856begin
     857  if Index = 0 then BeginEnd := TBeginEnd(Value)
     858  else if Index = 1 then Params := TFunctionParameters(Value)
     859  else if Index = 2 then ResultType := TType(Value)
     860  else if Index = 3 then Name := string(Value)
     861  else inherited;
    670862end;
    671863
    … …  
    684876
    685877{ TType }
     878
     879procedure TType.GetValue(Index: Integer; out Value);
     880begin
     881  if Index = 0 then string(Value) := Name
     882  else inherited;
     883end;
     884
     885function TType.GetField(Index: Integer): TField;
     886begin
     887  if Index = 0 then Result := TField.Create(dtString, 'Name')
     888  else inherited;
     889end;
     890
     891function TType.GetFieldsCount: Integer;
     892begin
     893  Result := 1;
     894end;
     895
     896procedure TType.SetValue(Index: Integer; var Value);
     897begin
     898  if Index = 0 then Name := string(Value)
     899  else inherited;
     900end;
    686901
    687902constructor TType.Create;
    … …  
    717932{ TExpressionOperation }
    718933
    719 function TExpressionOperation.GetNode(Index: Integer): TSourceNode;
    720 begin
    721   Result := TSourceNode(Items[Index]);
    722 end;
    723 
    724 function TExpressionOperation.GetNodesCount: Integer;
     934procedure TExpressionOperation.GetValue(Index: Integer; out Value);
     935begin
     936  TObject(Value) := Items[Index];
     937end;
     938
     939function TExpressionOperation.GetField(Index: Integer): TField;
     940begin
     941  if Index < Items.Count then Result := TField.Create(dtObject, 'Expression')
     942  else inherited;
     943end;
     944
     945function TExpressionOperation.GetFieldsCount: Integer;
    725946begin
    726947  Result := Items.Count;
    727948end;
    728949
    729 procedure TExpressionOperation.SetNode(Index: Integer; AValue: TSourceNode);
    730 begin
    731   Items[Index] := AValue;
     950procedure TExpressionOperation.SetValue(Index: Integer; var Value);
     951begin
     952  Items[Index] := TObject(Value);
    732953end;
    733954
    … …  
    750971{ TAssignment }
    751972
    752 function TAssignment.GetNode(Index: Integer): TSourceNode;
    753 begin
    754   if Index = 0 then Result := Expression
    755   else if Index = 1 then Result := Variable
    756   else raise Exception.Create(SIndexError);
    757 end;
    758 
    759 function TAssignment.GetNodesCount: Integer;
     973procedure TAssignment.GetValue(Index: Integer; out Value);
     974begin
     975  if Index = 0 then TExpression(Value) := Expression
     976  else if Index = 1 then TVariable(Value) := Variable
     977  else inherited;
     978end;
     979
     980function TAssignment.GetField(Index: Integer): TField;
     981begin
     982  if Index = 0 then Result := TField.Create(dtObject, 'Expression')
     983  else if Index = 1 then Result := TField.Create(dtObject, 'Variable')
     984  else inherited;
     985end;
     986
     987function TAssignment.GetFieldsCount: Integer;
    760988begin
    761989  Result := 2;
    762990end;
    763991
    764 procedure TAssignment.SetNode(Index: Integer; AValue: TSourceNode);
    765 begin
    766   if Index = 0 then Expression := TExpression(AValue)
    767   else if Index = 1 then Variable := TVariable(AValue)
    768   else raise Exception.Create(SIndexError);
     992procedure TAssignment.SetValue(Index: Integer; var Value);
     993begin
     994  if Index = 0 then Expression := TExpression(Value)
     995  else if Index = 1 then Variable := TVariable(Value)
     996  else inherited;
    769997end;
    770998
    … …  
    7841012{ TIfThenElse }
    7851013
    786 function TIfThenElse.GetNode(Index: Integer): TSourceNode;
    787 begin
    788   if Index = 0 then Result := Expression
    789   else if Index = 1 then Result := CommandElse
    790   else if Index = 2 then Result := CommandThen
    791   else raise Exception.Create(SIndexError);
    792 end;
    793 
    794 function TIfThenElse.GetNodesCount: Integer;
     1014procedure TIfThenElse.GetValue(Index: Integer; out Value);
     1015begin
     1016  if Index = 0 then TExpression(Value) := Expression
     1017  else if Index = 1 then TCommand(Value) := CommandElse
     1018  else if Index = 2 then TCommand(Value) := CommandThen
     1019  else inherited;
     1020end;
     1021
     1022function TIfThenElse.GetField(Index: Integer): TField;
     1023begin
     1024  if Index = 0 then Result := TField.Create(dtObject, 'Expression')
     1025  else if Index = 1 then Result := TField.Create(dtObject, 'Else')
     1026  else if Index = 2 then Result := TField.Create(dtObject, 'Then')
     1027  else inherited;
     1028end;
     1029
     1030function TIfThenElse.GetFieldsCount: Integer;
    7951031begin
    7961032  Result := 3;
    7971033end;
    7981034
    799 procedure TIfThenElse.SetNode(Index: Integer; AValue: TSourceNode);
    800 begin
    801   if Index = 0 then Expression := TExpression(AValue)
    802   else if Index = 1 then CommandElse := TCommand(AValue)
    803   else if Index = 2 then CommandThen := TCommand(AValue)
    804   else raise Exception.Create(SIndexError);
     1035procedure TIfThenElse.SetValue(Index: Integer; var Value);
     1036begin
     1037  if Index = 0 then Expression := TExpression(Value)
     1038  else if Index = 1 then CommandElse := TCommand(Value)
     1039  else if Index = 2 then CommandThen := TCommand(Value)
     1040  else inherited;
    8051041end;
    8061042
    … …  
    8221058{ TWhileDo }
    8231059
    824 function TWhileDo.GetNode(Index: Integer): TSourceNode;
    825 begin
    826   Result:=inherited GetNode(Index);
    827 end;
    828 
    829 function TWhileDo.GetNodesCount: Integer;
    830 begin
    831   Result:=inherited GetNodesCount;
    832 end;
    833 
    834 procedure TWhileDo.SetNode(Index: Integer; AValue: TSourceNode);
    835 begin
    836   inherited SetNode(Index, AValue);
     1060procedure TWhileDo.GetValue(Index: Integer; out Value);
     1061begin
     1062  if Index = 0 then TExpression(Value) := Expression
     1063  else if Index = 1 then TCommand(Value) := Command
     1064  else inherited;
     1065end;
     1066
     1067function TWhileDo.GetField(Index: Integer): TField;
     1068begin
     1069  if Index = 0 then Result := TField.Create(dtObject, 'Expression')
     1070  else if Index = 1 then Result := TField.Create(dtObject, 'Do')
     1071  else inherited;
     1072end;
     1073
     1074function TWhileDo.GetFieldsCount: Integer;
     1075begin
     1076  Result := 2;
     1077end;
     1078
     1079procedure TWhileDo.SetValue(Index: Integer; var Value);
     1080begin
     1081  if Index = 0 then Expression := TExpression(Value)
     1082  else if Index = 1 then Command := TCommand(Value)
     1083  else inherited;
    8371084end;
    8381085
    … …  
    8521099{ TFunctionCall }
    8531100
    854 function TFunctionCall.GetNode(Index: Integer): TSourceNode;
    855 begin
    856   if Index = 0 then Result := FunctionDef
    857   else if Index = 1 then Result := Params
    858   else raise Exception.Create(SIndexError);
    859 end;
    860 
    861 function TFunctionCall.GetNodesCount: Integer;
     1101procedure TFunctionCall.GetValue(Index: Integer; out Value);
     1102begin
     1103  if Index = 0 then TFunction(Value) := FunctionDef
     1104  else if Index = 1 then TExpressions(Value) := Params
     1105  else inherited;
     1106end;
     1107
     1108function TFunctionCall.GetField(Index: Integer): TField;
     1109begin
     1110  if Index = 0 then Result := TField.Create(dtObject, 'Function')
     1111  else if Index = 1 then Result := TField.Create(dtObject, 'Parameters')
     1112  else inherited;
     1113end;
     1114
     1115function TFunctionCall.GetFieldsCount: Integer;
    8621116begin
    8631117  Result := 2;
    8641118end;
    8651119
    866 procedure TFunctionCall.SetNode(Index: Integer; AValue: TSourceNode);
    867 begin
    868   if Index = 0 then FunctionDef := TFunction(AValue)
    869   else if Index = 1 then Params := TExpressions(AValue)
    870   else raise Exception.Create(SIndexError);
     1120procedure TFunctionCall.SetValue(Index: Integer; var Value);
     1121begin
     1122  if Index = 0 then FunctionDef := TFunction(Value)
     1123  else if Index = 1 then Params := TExpressions(Value)
     1124  else inherited;
    8711125end;
    8721126
    … …  
    9341188{ TBlock }
    9351189
    936 function TBlock.GetNode(Index: Integer): TSourceNode;
    937 begin
    938   if Index = 0 then Result := BeginEnd
    939   else if Index = 1 then Result := Types
    940   else if Index = 2 then Result := Variables
    941   else if Index = 3 then Result := Constants
    942   else if Index = 4 then Result := Functions
    943   else raise Exception.Create(SIndexError);
    944 end;
    945 
    946 function TBlock.GetNodesCount: Integer;
     1190procedure TBlock.GetValue(Index: Integer; out Value);
     1191begin
     1192  if Index = 0 then TBeginEnd(Value) := BeginEnd
     1193  else if Index = 1 then TTypes(Value) := Types
     1194  else if Index = 2 then TVariables(Value) := Variables
     1195  else if Index = 3 then TConstants(Value) := Constants
     1196  else if Index = 4 then TFunctions(Value) := Functions
     1197  else inherited;
     1198end;
     1199
     1200function TBlock.GetField(Index: Integer): TField;
     1201begin
     1202  if Index = 0 then Result := TField.Create(dtObject, 'Block')
     1203  else if Index = 1 then Result := TField.Create(dtObject, 'Types')
     1204  else if Index = 2 then Result := TField.Create(dtObject, 'Variables')
     1205  else if Index = 3 then Result := TField.Create(dtObject, 'Constants')
     1206  else if Index = 4 then Result := TField.Create(dtObject, 'Functions')
     1207  else inherited;
     1208end;
     1209
     1210function TBlock.GetFieldsCount: Integer;
    9471211begin
    9481212  Result := 5;
    9491213end;
    9501214
    951 procedure TBlock.SetNode(Index: Integer; AValue: TSourceNode);
    952 begin
    953   if Index = 0 then BeginEnd := TBeginEnd(AValue)
    954   else if Index = 1 then Types := TTypes(AValue)
    955   else if Index = 2 then Variables := TVariables(AValue)
    956   else if Index = 3 then Constants := TConstants(AValue)
    957   else if Index = 4 then Functions := TFunctions(AValue)
    958   else raise Exception.Create(SIndexError);
     1215procedure TBlock.SetValue(Index: Integer; var Value);
     1216begin
     1217  if Index = 0 then BeginEnd := TBeginEnd(Value)
     1218  else if Index = 1 then Types := TTypes(Value)
     1219  else if Index = 2 then Variables := TVariables(Value)
     1220  else if Index = 3 then Constants := TConstants(Value)
     1221  else if Index = 4 then Functions := TFunctions(Value)
     1222  else inherited;
    9591223end;
    9601224
    … …  
    10161280{ TBeginEnd }
    10171281
    1018 function TBeginEnd.GetNode(Index: Integer): TSourceNode;
    1019 begin
    1020   if Index = 0 then Result := Commands
    1021   else raise Exception.Create(SIndexError);
    1022 end;
    1023 
    1024 function TBeginEnd.GetNodesCount: Integer;
     1282procedure TBeginEnd.GetValue(Index: Integer; out Value);
     1283begin
     1284  if Index = 0 then TCommands(Value) := Commands
     1285  else inherited;
     1286end;
     1287
     1288function TBeginEnd.GetField(Index: Integer): TField;
     1289begin
     1290  if Index = 0 then Result := TField.Create(dtObject, 'Command')
     1291  else inherited;
     1292end;
     1293
     1294function TBeginEnd.GetFieldsCount: Integer;
    10251295begin
    10261296  Result := 1;
    10271297end;
    10281298
    1029 procedure TBeginEnd.SetNode(Index: Integer; AValue: TSourceNode);
    1030 begin
    1031   if Index = 0 then Commands := TCommands(AValue)
    1032   else raise Exception.Create(SIndexError);
     1299procedure TBeginEnd.SetValue(Index: Integer; var Value);
     1300begin
     1301  if Index = 0 then Commands := TCommands(Value)
     1302  else inherited;
    10331303end;
    10341304
    … …  
    10511321{ TProgram }
    10521322
    1053 function TProgram.GetNode(Index: Integer): TSourceNode;
    1054 begin
    1055   if Index = 0 then Result := Block
     1323procedure TProgram.GetValue(Index: Integer; out Value);
     1324begin
     1325  if Index = 0 then string(Value) := Name
     1326  else if Index = 1 then TBlock(Value) := Block
    10561327  else raise Exception.Create(SIndexError);
    10571328end;
    10581329
    1059 function TProgram.GetNodesCount: Integer;
    1060 begin
    1061   Result := 1;
    1062 end;
    1063 
    1064 procedure TProgram.SetNode(Index: Integer; AValue: TSourceNode);
    1065 begin
    1066   if Index = 0 then Block := TBlock(AValue)
     1330function TProgram.GetField(Index: Integer): TField;
     1331begin
     1332  if Index = 0 then Result := TField.Create(dtString, 'Name')
     1333  else if Index = 1 then Result := TField.Create(dtObject, 'Block')
     1334  else inherited;
     1335end;
     1336
     1337function TProgram.GetFieldsCount: Integer;
     1338begin
     1339  Result := 2;
     1340end;
     1341
     1342procedure TProgram.SetValue(Index: Integer; var Value);
     1343begin
     1344  if Index = 0 then Name := string(Value)
     1345  else if Index = 0 then Block := TBlock(Value)
    10671346  else raise Exception.Create(SIndexError);
    10681347end;
    … …  
    10871366
    10881367
    1089 
    10901368end.
    10911369
Note: See TracChangeset for help on using the changeset viewer.