source: branches/easy compiler/UCompiler.pas

unit UCompiler;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, USourceCode, UTargetCode;

type
  TSourceTokenKind = (stNone, stString, stIdentifier, stEof, stInteger,
    stSpecialSymbol);
  TSourceToken = record
    Text: string;
    Kind: TSourceTokenKind;
  end;

  { TSourceTokens }

  TSourceTokens = class
    Tokens: array of TSourceToken;
    procedure AddToken(Kind: TSourceTokenKind; Text: string);
  end;

  { TTokenizer }

  TTokenizer = class
    TokenIndex: Integer;
    Tokens: TSourceTokens;
    function IsAlpha(Character: Char): Boolean;
    function IsDigit(Character: Char): Boolean;
    function IsAlphaNumeric(Character: Char): Boolean;
    function IsWhiteSpace(Character: Char): Boolean;
    function IsKeyword(Text: string): Boolean;
    function GetNext(Kind: TSourceTokenKind = stNone): TSourceToken;
    function CheckNext(Text: string; Kind: TSourceTokenKind): Boolean;
    procedure Tokenize(Text: string; Tokens: TSourceTokens);
  end;

  { TCompiler }

  TCompiler = class
  private
    Tokenizer: TTokenizer;
    procedure Parse(Code: TSourceCode);
    function ParseBeginEnd(SourceCode: TSourceCode; out BeginEnd: TCommandBeginEnd): Boolean;
    function ParseBreak(SourceCode: TSourceCode; out CommandBreak: TCommandBreak
      ): Boolean;
    function ParseCommand(SourceCode: TSourceCode; out Command: TSourceCommand
      ): Boolean;
    function ParseFunctionCall(SourceCode: TSourceCode; out FunctionCall: TCommandFunctionCall): Boolean;
    function ParseIfEqual(SourceCode: TSourceCode; out IfEqual: TCommandIfEqual): Boolean;
    function ParseIfNotEqual(SourceCode: TSourceCode; out IfNotEqual: TCommandIfNotEqual): Boolean;
    function ParseReference(SourceCode: TSourceCode): TSourceReference;
    function ParseReferenceVariable(SourceCode: TSourceCode): TSourceReference;
    function ParseRepeat(SourceCode: TSourceCode; out
      CommandRepeat: TCommandRepeat): Boolean;
    function ParseVar(SourceCode: TSourceCode): Boolean;
  public
    procedure Compile(Source: string; SourceCode: TSourceCode);
    procedure Convert(SourceCode: TSourceCode; Target: TTargetCode);
  end;


implementation

{ TSourceTokens }

procedure TSourceTokens.AddToken(Kind: TSourceTokenKind; Text: string);
begin
  SetLength(Tokens, Length(Tokens) + 1);
  Tokens[Length(Tokens) - 1].Kind := Kind;
  Tokens[Length(Tokens) - 1].Text := Text;
end;

{ TTokenizer }

function TTokenizer.IsAlpha(Character: Char): Boolean;
begin
  Result := (Character in ['a'..'z']) or (Character in ['A'..'Z']);
end;

function TTokenizer.IsDigit(Character: Char): Boolean;
begin
  Result := Character in ['0'..'9'];
end;

function TTokenizer.IsAlphaNumeric(Character: Char): Boolean;
begin
  Result := IsAlpha(Character) or IsDigit(Character);
end;

