source: trunk/Compiler/Compiler.pas

unit Compiler;

interface

uses
  SysUtils, Variants, Classes, FileUtil, ModularSystem, CompilerAPI,
  Dialogs, SourceCodePascal, Producer, Analyzer, Generics.Collections, Target;

type
  TErrorMessage = class
    Text: string;
    Position: TPoint;
    FileName: string;
  end;

  { TSourceFileManager }

  TSourceFileManager = class
    Files: TStringList;
    function LoadStringFromFile(FileName: string): string;
    procedure SaveStringToFile(FileName: string; Content: string);
  public
    function GetFileContent(Name: string; var Content: string): Boolean;
    function SetFileContent(Name: string; const Content: string): Boolean;
    constructor Create;
    destructor Destroy; override;
  end;

  { TCompilerList }

  TCompiler = class
  private
    FAnalyzer: TAnalyzer;
    FOnLoadSource: TGetSourceEvent;
    FOnSaveTarget: TWriteTargetEvent;
    FTarget: TTarget;
    FOnErrorMessage: TErrorMessageEvent;
    procedure SetAnalyzer(const AValue: TAnalyzer);
    procedure AnalyzeAll;
    procedure ProduceAll;
    procedure SetTarget(AValue: TTarget);
  public
    AbstractCode: TProgram;
    ErrorMessages: TObjectList<TErrorMessage>;
    CompiledFolder: string;

    Targets: TTargets;
    Analyzers: TAnalyzers;
    Convertors: TObjectList<TObject>;
    Executors: TObjectList<TObject>;
    API: TCompilerAPI;
    TargetFolder: string;
    MainSource: string;
    ModuleManager: TModuleManager;
    procedure ErrorMessage(Text: string; Position: TPoint; FileName: string);
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Init; virtual;
    procedure Compile;
    property OnErrorMessage: TErrorMessageEvent read FOnErrorMessage
      write FOnErrorMessage;
    property Analyzer: TAnalyzer read FAnalyzer write SetAnalyzer;
    property Target: TTarget read FTarget write SetTarget;
    property OnLoadSource: TGetSourceEvent read FOnLoadSource write FOnLoadSource;
    property OnSaveTarget: TWriteTargetEvent read FOnSaveTarget write FOnSaveTarget;
  end;


implementation

uses
  AnalyzerPascal;

resourcestring
  SNothingToAnalyze = 'Nothing to analyze';
  SRewritingExistedTarget = 'Rewriting existing target file %s';

{ TSourceFileManager }

function TSourceFileManager.LoadStringFromFile(FileName: string): string;
var
  F: TFileStream;
begin
  try
    F := TFileStream.Create(UTF8Decode(FileName), fmOpenRead);
    SetLength(Result, F.Size);
    if F.Size > 0 then
      F.Read(Result[1], F.Size);
  finally
    F.Free;
  end;
end;

procedure TSourceFileManager.SaveStringToFile(FileName: string; Content: string);
var
  F: TFileStream;
begin
  try
    ForceDirectories(ExtractFileDir(FileName));
    if FileExists(FileName) then
      F := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
      else F := TFileStream.Create(UTF8Decode(FileName), fmCreate);
    F.Size := 0;
    if Length(Content) > 0 then
      F.Write(Content[1], Length(Content));
  finally
    F.Free;
  end;
end;

function TSourceFileManager.GetFileContent(Name: string; var Content: string): Boolean;
var
  I: Integer;
begin
  I := 0;
  while (I < Files.Count) and (ExtractFileName(Files[I]) <> Name) do Inc(I);
  if I < Files.Count then begin
    if FileExists(Files[I]) then begin
      Content := LoadStringFromFile(Files[I]);
      Result := True;
    end else Result := False;
  end else Result := False;
end;

function TSourceFileManager.SetFileContent(Name: string; const Content: string
  ): Boolean;
var
  I: Integer;
  F: TFileStream;
