Simba/trunk/Projects/SAMufasaGUI/simpleanalyzer.pas

unit simpleanalyzer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, SynEdit, SynHighlighterPas, Clipbrd;

type

  TScriptVar = record
    VarName, VarType : string;
  end;

  { TScriptMethod }

  TScriptMethod = class(TObject)
    BeginPos, EndPos : integer;
    isFunction : Boolean;
    Name : string;
    Parameters,Vars : array of TScriptVar;
    ParameterLen,VarLen : integer;
    Returns : String;
    Methods : Array of TScriptMethod;
    MethodLen : Integer;
    function AddMethod( iszehfunction : boolean; TheName : string): TScriptMethod;
    procedure AddVar( TheName, TheType : string);
    procedure AddParam( TheName : string);
    constructor create( iszehfunction : Boolean; TheName : string);
    function CreateMethodStr : string;
    Destructor  Destroy; override;
  end;

  { TScriptAnalyzer }

  TScriptAnalyzer = class(TObject)
    ScriptToAnalyze : string;
    ScriptName : string;
    Methods : Array of TScriptMethod;
    MethodLen : Integer;
    Main : TScriptMethod;
    HasMain : boolean;
    Vars : Array of TScriptVar;
    VarLen : integer;
    Function AddMethod( iszehfunction : boolean; Name : string): TScriptMethod;
    procedure AddVar( TheName, TheType : string);
    procedure analyze;
    constructor create;
    Destructor  Destroy; override;
  end;



implementation

uses
  mPasLex,strutils;



destructor TScriptAnalyzer.Destroy;
var
  i : integer;
begin;
  for i := 0 to MethodLen - 1 do
    Self.Methods[i].Free;
  Main.Free;
  inherited;
end;

destructor TScriptMethod.Destroy;
var
  i : integer;
begin;
  for i := 0 to MethodLen - 1 do
    Self.Methods[i].Free;
  inherited;
end;
constructor TScriptMethod.create( iszehfunction : Boolean; TheName : string);
begin;
  inherited Create;
  Self.isFunction := iszehfunction;
  Self.Name := TheName;
end;

function TScriptMethod.CreateMethodStr: string;
var
  i : integer;
  LastType : string;
begin
  if isFunction then
    result := 'function ' + Name
  else
    result := 'procedure '+  name;
  if ParameterLen > 0 then
  begin;
    result := result + '(';
    LastType := '';
    for i := 0 to ParameterLen - 1 do
    begin;
      if lasttype <> '' then
        if lowercase(lasttype) <> lowercase(Parameters[i].VarType) then
          result := result + ' : ' + LastType + '; '
        else
          result := result + ', ';
        result := result + Parameters[i].VarName;
      lasttype := Parameters[i].VarType;
    end;
    Result := result + ' : ' + Parameters[ParameterLen - 1].VarType + ')';
  end;
  if isFunction then
    result := result + ' : ' + Returns
  else
    result := result + ';';
end;

constructor TScriptAnalyzer.create;
begin;
  inherited create;
  ScriptName := 'Default';
  Main := TScriptMethod.create(false,'!main');
end;
procedure TScriptMethod.addVar( TheName, TheType : string);
begin;
  inc(Self.VarLen);
  SetLength(Self.Vars, self.varlen);
  Self.Vars[Self.VarLen - 1].VarName := TheName;
  Self.Vars[Self.VarLen - 1].VarType := TheType;
end;
procedure TScriptAnalyzer.AddVar( TheName, TheType : string);
begin;
  inc(Self.VarLen);
  SetLength(Self.Vars, self.VarLen);
  Self.Vars[Self.VarLen - 1].VarName := TheName;
  Self.Vars[Self.VarLen - 1].VarType := TheType;
end;
function TScriptMethod.AddMethod( iszehfunction : boolean; TheName : string) : TScriptMethod;
begin;
  inc(Self.MethodLen);
  SetLength(Self.Methods, Self.MethodLen);
  Self.Methods[Self.Methodlen - 1] := TScriptMethod.create(iszehfunction,TheName);
  Result :=Self.Methods[Self.Methodlen - 1];
