source: branches/interpreter/interpreter3/Source.pas

unit Source;

{$mode delphi}

interface

type
  PBeginEnd = ^TBeginEnd;
  PAssignment = ^TAssignment;
  PVariable = ^TVariable;
  PConstant = ^TConstant;
  PIfThenElse = ^TIfThenElse;
  PWhileDo = ^TWhileDo;
  PExpression = ^TExpression;
  PExecution = ^TExecution;

  TOperator = (opNone, opAdd, opSubtract, opAnd, opOr, opNot, opEqual, opNotEqual);

  TBaseType = (btNone, btBoolean, btInteger, btChar, btShortString, btArray);

  TType = record
    Name: string;
    BaseType: TBaseType;
  end;
  PType = ^TType;

  { TTypes }

  TTypes = record
    Items: array of TType;
    procedure Add(DataType: TType);
    function GetByName(Name: string): PType;
    function GetLast: PType;
  end;

  TVariable = record
    Name: string;
    DataType: PType;
    Index: Integer;
  end;

  { TVariables }

  TVariables = record
    Items: array of TVariable;
    procedure Add(Variable: TVariable);
    function GetByName(Name: string): PVariable;
  end;
  PVariables = ^TVariables;

  TConstant = record
    Name: shortstring;
    DataType: PType;
    Index: Integer;
    case TBaseType of
      btChar: (ValueChar: Char);
      btInteger: (ValueInteger: Integer);
      btShortString: (ValueString: shortstring);
      btBoolean: (ValueBoolean: Boolean);
  end;

  { TConstants }

  TConstants = record
    Items: array of TConstant;
    procedure Add(Constant: TConstant);
    function GetByName(Name: string): PConstant;
  end;
  PConstants = ^TConstants;

  TFunctionParameter = record
    Name: string;
    DataType: PType;
    Output: Boolean;
  end;

  { TFunctionParameters }

  TFunctionParameters = record
    Items: array of TFunctionParameter;
    procedure Add(Param: TFunctionParameter);
  end;
  PFunctionParameters = ^TFunctionParameters;

  TFunctionCall = procedure ;

  TCmdType = (ctNone, ctWhileDo, ctIfThenElse, ctBeginEnd, ctAssignment, ctExecution);
  TCommand = record
    CmdType: TCmdType;
    case Integer of
      0: (WhileDo: PWhileDo);
      1: (IfThenElse: PIfThenElse);
      2: (BeginEnd: PBeginEnd);
      3: (Assignment: PAssignment);
      4: (Execution: PExecution);
  end;
  PCommand = ^TCommand;

  { TBeginEnd }

  TBeginEnd = record
    Commands: array of TCommand;
    procedure Add;
    function GetLast: PCommand;
  end;

  TReadType = (rtVariable, rtConstant, rtExpression, rtFunctionCall, rtValue);
  TGetValue = record
    ReadType: TReadType;
    case TReadType of
      rtVariable: (Variable: PVariable);
      rtConstant: (Constant: PConstant);
      rtExpression: (Expression: PExpression);
      rtFunctionCall: (FunctionCall: PExecution);
      rtValue: (Value: TConstant);
  end;
  PGetValue = ^TGetValue;

  TExpNodeType = (ntNone, ntValue, ntOperator);

  TExpression = record
    NodeType: TExpNodeType;
    OperatorType: TOperator;
    Items: array of TExpression;
    Value: TGetValue;
    Parentheses: Boolean;
    Associated: Boolean;
  end;

  TAssignment = record
    Destination: PVariable;
    Source: TGetValue;
  end;

  TIfThenElse = record
    Condition: TGetValue;
    DoThen: TCommand;
    DoElse: TCommand;
  end;

  TWhileDo = record
    Condition: TGetValue;
    Command: TCommand;
  end;

  { TFunction }

  TFunction = record // TCommand
    Name: string;
    Parameters: TFunctionParameters;
    ReturnType: PType;
    BeginEnd: TBeginEnd;
    Variables: TVariables;
  end;
  PFunction = ^TFunction;

  { TFunctions }

  TFunctions = record
    Items: array of TFunction;
    procedure Add(Func: TFunction);
    function GetByName(Name: string): PFunction;
    function GetLast: PFunction;
  end;

  TExecutionParams = record
    Items: array of TGetValue;
  end;

  TExecution = record
    Func: PFunction;
    Parameters: TExecutionParams;
  end;

  TProgramCode = record
    Name: string;
    Variables: TVariables;
    Constants: TConstants;
    Types: TTypes;
    Functions: TFunctions;
    BeginEnd: TBeginEnd;
  end;
  PProgramCode = ^TProgramCode;