begin
  I := 0;
  while (I < Files.Count) and (ExtractFileName(Files[I]) <> Name) do Inc(I);
  if I >= Files.Count then begin
    SaveStringToFile(Name, Content);
    Result := True;
    Files.Add(Name);
  end else begin
    Result := False;
    //ErrorMessage(Format(SRewritingExistedTarget, [Name]), Point(0, 0), '');
  end;
end;

constructor TSourceFileManager.Create;
begin
  Files := TStringList.Create;
end;

destructor TSourceFileManager.Destroy;
begin
  FreeAndNil(Files);
  inherited;
end;

{ TCompiler }

procedure TCompiler.Compile;
begin
  Analyzer.OnGetSource := OnLoadSource;
  AnalyzeAll;
  if Assigned(Target.Producer) then
    Target.Producer.OnWriteTarget := OnSaveTarget;
  ProduceAll;
end;

constructor TCompiler.Create;
begin
  Targets := TTargets.Create;
  Analyzers := TAnalyzers.Create;
  Convertors := TObjectList<TObject>.Create;
  Executors := TObjectList<TObject>.Create;
  API := TCompilerAPI.Create;
  API.Compiler := Self;
  AbstractCode := TProgram.Create;
  ErrorMessages := TObjectList<TErrorMessage>.Create;
  CompiledFolder := 'Compiled';
  ModuleManager := TModuleManager.Create(nil);
  ModuleManager.API := API;
end;

procedure TCompiler.Init;
begin
  ErrorMessages.Clear;
  AbstractCode.Clear;
end;

destructor TCompiler.Destroy;
begin
  FreeAndNil(ModuleManager);
  FreeAndNil(AbstractCode);
  FreeAndNil(ErrorMessages);
  FreeAndNil(Targets);
  FreeAndNil(Analyzers);
  FreeAndNil(Executors);
  FreeAndNil(Convertors);
  inherited;
end;

procedure TCompiler.ErrorMessage(Text: string; Position: TPoint; FileName: string);
var
  NewMessage: TErrorMessage;
begin
  NewMessage := TErrorMessage.Create;
  NewMessage.Text := Text;
  NewMessage.Position := Position;
  NewMessage.FileName := FileName;
  ErrorMessages.Add(NewMessage);
  if Assigned(FOnErrorMessage) then FOnErrorMessage(Text, Position, FileName);
end;

procedure TCompiler.SetAnalyzer(const AValue: TAnalyzer);
begin
  if FAnalyzer = AValue then exit;
  FAnalyzer := AValue;
  if Assigned(Analyzer) then begin
    Analyzer.OnErrorMessage := ErrorMessage;
    Analyzer.OnGetSource := OnLoadSource;
  end;
end;

procedure TCompiler.AnalyzeAll;
begin
  if MainSource <> '' then begin
    Analyzer.FileName := MainSource;
    Analyzer.OnGetSource(ExtractFileName(Analyzer.FileName), Analyzer.SourceCode2);
    Analyzer.Process;
    Analyzer.ParseModule(AbstractCode);
  end else raise Exception.Create(SNothingToAnalyze);
end;

procedure TCompiler.ProduceAll;
var
  NewModule: TSourceModule;
  ProducedCode: TStringList;
  I: Integer;
  TargetFileName: string;
begin
  if Assigned(Target.Producer) then
  try
    ProducedCode := TStringList.Create;
    with AbstractCode do
    for I := 0 to Modules.Count - 1 do begin
      Target.Producer.Produce(TSourceModule(Modules[I]));
      Target.Producer.AssignToStringList(ProducedCode);
      TargetFileName := TargetFolder + DirectorySeparator + TSourceModule(Modules[I]).TargetFile;
      if Assigned(Target.Producer.OnWriteTarget) then
        Target.Producer.OnWriteTarget(TargetFileName, ProducedCode.Text);
    end;
  finally
    ProducedCode.Free;
  end;
end;

procedure TCompiler.SetTarget(AValue: TTarget);
begin
  if FTarget = AValue then Exit;
  FTarget := AValue;
  if Assigned(FTarget) then begin
    FTarget.Compiler := Self;
    if Assigned(FTarget.Producer) then
      FTarget.Producer.OnWriteTarget := OnSaveTarget;
  end;
end;

end.