end;



function TScriptAnalyzer.AddMethod( iszehfunction : boolean; Name : string) : TScriptMethod;
begin;
  inc(Self.MethodLen);
  SetLength(Self.Methods, Self.MethodLen);
  Self.Methods[Self.Methodlen - 1] := TScriptMethod.create(iszehfunction,Name);
  Result :=Self.Methods[Self.Methodlen - 1];
end;


procedure TScriptMethod.AddParam(TheName: string);
begin;
  inc(Self.ParameterLen);
  SetLength(Self.Parameters, self.ParameterLen);
  Self.Parameters[Self.ParameterLen - 1].VarName := TheName;
end;


procedure TScriptAnalyzer.analyze;
var
  LastTk : TTokenKind;
  StartPos,LastPos: integer;

  LastTkString : string;
  I : integer;
  TempInt : integer;
  InMethod : Boolean;
  ExpectingType : boolean; //Params and result
  WaitingForResult : boolean;
  StartParam : integer;
  StartVar : integer;
  Method : TScriptMethod;
  InTypes : Boolean;
  TempName : string;
  BeginCount : integer;
  InGlobal : boolean;
  InParams : boolean;
  InVarSection : Boolean;
  Lex : TmwPasLex;
begin
  Lex := TmwPasLex.Create;
  Lex.Origin := PChar(Self.ScriptToAnalyze);
  InTypes := False;
  InMethod := False;
  InParams := False;
  Method := nil;
  BeginCount := 0;
  ExpectingType := False;
  WaitingForResult := False;
  StartParam := 0;
  InVarSection := False;
  while (Lex.TokenID <> tkNull) do
  begin;
    LastTk := Lex.TokenID;
    LastPos := Lex.RunPos;
    Lex.NextNoJunk;
    case LastTk of
//      tkInclude : ShowMessage(Lex.Token);
//        if (FParser.Token[Length(FParser.Token)] = '}') then
//          FIncludes.Add(StringReplace(LowerCase(Trim(Copy(FParser.Token, 11, Length(FParser.Token) - 11))), '/', '\', [rfReplaceAll]));
      tkProgram : if Lex.TokenID = tkIdentifier then
                    Self.ScriptName := Lex.Token;
      tkRoundOpen: begin;
                     LastTkString := Lex.Token;
                     if InMethod and InParams then
                       StartParam := 0;
                   end;
      tkType      : InVarSection := False;
      tkBegin     : begin;

                      InVarSection := False;
                      if InMethod then
                        inc(BeginCount)
                      else if BeginCount = 0 then
                      begin;
                        InVarSection := false;
                        InMethod := true;
                        HasMain := True;
                        Method := Main;
                        Main.BeginPos := LastPos - 4;
                        Inc(BeginCount);
                      end;
                    end;
      tkCase      : begin;
                      if InMethod then
                        inc(BeginCount);
                    end;
      tkEnd       : if InMethod then
                    begin;
                      Dec(BeginCount);
                      if BeginCount = 0 then
                      begin;
                        Method.EndPos := LastPos;
                        InMethod := False;
                      end;
                    end;
      tkIdentifier: begin;
                      if (InMethod and InParams) or (InVarSection) then
                      begin;

