source: branches/easy compiler/USourceCode.pas

unit USourceCode;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Contnrs;

type
  TSourceCommand = class
    Parent: TSourceCommand;
  end;

  TSourceCommands = class(TObjectList)
  end;

  TSourceReference = class
  end;

  TSourceReferences = class(TObjectList)
  end;

  { TSourceValue }

  TSourceValue = class
    procedure Assign(Source: TSourceValue); virtual;
    constructor Create; virtual;
  end;

  TSourceValues = class(TObjectList)
  end;

  TSourceValueClass = class of TSourceValue;

  { TSourceType }

  TSourceType = class
    Name: string;
    function GetValueType: TSourceValueClass; virtual;
  end;

  TSourceTypeClass = class of TSourceType;

  { TSourceTypes }

  TSourceTypes = class(TObjectList)
    Parent: TSourceTypes;
    function AddNew(Name: string; ClassType: TSourceTypeClass): TSourceType;
    function Search(Name: string): TSourceType;
  end;

  { TSourceTypeInteger }

  TSourceTypeInteger = class(TSourceType)
    function GetValueType: TSourceValueClass; override;
  end;

  { TSourceTypeString }

  TSourceTypeString = class(TSourceType)
    function GetValueType: TSourceValueClass; override;
  end;

  { TSourceTypeArray }

  TSourceTypeArray = class(TSourceType)
    ItemType: TSourceType;
    function GetValueType: TSourceValueClass; override;
  end;


  { TSourceVariable }

  TSourceVariable = class
    Name: string;
    ValueType: TSourceType;
  end;

  { TSourceVariables }

  TSourceVariables = class(TObjectList)
    Parent: TSourceVariables;
    function AddNew(Name: string; ValueType: TSourceType): TSourceVariable;
    function Search(Name: string): TSourceVariable;
  end;

  TSourceReferenceVariable = class(TSourceReference)
    Variable: TSourceVariable;
  end;

  TSourceReferenceArray = class(TSourceReference)
    ArrayRef: TSourceVariable;
    Index: TSourceReference;
  end;

  { TSourceValueString }

  TSourceValueString = class(TSourceValue)
    Value: string;
    procedure Assign(Source: TSourceValue); override;
  end;

  { TSourceValueInteger }

  TSourceValueInteger = class(TSourceValue)
    Value: Integer;
    procedure Assign(Source: TSourceValue); override;
  end;

  { TSourceValueArray }

  TSourceValueArray = class(TSourceValue)
    Items: TSourceValues;
    procedure Assign(Source: TSourceValue); override;
    constructor Create; override;
    destructor Destroy; override;
  end;

  { TSourceConstant }

  TSourceConstant = class
    Name: string;
    Value: TSourceValue;
    destructor Destroy; override;
  end;

  TSourceParameterKind = (pkString, pkVariable, pkType);

  TSourceFunctionParameter = class
    Name: string;
    Kind: TSourceParameterKind;
  end;

  TSourceFunctionParameters = class(TObjectList)
  end;

  { TSourceFunction }

  TSourceFunction = class
    Name: string;
    Parameters: TSourceFunctionParameters;
    procedure AddParameter(Name: string; Kind: TSourceParameterKind);
    constructor Create;
    destructor Destroy; override;
  end;

  { TSourceFunctions }

  TSourceFunctions = class(TObjectList)
    function AddNew(Name: string): TSourceFunction;
    function Search(Name: string): TSourceFunction;
  end;

  { TSourceConstants }

  TSourceConstants = class(TObjectList)
    Parent: TSourceConstants;
    function AddNewString(Value: string; Name: string = ''): TSourceConstant;
    function AddNewInteger(Value: Integer; Name: string = ''): TSourceConstant;
    function Search(Name: string): TSourceConstant;
  end;

  TSourceReferenceConstant = class(TSourceReference)
    Constant: TSourceConstant;
  end;

  { TCommandFunctionCall }

  TCommandFunctionCall = class(TSourceCommand)
    Name: string;
    Parameters: TSourceReferences;
    constructor Create;
    destructor Destroy; override;
  end;

  TSourceCode = class;

  { TCommandBeginEnd }

  TCommandBeginEnd = class(TSourceCommand)
    SourceCode: TSourceCode;
    Commands: TSourceCommands;
    constructor Create;
    destructor Destroy; override;
  end;

  { TCommandIfEqual }

  TCommandIfEqual = class(TSourceCommand)
    Reference1: TSourceReference;
    Reference2: TSourceReference;
    destructor Destroy; override;
  end;

  { TCommandIfNotEqual }

  TCommandIfNotEqual = class(TSourceCommand)
    Reference1: TSourceReference;
    Reference2: TSourceReference;
    destructor Destroy; override;
  end;

  { TCommandRepeat }

  TCommandRepeat = class(TSourceCommand)
    Command: TSourceCommand;
    destructor Destroy; override;
  end;

  TCommandBreak = class(TSourceCommand)
  end;

  TCommandContinue = class(TSourceCommand)
  end;

  { TSourceCode }

  TSourceCode = class
  private
    procedure InitFunctions;
  public
    Functions: TSourceFunctions;
    Types: TSourceTypes;
    Variables: TSourceVariables;
    Constants: TSourceConstants;
    Main: TCommandBeginEnd;
    constructor Create;
    destructor Destroy; override;
  end;