function TTokenizer.IsWhiteSpace(Character: Char): Boolean;
begin
  Result := (Character = ' ') or (Character = #13) or (Character = #10) or
    (Character = #9);
end;

function TTokenizer.IsKeyword(Text: string): Boolean;
begin
  Result := False;
end;

function TTokenizer.GetNext(Kind: TSourceTokenKind = stNone): TSourceToken;
begin
  if TokenIndex < Length(Tokens.Tokens) then begin
    Result := Tokens.Tokens[TokenIndex];
    Inc(TokenIndex);
  end else begin
    Result.Kind := stEof;
    Result.Text := '';
  end;
  if (Kind <> stNone) and (Result.Kind <> Kind) then
    raise Exception.Create('Unexpected token type');
end;

function TTokenizer.CheckNext(Text: string; Kind: TSourceTokenKind): Boolean;
var
  Index: Integer;
  Token: TSourceToken;
begin
  Index := TokenIndex;
  Token := GetNext;
  Result := (LowerCase(Token.Text) = Text) and (Token.Kind = Kind);
  TokenIndex := Index;
end;

procedure TTokenizer.Tokenize(Text: string; Tokens: TSourceTokens);
type
  TTokenizerState = (tsNone, tsIdentifier, tsString, tsInteger, tsSpecialSymbol);
var
  State: TTokenizerState;
  Token: string;
  I: Integer;
begin
  Self.Tokens := Tokens;
  TokenIndex := 0;
  I := 1;
  State := tsNone;
  while I < Length(Text) do begin
    if State = tsNone then begin
      if IsDigit(Text[I]) then begin
        State := tsInteger;
        Token := Text[I];
      end else
      if IsAlpha(Text[I]) then begin
        State := tsIdentifier;
        Token := Text[I];
      end else
      if IsWhiteSpace(Text[I]) then begin
        // Do nothing
      end else
      if Text[I] = '''' then begin
        State := tsString;
        Token := '';
      end else
      if (Text[I] = '[') or (Text[I] = ']') then begin
        Tokens.AddToken(stSpecialSymbol, Text[I]);
      end else
      raise Exception.Create('Unexpected character: ' + Text[I]);
    end else
    if State = tsIdentifier then begin
      if IsAlphaNumeric(Text[I]) then begin
        Token := Token + Text[I];
      end else begin
        Tokens.AddToken(stIdentifier, Token);
        State := tsNone;
        Dec(I);
      end;
    end else
    if State = tsInteger then begin
      if IsDigit(Text[I]) then begin
        Token := Token + Text[I];
      end else begin
        Tokens.AddToken(stInteger, Token);
        State := tsNone;
        Dec(I);
      end;
    end else
    if State = tsString then begin
      if Text[I] <> '''' then begin
        Token := Token + Text[I];
      end else begin
        Tokens.AddToken(stString, Token);
        State := tsNone;
      end;
    end else
    raise Exception.Create('Unsupported tokenizer state');
    Inc(I);
  end;
end;

{ TCompiler }

procedure TCompiler.Parse(Code: TSourceCode);
begin
  Tokenizer.TokenIndex := 0;
  ParseBeginEnd(Code, Code.Main);
end;

function TCompiler.ParseVar(SourceCode: TSourceCode): Boolean;
var
  Token: TSourceToken;
  Token2: TSourceToken;
  Variable: TSourceVariable;
  ValueType: TSourceType;
  TokenIndex: Integer;
begin
  Result := False;
  TokenIndex := Tokenizer.TokenIndex;
  Token := Tokenizer.GetNext;
  if LowerCase(Token.Text) = 'var' then begin
    Token := Tokenizer.GetNext;
    Token2 := Tokenizer.GetNext;
    if Token2.Kind <> stIdentifier then
      raise Exception.Create('Expected type parameter');
    Variable := SourceCode.Variables.Search(Token.Text);
    if not Assigned(Variable) then begin
      ValueType := SourceCode.Types.Search(Token2.Text);
      if not Assigned(ValueType) then
        raise Exception.Create('Unsupported type: ' + Token2.Text);
      Variable := SourceCode.Variables.AddNew(Token.Text,
        ValueType);
    end else raise Exception.Create('Variable redefined: ' + Token.Text);
    Result := True;
  end;
  if not Result then Tokenizer.TokenIndex := TokenIndex;
end;

function TCompiler.ParseReference(SourceCode: TSourceCode): TSourceReference;
var
  Token: TSourceToken;
  Token2: TSourceToken;
  NewReference: TSourceReference;
begin
  Token := Tokenizer.GetNext;
  if Token.Kind = stString then begin
    NewReference := TSourceReferenceConstant.Create;
    TSourceReferenceConstant(NewReference).Constant :=
      SourceCode.Constants.AddNewString(Token.Text);
  end else
  if Token.Kind = stIdentifier then begin
    if Tokenizer.CheckNext('[', stSpecialSymbol) then begin
      Token2 := Tokenizer.GetNext;
      NewReference := TSourceReferenceArray.Create;
      TSourceReferenceArray(NewReference).ArrayRef := SourceCode.Variables.Search(Token.Text);
      if TSourceReferenceArray(NewReference).ArrayRef = nil then
        raise Exception.Create('Variable not found: ' + Token.Text);
      TSourceReferenceArray(NewReference).Index := ParseReference(SourceCode);

      Token2 := Tokenizer.GetNext;
      if (Token2.Text <> ']') or (Token2.Kind <> stSpecialSymbol) then
        raise Exception.Create('Expected ]');
    end else begin
      NewReference := TSourceReferenceVariable.Create;
      TSourceReferenceVariable(NewReference).Variable :=
        SourceCode.Variables.Search(Token.Text);
      if TSourceReferenceVariable(NewReference).Variable = nil then
        raise Exception.Create('Variable not found: ' + Token.Text);
    end;
  end else
  if Token.Kind = stInteger then begin
    NewReference := TSourceReferenceConstant.Create;
    TSourceReferenceConstant(NewReference).Constant :=
      SourceCode.Constants.AddNewInteger(StrToInt(Token.Text));
  end else
  raise Exception.Create('Unexpected parameter');
  Result := NewReference;
end;

function TCompiler.ParseReferenceVariable(SourceCode: TSourceCode): TSourceReference;
var
  Token: TSourceToken;
  Token2: TSourceToken;
  NewReference: TSourceReference;
begin
  Token := Tokenizer.GetNext;
  if Token.Kind = stIdentifier then begin
    if Tokenizer.CheckNext('[', stSpecialSymbol) then begin
      Token2 := Tokenizer.GetNext;
      NewReference := TSourceReferenceArray.Create;
      TSourceReferenceArray(NewReference).ArrayRef := SourceCode.Variables.Search(Token.Text);
      if TSourceReferenceArray(NewReference).ArrayRef = nil then
        raise Exception.Create('Variable not found: ' + Token.Text);
      TSourceReferenceArray(NewReference).Index := ParseReference(SourceCode);

      Token2 := Tokenizer.GetNext;
      if (Token2.Text <> ']') or (Token2.Kind <> stSpecialSymbol) then
        raise Exception.Create('Expected ]');
    end else begin
      NewReference := TSourceReferenceVariable.Create;
      TSourceReferenceVariable(NewReference).Variable :=
        SourceCode.Variables.Search(Token.Text);
      if TSourceReferenceVariable(NewReference).Variable = nil then
        raise Exception.Create('Variable not found: ' + Token.Text);
    end;
  end else raise Exception.Create('Unexpected parameter');
  Result := NewReference;
end;

function TCompiler.ParseFunctionCall(SourceCode: TSourceCode; out FunctionCall: TCommandFunctionCall): Boolean;
var
  Funct: TSourceFunction;
  Param: TSourceFunctionParameter;
  Token: TSourceToken;
  TokenIndex: Integer;
  Keyword: string;
begin
  Result := False;
  TokenIndex := Tokenizer.TokenIndex;
  Token := Tokenizer.GetNext;
  Keyword := LowerCase(Token.Text);
  Funct := SourceCode.Functions.Search(Keyword);
  if Assigned(Funct) then begin
    FunctionCall := TCommandFunctionCall.Create;
    FunctionCall.Name := Keyword;
    for Param in Funct.Parameters do
    if Param.Kind = pkString then begin
      FunctionCall.Parameters.Add(ParseReference(SourceCode))
    end else
    if Param.Kind = pkVariable then begin
      FunctionCall.Parameters.Add(ParseReferenceVariable(SourceCode));
    end else
    raise Exception.Create('Unsupported parameter type.');
    Result := True;
  end;
  if not Result then Tokenizer.TokenIndex := TokenIndex;
end;

function TCompiler.ParseIfEqual(SourceCode: TSourceCode; out IfEqual: TCommandIfEqual): Boolean;
var
  Token: TSourceToken;
  TokenIndex: Integer;
  Keyword: string;
begin
  Result := False;
  TokenIndex := Tokenizer.TokenIndex;
  Token := Tokenizer.GetNext;
  Keyword := LowerCase(Token.Text);
  if Keyword = 'ifequal' then begin
    IfEqual := TCommandIfEqual.Create;
    IfEqual.Reference1 := ParseReference(SourceCode);
    IfEqual.Reference2 := ParseReference(SourceCode);
    Result := True;
  end;
  if not Result then Tokenizer.TokenIndex := TokenIndex;
end;

function TCompiler.ParseIfNotEqual(SourceCode: TSourceCode; out
  IfNotEqual: TCommandIfNotEqual): Boolean;
var
  Token: TSourceToken;
  TokenIndex: Integer;
  Keyword: string;
begin
  Result := False;
  TokenIndex := Tokenizer.TokenIndex;
  Token := Tokenizer.GetNext;
  Keyword := LowerCase(Token.Text);
  if Keyword = 'ifnotequal' then begin
    IfNotEqual := TCommandIfNotEqual.Create;
    IfNotEqual.Reference1 := ParseReference(SourceCode);
    IfNotEqual.Reference2 := ParseReference(SourceCode);
    Result := True;
  end;
  if not Result then Tokenizer.TokenIndex := TokenIndex;
end;

function TCompiler.ParseBreak(SourceCode: TSourceCode; out CommandBreak: TCommandBreak): Boolean;
var
  Token: TSourceToken;
  TokenIndex: Integer;
  Keyword: string;
begin
  Result := False;
  TokenIndex := Tokenizer.TokenIndex;
  Token := Tokenizer.GetNext;
  Keyword := LowerCase(Token.Text);
  if Keyword = 'break' then begin
    CommandBreak := TCommandBreak.Create;
    Result := True;
  end;
  if not Result then Tokenizer.TokenIndex := TokenIndex;
end;

function TCompiler.ParseRepeat(SourceCode: TSourceCode; out CommandRepeat: TCommandRepeat): Boolean;
var
  Token: TSourceToken;
  TokenIndex: Integer;
  Keyword: string;
  Command: TSourceCommand;
begin
  Result := False;
  TokenIndex := Tokenizer.TokenIndex;
  Token := Tokenizer.GetNext;
  Keyword := LowerCase(Token.Text);
  if Keyword = 'repeat' then begin
    CommandRepeat := TCommandRepeat.Create;
    if ParseCommand(SourceCode, Command) then begin
      CommandRepeat := TCommandRepeat.Create;
      CommandRepeat.Command := Command;
      Command.Parent := CommandRepeat;
    end else
    raise Exception.Create('Unexpected token');
    Result := True;
  end;
  if not Result then Tokenizer.TokenIndex := TokenIndex;
end;

function TCompiler.ParseCommand(SourceCode: TSourceCode; out Command: TSourceCommand): Boolean;
var
  CommandBeginEnd: TCommandBeginEnd;
  CommandIfEqual: TCommandIfEqual;
  CommandFunctionCall: TCommandFunctionCall;
  CommandBreak: TCommandBreak;
  CommandRepeat: TCommandRepeat;
  CommandIfNotEqual: TCommandIfNotEqual;
begin
  Command := nil;
  Result := True;
  if ParseVar(SourceCode) then else
  if ParseBeginEnd(SourceCode, CommandBeginEnd) then begin
    Command := CommandBeginEnd;
  end else
  if ParseIfEqual(SourceCode, CommandIfEqual) then begin
    Command := CommandIfEqual;
  end else
  if ParseIfNotEqual(SourceCode, CommandIfNotEqual) then begin
    Command := CommandIfNotEqual;
  end else
  if ParseBreak(SourceCode, CommandBreak) then begin
    Command := CommandBreak;
  end else
  if ParseRepeat(SourceCode, CommandRepeat) then begin
    Command := CommandRepeat;
  end else
  if ParseFunctionCall(SourceCode, CommandFunctionCall) then begin
    Command := CommandFunctionCall;
  end else Result := False;
end;

function TCompiler.ParseBeginEnd(SourceCode: TSourceCode; out BeginEnd: TCommandBeginEnd): Boolean;
var
  Token: TSourceToken;
  Keyword: string;
  TokenIndex: Integer;
  Command: TSourceCommand;
begin
  Result := False;
  TokenIndex := Tokenizer.TokenIndex;
  Token := Tokenizer.GetNext;
  Keyword := LowerCase(Token.Text);
  if Keyword = 'begin' then begin
    BeginEnd := TCommandBeginEnd.Create;
    BeginEnd.SourceCode := SourceCode;
    while True do begin
      if ParseCommand(SourceCode, Command) then begin
        if Assigned(Command) then begin
          BeginEnd.Commands.Add(Command);
          Command.Parent := BeginEnd;
        end;
      end else
      if Tokenizer.CheckNext('end', stIdentifier) then begin
        Break;
      end else begin
        Token := Tokenizer.GetNext;
        Keyword := LowerCase(Token.Text);
        raise Exception.Create('Unknown token: ' + Keyword);
      end;
    end;
    Token := Tokenizer.GetNext;
    if LowerCase(Token.Text) <> 'end' then
      raise Exception.Create('Expected end keyword');
    Result := True;
  end;
  if not Result then Tokenizer.TokenIndex := TokenIndex;
end;

procedure TCompiler.Compile(Source: string; SourceCode: TSourceCode);
var
  SourceTokens: TSourceTokens;
begin
  SourceTokens := TSourceTokens.Create;
  Tokenizer := TTokenizer.Create;

  Tokenizer.Tokenize(Source, SourceTokens);
  Parse(SourceCode);

  Tokenizer.Free;
  SourceTokens.Free;
end;

procedure TCompiler.Convert(SourceCode: TSourceCode; Target: TTargetCode);
var
  I: Integer;
  Instruction: TSourceCommand;
  TargetInstruction: TTargetInstruction;
begin
{  Target.Instructions.Count := 0;
  for I := 0 to SourceCode.Instructions.Count - 1 do begin
    Instruction := TSourceCommand(SourceCode.Instructions[I]);
    if Instruction is TCommandFunctionCall then begin
      TargetInstruction := TTargetInstruction.Create;
      TargetInstruction.Kind := tiFunction;
      TargetInstruction.Name := TCommandFunctionCall(Instruction).Name;
      Target.Instructions.Add(TargetInstruction)
    end else raise Exception.Create('Unsupported source instruction');
  end;
  }
end;

end.