{                        if ExpectingType then
                        begin;
                          FormAnalyzer.SynEdit1.Lines.add(copy( FormAnalyzer.SynEdit1.Lines.Text,StartPos, LastPos - StartPos));
                          LastTKString := copy( FormAnalyzer.SynEdit1.Lines.GetText,StartPos, Lex.TokenPos - StartPos);
                          for i := StartParam to Method.ParameterLen - 1 do
                            Method.Parameters[i].VarType := LastTkString;
                        end
                        else
                          Method.AddParam(LastTkString);    }
                        if not ExpectingType and InVarSection then
                          Method.AddVar(LastTKString,'') else
                        if not ExpectingType then
                          Method.AddParam(LastTKString);
                      end;
                    end;
      tkVar       : begin;
                      if InMethod and Not InParams then
                        InVarSection := True;
                      if not InMethod then
                      begin;
                        Method := Main;
                        InGlobal := True;
                        InVarSection := True;

                      end;
                      if InVarSection then
                        StartVar := Method.VarLen;
                      LastTKString := Lex.Token;
                    end;
      tkConst     : begin;
                      if not InMethod then
                        InVarSection := false;
                      LastTKString := Lex.token;
                    end;
      tkComma     : begin;
                      LastTKString := Lex.Token;
                    end;
      tkColon     : begin;
                      LastTkString := Lex.Token;
                      if (InMethod and InParams) or InVarSection then
                      begin;
                        ExpectingType := True;
                        StartPos := LastPos;
                      end
                      else if InMethod and WaitingForresult then
                      begin;
                        Method.Returns := Lex.Token;
                        WaitingForResult := False;
                      end;
                    end;
      tkSemiColon : begin;
                      if (InMethod and InParams) or (InVarSection) then
                      begin;
                        if ExpectingType then
                        begin;
                          LastTKString := Trim(copy( ScriptToAnalyze,StartPos + 1, LastPos - StartPos - 1));
                          if (InParams and InMethod) then
                            for i := StartParam to Method.ParameterLen - 1 do
                              Method.Parameters[i].VarType := LastTkString
                          else
                            for i := StartVar to Method.VarLen - 1 do
                              Method.Vars[i].VarType := LastTKString;
                          ExpectingType := False;
                        end;
                        LastTkString := Lex.Token;
                        StartParam := Method.ParameterLen;
                        StartVar := Method.VarLen;
                      end;
                    end;
      tkRoundClose: if InMethod and InParams then
                    begin;
                      if ExpectingType then
                      begin;
                        LastTKString := Trim(copy(ScriptToAnalyze,StartPos + 2, LastPos - StartPos - 2));
                        for i := StartParam to Method.ParameterLen - 1 do
                          Method.Parameters[i].VarType := LastTkString;
                        ExpectingType := False;
                      end;
                      InParams := False;
                    end;
      tkProcedure,
      tkFunction : begin;
                      if (InVarSection or (InMethod and InParams)) and ExpectingType then
                      begin;
                        //Do nothing since the this procedure/function is a var ;-)
                      end else
                      begin;
                        if not InMethod then
                          InVarSection := False;
                        if (not InTypes) and (not InVarSection) then
                        begin;
                          WaitingForResult := LastTK = tkFunction;
                          if Lex.TokenID <> tkIdentifier then
                          begin;
                            Writeln('Analyzer: No method name -> exiting');
                            exit;
                          end;
                          TempName := Lex.Token;
                          TempInt := Lex.TokenPos;
                          Lex.NextNoJunk;
                          if Lex.TokenID = tkRoundOpen then
                            InParams := True
                          else if Lex.TokenID = tkPoint then
                          begin;
                            Writeln('Analyzer: In class definition?');
    //                          FormAnalyzer.SynEdit2.Lines.add('In class definition *cough*');
                            Lex.NextNoJunk;
                            TempName := Lex.Token;
                          end else if ((Lex.TokenID = tkSemicolon) xor WaitingForResult) or ((Lex.TokenID = tkColon) xor WaitingForResult)  then
                          begin;
                            InParams := False;
                          end else
                          begin;
                            Writeln('Analyzer: You''re missing some stuff in the procedure declaration');
                            Exit;
                          end;
                          if InMethod then
                            Method := Method.AddMethod(WaitingForResult,TempName)
                          else
                            Method := Self.AddMethod(WaitingForResult,TempName);
                          InMethod := true;
                          Method.Beginpos := TempInt;

                        end;
                      end;
                    end;

    end;
//    SynEdit2.Lines.Add(TokeToString(Lex.TokenID) + '-' + Lex.Token);
  end;
end;

end.