implementation

{ TCommandIfNotEqual }

destructor TCommandIfNotEqual.Destroy;
begin
  Reference1.Free;
  Reference2.Free;
  inherited Destroy;
end;

{ TSourceType }

function TSourceType.GetValueType: TSourceValueClass;
begin
  Result := nil;
end;

{ TSourceTypeInteger }

function TSourceTypeInteger.GetValueType: TSourceValueClass;
begin
  Result := TSourceValueInteger;
end;

{ TSourceTypeString }

function TSourceTypeString.GetValueType: TSourceValueClass;
begin
  Result := TSourceValueString;
end;

{ TSourceTypeArray }

function TSourceTypeArray.GetValueType: TSourceValueClass;
begin
  Result := TSourceValueArray;
end;

{ TSourceValueArray }

procedure TSourceValueArray.Assign(Source: TSourceValue);
var
  I: Integer;
  Value: TSourceValue;
begin
  if Source is TSourceValueInteger then begin
    while Items.Count < TSourceValueArray(Source).Items.Count do begin
      Value := TSourceValue(TSourceValue(TSourceValueArray(Source).Items[Items.Count]).ClassType.Create);
      Items.Add(Value);
    end;
    while Items.Count > TSourceValueArray(Source).Items.Count do begin
      Items.Delete(Items.Count - 1);
    end;
    for I := 0 to Items.Count - 1 do
      TSourceValue(Items[I]).Assign(TSourceValue(TSourceValueArray(Source).Items[I]));
  end else raise Exception.Create('Type for assignment not matches');
end;

constructor TSourceValueArray.Create;
begin
  Items := TSourceValues.Create;
end;

destructor TSourceValueArray.Destroy;
begin
  Items.Free;
  inherited Destroy;
end;

{ TCommandIfEqual }

destructor TCommandIfEqual.Destroy;
begin
  Reference1.Free;
  Reference2.Free;
  inherited Destroy;
end;

{ TCommandRepeat }

destructor TCommandRepeat.Destroy;
begin
  Command.Free;
  inherited Destroy;
end;

{ TSourceConstant }

destructor TSourceConstant.Destroy;
begin
  Value.Free;
  inherited Destroy;
end;

{ TCommandFunctionCall }

constructor TCommandFunctionCall.Create;
begin
  Parameters := TSourceReferences.Create;
end;

destructor TCommandFunctionCall.Destroy;
begin
  Parameters.Free;
  inherited Destroy;
end;

{ TCommandBeginEnd }

constructor TCommandBeginEnd.Create;
begin
  Commands := TSourceCommands.Create;
end;

destructor TCommandBeginEnd.Destroy;
begin
  Commands.Free;
  inherited Destroy;
end;

{ TSourceTypes }

function TSourceTypes.AddNew(Name: string; ClassType: TSourceTypeClass): TSourceType;
begin
  Result := ClassType.Create;
  Result.Name := Name;
  Add(Result);
end;

function TSourceTypes.Search(Name: string): TSourceType;
var
  Item: TSourceType;
begin
  Result := nil;
  for Item in Self do
  if Item.Name = Name then begin
    Result := Item;
    Break;
  end;
  if not Assigned(Result) and Assigned(Parent) then
    Result := Parent.Search(Name);
end;

{ TSourceValue }

procedure TSourceValue.Assign(Source: TSourceValue);
begin
  raise Exception.Create('Value assign not implemented');
end;

constructor TSourceValue.Create;
begin
end;

{ TSourceValueInteger }

procedure TSourceValueInteger.Assign(Source: TSourceValue);
begin
  if Source is TSourceValueInteger then
  Value := TSourceValueInteger(Source).Value
  else raise Exception.Create('Type for assignment not matches');
end;

{ TSourceValueString }

procedure TSourceValueString.Assign(Source: TSourceValue);
begin
  if Source is TSourceValueString then
  Value := TSourceValueString(Source).Value
  else raise Exception.Create('Type for assignment not matches');
end;

{ TSourceFunctions }