function VariableCreate(Name: string; DataType: PType): TVariable;
function FunctionCreate(Name: string; DataType: PType): TFunction;
function TypeCreate(Name: string; BaseType: TBaseType): TType;
function FunctionParameterCreate(Name: string; DataType: PType; Output: Boolean = False): TFunctionParameter;

var
  OperatorString: array[TOperator] of string = ('', '+', '-', 'and', 'or', 'not',
    '=', '<>');

const
  OperatorPrecedence: array[0..6] of TOperator = (opNot, opAnd, opOr, opAdd,
    opSubtract, opEqual, opNotEqual);


implementation

function VariableCreate(Name: string; DataType: PType): TVariable;
begin
  Result.Name := Name;
  Result.DataType := DataType;
end;

function FunctionCreate(Name: string; DataType: PType): TFunction;
begin
  Result.Name := Name;
  Result.ReturnType := DataType;
end;

function TypeCreate(Name: string; BaseType:TBaseType): TType;
begin
  Result.Name := Name;
  Result.BaseType := BaseType;
end;

function FunctionParameterCreate(Name: string; DataType: PType; Output: Boolean = False): TFunctionParameter;
begin
  Result.Name := Name;
  Result.DataType := DataType;
  Result.Output := Output;
end;

{ TBeginEnd }

procedure TBeginEnd.Add;
begin
  SetLength(Commands, Length(Commands) + 1);
end;

function TBeginEnd.GetLast: PCommand;
begin
  Result := @Commands[Length(Commands) - 1];
end;

{ TConstants }

procedure TConstants.Add(Constant: TConstant);
begin
  SetLength(Items, Length(Items) + 1);
  Items[Length(Items) - 1] := Constant;
  Items[Length(Items) - 1].Index := Length(Items) - 1;
end;

function TConstants.GetByName(Name: string): PConstant;
var
  I: Integer;
begin
  I := 0;
  while (I < Length(Items)) and (Items[I].Name <> Name) do I := I + 1;
  if I < Length(Items) then Result := @Items[I]
    else Result := nil;
end;

{ TVariables }

procedure TVariables.Add(Variable: TVariable);
begin
  SetLength(Items, Length(Items) + 1);
  Items[Length(Items) - 1] := Variable;
  Items[Length(Items) - 1].Index := Length(Items) - 1;
end;

function TVariables.GetByName(Name: string): PVariable;
var
  I: Integer;
begin
  I := 0;
  while (I < Length(Items)) and (Items[I].Name <> Name) do I := I + 1;
  if I < Length(Items) then Result := @Items[I]
    else Result := nil;
end;

{ TFunctionParameters }

procedure TFunctionParameters.Add(Param: TFunctionParameter);
begin
  SetLength(Items, Length(Items) + 1);
  Items[Length(Items) - 1] := Param;
end;

{ TTypes }

procedure TTypes.Add(DataType: TType);
begin
  SetLength(Items, Length(Items) + 1);
  Items[Length(Items) - 1] := DataType;
end;

function TTypes.GetByName(Name: string): PType;
var
  I: Integer;
begin
  I := 0;
  while (I < Length(Items)) and (Items[I].Name <> Name) do I := I + 1;
  if I < Length(Items) then Result := @Items[I]
    else Result := nil;
end;

function TTypes.GetLast: PType;
begin
  Result := @Items[Length(Items) - 1];
end;

{ TFunctions }

procedure TFunctions.Add(Func: TFunction);
begin
  SetLength(Items, Length(Items) + 1);
  Items[Length(Items) - 1] := Func;
end;

function TFunctions.GetByName(Name: string): PFunction;
var
  I: Integer;
begin
  I := 0;
  while (I < Length(Items)) and (Items[I].Name <> Name) do I := I + 1;
  if I < Length(Items) then Result := @Items[I]
    else Result := nil;
end;

function TFunctions.GetLast: PFunction;
begin
  Result := @Items[Length(Items) - 1];
end;

end.