Changeset 231


Ignore:
Timestamp:
Jun 26, 2023, 12:17:46 PM (18 months ago)
Author:
chronos
Message:
  • Modified: SourceNode classes moved into separate unit.
Location:
branches/xpascal
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed

  • branches/xpascal/Executor.pas

    r230 r231  
    159159implementation
    160160
     161uses
     162  SourceNode;
     163
    161164resourcestring
    162165  SUnsupportedOperandType = 'Unsupported exception operand type.';

  • branches/xpascal/Generators/GeneratorXml.pas

    r230 r231  
    44
    55uses
    6   Classes, SysUtils, Source, Generator;
     6  Classes, SysUtils, Source, SourceNode, Generator;
    77
    88type

  • branches/xpascal/Languages/xpascal.cs.po

    r230 r231  
    2525
    2626#: generatorxml.sunsupportednodetype
    27 #, fuzzy
    2827msgctxt "generatorxml.sunsupportednodetype"
    2928msgid "Unsupported node type"
    … …  
    4342msgstr "Chyba indexu"
    4443
    45 #: source.sno
     44#: sourcenode.sno
     45msgctxt "sourcenode.sno"
    4646msgid "No"
    4747msgstr "Ne"
    4848
    49 #: source.sunsupporteddatatype
     49#: sourcenode.sunsupporteddatatype
    5050#, object-pascal-format
     51msgctxt "sourcenode.sunsupporteddatatype"
    5152msgid "Unsupported field value data type %s"
    5253msgstr "NepodporovanÜ datovÜ typ pole %s"
    5354
    54 #: source.sunsupportedvalueindex
     55#: sourcenode.sunsupportedvalueindex
    5556#, object-pascal-format
     57msgctxt "sourcenode.sunsupportedvalueindex"
    5658msgid "Unsupported value index %d"
    5759msgstr "Nepodporovaná hodnota indexu %d"
    5860
    59 #: source.syes
     61#: sourcenode.syes
     62msgctxt "sourcenode.syes"
    6063msgid "Yes"
    6164msgstr "Ano"
    … …  
    149152msgid "Source:"
    150153msgstr "Zdroj:"
    151 

  • branches/xpascal/Languages/xpascal.pot

    r230 r231  
    3232msgstr ""
    3333
    34 #: source.sno
     34#: sourcenode.sno
     35msgctxt "sourcenode.sno"
    3536msgid "No"
    3637msgstr ""
    3738
    38 #: source.sunsupporteddatatype
     39#: sourcenode.sunsupporteddatatype
    3940#, object-pascal-format
     41msgctxt "sourcenode.sunsupporteddatatype"
    4042msgid "Unsupported field value data type %s"
    4143msgstr ""
    4244
    43 #: source.sunsupportedvalueindex
     45#: sourcenode.sunsupportedvalueindex
    4446#, object-pascal-format
     47msgctxt "sourcenode.sunsupportedvalueindex"
    4548msgid "Unsupported value index %d"
    4649msgstr ""
    4750
    48 #: source.syes
     51#: sourcenode.syes
     52msgctxt "sourcenode.syes"
    4953msgid "Yes"
    5054msgstr ""

  • branches/xpascal/Optimizer.pas

    r230 r231  
    44
    55uses
    6   Classes, SysUtils, Source;
     6  Classes, SysUtils, Source, SourceNode;
    77
    88type

  • branches/xpascal/Source.pas

    r230 r231  
    44
    55uses
    6   Classes, SysUtils, Generics.Collections;
     6  Classes, SysUtils, Generics.Collections, SourceNode;
    77
    88type
    … …  
    1111  TBeginEnd = class;
    1212  TBlock = class;
    13 
    14   TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,
    15     dtTime, dtDate, dtDateTime, dtEnumeration, dtObject);
    16 
    17   { TField }
    18 
    19   TField = class
    20     Index: Integer;
    21     DataType: TDataType;
    22     Name: string;
    23     constructor Create(ADataType: TDataType; AName: string);
    24   end;
    25 
    26   TFields = class(TObjectList<TField>)
    27   end;
    28 
    29   { TSourceNode }
    30 
    31   TSourceNode = class
    32   private
    33     function GetFieldsCount: Integer; virtual;
    34   public
    35     Parent: TSourceNode;
    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;
    50   end;
    51 
    52   { TSourceNodeList }
    53 
    54   TSourceNodeList<T> = class(TSourceNode)
    55   private
    56     Parent: TSourceNode;
    57     function GetCount: Integer;
    58     function GetItem(Index: Integer): T;
    59     procedure SetItem(Index: Integer; AValue: T);
    60   public
    61     List: TObjectList<TSourceNode>;
    62     procedure Clear;
    63     function Add(AObject: T): Integer;
    64     constructor Create;
    65     destructor Destroy; override;
    66     property Items[Index: Integer]: T read GetItem write SetItem; default;
    67     property Count: Integer read GetCount;
    68   end;
    6913
    7014  { TValue }
    … …  
    453397
    454398  const
    455     DataTypeStr: array[TDataType] of string = ('None', 'String', 'Boolean',
    456       'Integer', 'Float', 'Color', 'Time', 'Date', 'DateTime', 'Enumeration',
    457       'Reference');
    458399    ExpressionOperatorText: array[TExpressionOperator] of string = ('', '+',
    459400      '-', '*', '/', 'div', 'mod', 'and', 'xor', 'or', 'shl',
    … …  
    471412resourcestring
    472413  SIndexError = 'Index error';
    473   SUnsupportedValueIndex = 'Unsupported value index %d';
    474   SUnsupportedDataType = 'Unsupported field value data type %s';
    475   SYes = 'Yes';
    476   SNo = 'No';
    477414
    478415function GetOperatorByName(Name: string): TExpressionOperator;
    … …  
    560497end;
    561498
    562 { TField }
    563 
    564 constructor TField.Create(ADataType: TDataType; AName: string);
    565 begin
    566   DataType := ADataType;
    567   Name := AName;
    568 end;
    569 
    570 { TSourceNodeList }
    571 
    572 function TSourceNodeList<T>.GetCount: Integer;
    573 begin
    574   Result := List.Count;
    575 end;
    576 
    577 function TSourceNodeList<T>.GetItem(Index: Integer): T;
    578 begin
    579   Result := T(List[Index]);
    580 end;
    581 
    582 procedure TSourceNodeList<T>.SetItem(Index: Integer; AValue: T);
    583 begin
    584   List[Index] := AValue;
    585 end;
    586 
    587 procedure TSourceNodeList<T>.Clear;
    588 begin
    589   List.Clear;
    590 end;
    591 
    592 function TSourceNodeList<T>.Add(AObject: T): Integer;
    593 begin
    594   Result := List.Add(AObject);
    595 end;
    596 
    597 constructor TSourceNodeList<T>.Create;
    598 begin
    599   List := TObjectList<TSourceNode>.Create;
    600 end;
    601 
    602 destructor TSourceNodeList<T>.Destroy;
    603 begin
    604   FreeAndNil(List);
    605   inherited;
    606 end;
    607 
    608499{ TVariable }
    609500
    … …  
    666557  FreeAndNil(Value);
    667558  inherited;
    668 end;
    669 
    670 { TSourceNode }
    671 
    672 procedure TSourceNode.GetValue(Index: Integer; out Value);
    673 begin
    674   raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
    675 end;
    676 
    677 function TSourceNode.GetFieldsCount: Integer;
    678 begin
    679   Result := 0;
    680 end;
    681 
    682 function TSourceNode.GetField(Index: Integer): TField;
    683 begin
    684   Result := nil;
    685   raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
    686 end;
    687 
    688 procedure TSourceNode.SetValue(Index: Integer; var Value);
    689 begin
    690   raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
    691 end;
    692 
    693 function TSourceNode.GetValueInteger(Index: Integer): Integer;
    694 begin
    695   GetValue(Index, Result);
    696 end;
    697 
    698 function TSourceNode.GetValueString(Index: Integer): string;
    699 begin
    700   GetValue(Index, Result);
    701 end;
    702 
    703 function TSourceNode.GetValueBoolean(Index: Integer): Boolean;
    704 begin
    705   GetValue(Index, Result);
    706 end;
    707 
    708 function TSourceNode.GetValueObject(Index: Integer): TObject;
    709 begin
    710   GetValue(Index, Result);
    711 end;
    712 
    713 function TSourceNode.GetValueAsText(Index: Integer): string;
    714 var
    715   Field: TField;
    716   Item: TObject;
    717 begin
    718   Field := GetField(Index);
    719   try
    720     if Field.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index))
    721     else if Field.DataType = dtString then Result := GetValueString(Index)
    722     //else if Field.DataType = dtEnumeration then Result := Field.EnumStates[Integer(GetValueEnumeration(Index))]
    723     else if Field.DataType = dtObject then begin
    724       Item := TObject(GetValueObject(Index));
    725       if Assigned(Item) then Result := Item.ClassName
    726         else Result := '';
    727     end else if Field.DataType = dtBoolean then begin
    728       if GetValueBoolean(Index) then Result := SYes else Result := SNo;
    729     end else
    730       raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
    731   finally
    732     Field.Free;
    733   end;
    734 end;
    735 
    736 
    737 procedure TSourceNode.SetValueInteger(Index: Integer; Value: Integer);
    738 begin
    739   SetValue(Index, Value);
    740 end;
    741 
    742 procedure TSourceNode.SetValueString(Index: Integer; Value: string);
    743 begin
    744   SetValue(Index, Value);
    745 end;
    746 
    747 procedure TSourceNode.SetValueBoolean(Index: Integer; Value: Boolean);
    748 begin
    749   SetValue(Index, Value);
    750 end;
    751 
    752 procedure TSourceNode.SetValueObject(Index: Integer; Value: TObject);
    753 begin
    754   SetValue(Index, Value);
    755 end;
    756 
    757 function TSourceNode.GetFields: TFields;
    758 var
    759   I: Integer;
    760 begin
    761   Result := TFields.Create;
    762   for I := 0 to GetFieldsCount - 1 do
    763     Result.Add(GetField(I));
    764559end;
    765560

  • branches/xpascal/xpascal.lpi

    r230 r231  
    8585      </Item3>
    8686    </RequiredPackages>
    87     <Units Count="19">
     87    <Units Count="20">
    8888      <Unit0>
    8989        <Filename Value="xpascal.lpr"/>
    … …  
    177177        <ResourceBaseClass Value="Form"/>
    178178      </Unit18>
     179      <Unit19>
     180        <Filename Value="SourceNode.pas"/>
     181        <IsPartOfProject Value="True"/>
     182      </Unit19>
    179183    </Units>
    180184  </ProjectOptions>

  • branches/xpascal/xpascal.lpr

    r230 r231  
    1010  Forms, Parser, Tokenizer, Source, Executor, Interpreter, Generator,
    1111  FormMessages, FormSource, Optimizer, FormOutput, FormMain,
    12   ParserPascal, Tests, FormConsole;
     12  ParserPascal, Tests, FormConsole, SourceNode;
    1313
    1414{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.