function TSourceFunctions.AddNew(Name: string): TSourceFunction;
begin
  Result := TSourceFunction.Create;
  Result.Name := Name;
  Add(Result);
end;

function TSourceFunctions.Search(Name: string): TSourceFunction;
var
  Item: TSourceFunction;
begin
  Result := nil;
  for Item in Self do
  if Item.Name = Name then begin
    Result := Item;
    Break;
  end;
end;

{ TSourceFunction }

procedure TSourceFunction.AddParameter(Name: string; Kind: TSourceParameterKind
  );
var
  Parameter: TSourceFunctionParameter;
begin
  Parameter := TSourceFunctionParameter.Create;
  Parameter.Name := Name;
  Parameter.Kind := Kind;
  Parameters.Add(Parameter);
end;

constructor TSourceFunction.Create;
begin
  Parameters := TSourceFunctionParameters.Create;
end;

destructor TSourceFunction.Destroy;
begin
  Parameters.Free;
  inherited Destroy;
end;

{ TSourceVariables }

function TSourceVariables.AddNew(Name: string;ValueType: TSourceType): TSourceVariable;
begin
  Result := TSourceVariable.Create;
  Result.Name := Name;
  Result.ValueType := ValueType;
  Add(Result);
end;

function TSourceVariables.Search(Name: string): TSourceVariable;
var
  Item: TSourceVariable;
begin
  Result := nil;
  for Item in Self do
  if Item.Name = Name then begin
    Result := Item;
    Break;
  end;
  if not Assigned(Result) and Assigned(Parent) then
    Result := Parent.Search(Name);
end;

{ TSourceConstants }

function TSourceConstants.AddNewString(Value: string; Name: string
  ): TSourceConstant;
begin
  Result := TSourceConstant.Create;
  Result.Value := TSourceValueString.Create;
  TSourceValueString(Result.Value).Value := Value;
  Result.Name := '';
  Add(Result);
end;

function TSourceConstants.AddNewInteger(Value: Integer; Name: string
  ): TSourceConstant;
begin
  Result := TSourceConstant.Create;
  Result.Value := TSourceValueInteger.Create;
  TSourceValueInteger(Result.Value).Value := Value;
  Result.Name := '';
  Add(Result);
end;

function TSourceConstants.Search(Name: string): TSourceConstant;
var
  Item: TSourceConstant;
begin
  Result := nil;
  for Item in Self do
  if Item.Name = Name then begin
    Result := Item;
    Break;
  end;
  if not Assigned(Result) and Assigned(Parent) then
    Result := Parent.Search(Name);
end;

{ TCommandFunctionCall }

{ TSourceCode }

procedure TSourceCode.InitFunctions;
var
  Funct: TSourceFunction;
  Typ: TSourceType;
begin
  Functions.Clear;

  // Init types
  Types.AddNew('Integer', TSourceTypeInteger);
  Types.AddNew('String', TSourceTypeString);
  Typ := Types.AddNew('StringArray', TSourceTypeArray);
  TSourceTypeArray(Typ).ItemType := TSourceTypeString.Create;
  Typ := Types.AddNew('IntegerArray', TSourceTypeArray);
  TSourceTypeArray(Typ).ItemType := TSourceTypeInteger.Create;

  // Init functions
  Funct := Functions.AddNew('print');
  Funct.AddParameter('Text', pkString);

  Funct := Functions.AddNew('println');
  Funct.AddParameter('Text', pkString);

  Funct := Functions.AddNew('var');
  Funct.AddParameter('Variable', pkVariable);
  Funct.AddParameter('Type', pkType);

  Funct := Functions.AddNew('assign');
  Funct.AddParameter('Destination', pkVariable);
  Funct.AddParameter('Source', pkString);

  Funct := Functions.AddNew('inputln');
  Funct.AddParameter('Text', pkVariable);

  Funct := Functions.AddNew('increment');
  Funct.AddParameter('Variable', pkVariable);
  Funct.AddParameter('Addition', pkString);

  Funct := Functions.AddNew('decrement');
  Funct.AddParameter('Variable', pkVariable);
  Funct.AddParameter('Addition', pkString);
end;

constructor TSourceCode.Create;
begin
  Types := TSourceTypes.Create;
  Variables := TSourceVariables.Create;
  Constants := TSourceConstants.Create;
  Functions := TSourceFunctions.Create;
  Main := TCommandBeginEnd.Create;
  Main.SourceCode := Self;
  InitFunctions;
end;

destructor TSourceCode.Destroy;
begin
  Main.Free;
  Functions.Free;
  Variables.Free;
  Constants.Free;
  Types.Free;
  inherited Destroy;
end;


end.