RuntimeBuilder/Source/RuntimeBuilder.Lua.pas

unit RuntimeBuilder.Lua;

interface

uses
  System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows,System.Generics.Collections,
    pLuaObject,pLuaRecord,pLuaTable,uWordList,Lua,LuaObject,LuaWrapper,pLua,RuntimeBuilder;

type
  TRTBLuaCompiler=class(TRTBCompiler)
    protected type
      TRTBLuaSource=class(TRTBSource)
    	protected type
          TRTBLuaModule=class(TRTBModule)
            protected type
              TRTBLuaFunc=class(TRTBFunc)
                protected
                  State:Plua_State;
                  Name:string;
                public
                  constructor Create(Module:TRTBLuaModule;s:string);
                  function Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override;
                  destructor Destroy;override;
              end;
              TRTBLuaVar=class(TRTBVar)
                protected
                  State:Plua_State;
                  Name:string;
                  procedure SetVal(Val:TValue);override;
                  function GetVal:TValue;override;
                public
                  constructor Create(Module:TRTBLuaModule;s:string);
                  destructor Destroy;override;
              end;
            private
              State:Plua_State;
              function GetFuntion(Name:string):TRTBFunc;override;
              function GetVar(Name:string):TRTBVar;override;
            public
              constructor Create(AState:Plua_State);
              destructor Destroy;override;
          end;
        protected
          libs:TStringList;
          funcs:TStringList;
          regvars:TList<TPair<string,PTypeInfo>>;
          consts:TList<TPair<string,TValue>>;
          FText:string;
          //function GetIncLibs():string;
      	  function GetText:string;override;
          procedure SetText(const S:string);override;
        public
          constructor Create(Compiler:TRTBLuaCompiler);

          procedure LoadLib(const Name:string);override;
          procedure UnLoadLib(const Name:string);override;

          //procedure AddNameSpace(Name:string);override;
          //procedure DelNameSpace(Name:string);override;

          //procedure AddType(NameSpace:string;Name:string;&Type:TRTBType);override;
          //procedure DelType(NameSpace:string;Name:string);override;

          //procedure AddConst(NameSpace:string;Name:string;Val:TValue);override;
          //procedure DelConst(NameSpace:string;Name:string);override;

          //procedure AddCallBack(NameSpace:string;Name:string;CallBack:TRTBCallBack);override;
          //procedure DelCallBack(NameSpace:string;Name:string);override;

          //procedure AddVariable(NameSpace:string;Name:string;var Data);override;
          //procedure ExportVariable(NameSpace:string;Name:string;var Data);override;
          //procedure DelVariable(NameSpace:string;Name:string);override;

          procedure &Register(const NameSpace,Name:string;&Type:TRTBType);override;
          procedure UnRegister(const NameSpace,Name:string);override;
          procedure RegisterFunction(const NameSpace,Name:string);override;
          procedure UnRegisterFunction(const NameSpace,Name:string);override;

          class procedure AddToStack(State:Plua_State;Data:TValue);static;
          class function GetFromStack(State:Plua_State):TValue;static;

          function Compilate:TRTBModule;override;
          destructor Destroy;override;
      end;
    public
      constructor Create();
      function GenNewSrc():TRTBSource;override;
  end;

const
  cLuaLangName='Lua';

implementation

uses System.SysUtils;

const
  cCurLang=cLuaLangName;

{constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaFunc.Create(p:Pointer;sb:NativeUInt);
begin
Self.p:=VirtualAlloc(nil,sb,MEM_COMMIT ,PAGE_EXECUTE_READWRITE);
CopyMemory(Self.p,p,sb);
Self.sb:=sb;
FreeMem(p);
end;

function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
begin
end;

destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaFunc.Destroy;
begin
VirtualFree(p,sb,MEM_RELEASE);
p:=nil;
end;

constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.TRTBLuaLibFunc.Create(p:Pointer);
begin
Self.p:=p;
end;

destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.TRTBLuaLibFunc.Destroy;
begin
p:=nil;
end;

function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBLuaLibFunc.Create(GetProcAddress(Lib,pwidechar(Name)));
end;

constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.Create(Name:string);
begin
filename:=Name;
Lib:=LoadLibrary(pwidechar(Name));
end;

destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaLib.Destroy;
begin
FreeLibrary(Lib);
end;}

constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Create(Module:TRTBLuaModule;s:string);
begin
Name:=s;
State:=Module.State;
end;

function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Call(OutType:PTypeInfo;args:TArray<TValue>;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;
var
  i:TValue;
begin
lua_getfield(State,LUA_GLOBALSINDEX,PAnsiChar(Name));
for i in args do
  TRTBLuaSource.AddToStack(State,i);
lua_pcall(State,length(args),1);
Result:=TRTBLuaSource.GetFromStack(State);
end;

destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaFunc.Destroy;
begin
end;

procedure TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaVar.SetVal(Val:TValue);
begin
TRTBLuaSource.AddToStack(State,Val);
lua_setfield(State,LUA_GLOBALSINDEX,PAnsiChar(Name));
end;

function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaVar.GetVal:TValue;
begin
lua_getfield(State,LUA_GLOBALSINDEX,PAnsiChar(Name));
Result:=TRTBLuaSource.GetFromStack(State);
end;

constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaVar.Create(Module:TRTBLuaModule;s:string);
begin
Name:=s;
State:=Module.State;
end;

destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.TRTBLuaVar.Destroy;
begin
end;

function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.GetFuntion(Name:string):TRTBFunc;
begin
Result:=TRTBLuaFunc.Create(self,Name);
end;

function TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.GetVar(Name:string):TRTBVar;
begin
Result:=TRTBLuaVar.Create(self,Name);
end;

constructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.Create(AState:Plua_State);
begin
State:=AState;
end;

destructor TRTBLuaCompiler.TRTBLuaSource.TRTBLuaModule.Destroy;
begin
lua_close(State);
end;

function TRTBLuaCompiler.TRTBLuaSource.GetText:string;
begin
Result:=FText;
end;

procedure TRTBLuaCompiler.TRTBLuaSource.SetText(const S:string);
begin
FText:=S;
end;

constructor TRTBLuaCompiler.TRTBLuaSource.Create(Compiler:TRTBLuaCompiler);
begin
inherited Create(Compiler);
FText:='';
libs:=TStringList.Create;
funcs:=TStringList.Create;
regvars:=TList<TPair<string,PTypeInfo>>.Create;
consts:=TList<TPair<string,TValue>>.Create;
end;

procedure TRTBLuaCompiler.TRTBLuaSource.LoadLib(const Name:string);
begin
libs.Add(Name);
end;

procedure TRTBLuaCompiler.TRTBLuaSource.UnLoadLib(const Name:string);
begin
with libs do
  Delete(IndexOf(Name));
end;

procedure TRTBLuaCompiler.TRTBLuaSource.&Register(const NameSpace,Name:string;&Type:TRTBType);
begin
end;

procedure TRTBLuaCompiler.TRTBLuaSource.UnRegister(const NameSpace,Name:string);
begin
end;

procedure TRTBLuaCompiler.TRTBLuaSource.RegisterFunction(const NameSpace,Name:string);
begin
end;

procedure TRTBLuaCompiler.TRTBLuaSource.UnRegisterFunction(const NameSpace,Name:string);
begin
end;

class procedure TRTBLuaCompiler.TRTBLuaSource.AddToStack(State:Plua_State;Data:TValue);
var
  i:NativeUInt;
  rtype:TRTTIType;
begin
with Data do
  if IsType<AnsiString> or IsType<RawByteString> or IsType<UTF8String> then
    lua_pushstring(State,PAnsiChar(AsType<AnsiString>))
  else if IsType<ShortString> then
    lua_pushstring(State,PAnsiChar(String(AsType<ShortString>)))
  else if IsType<WideString> then
    lua_pushstring(State,PAnsiChar(AsType<WideString>))
  else if IsType<UCS4String> then
    lua_pushstring(State,PAnsiChar(AsType<UCS4String>))
  else if IsOrdinal then
    lua_pushinteger(State,Data.AsOrdinal)
  else if IsType<Single> then
    lua_pushnumber(State,AsType<Single>)
  else if IsType<Double> then
    lua_pushnumber(State,AsType<Double>)
  else if IsType<Extended> then
    lua_pushnumber(State,AsExtended)
  else if IsType<Real> then
    lua_pushnumber(State,AsExtended)
  else if IsType<Real48> then
    lua_pushnumber(State,AsType<Real48>)
  else if IsType<Comp> then
    lua_pushnumber(State,AsType<Comp>)
  else if IsType<Currency> then
    lua_pushnumber(State,AsType<Currency>)
  else if Kind=tkPointer then
    lua_pushlightuserdata(State,AsType<Pointer>)
  else if IsArray then
  begin
    lua_createtable(State,Data.GetArrayLength,0);
    for i:=0 to Data.GetArrayLength-1 do
    begin
      lua_pushinteger(State,i);
      AddToStack(State,Data.GetArrayElement(i));
      lua_settable(State,-3);
    end;
  end
  else if Data.Kind=tkRecord then
  begin
    rtype:=TRTTIContext.Create.GetType(Data.TypeInfo);
  end
  //else if Data.Kind=tkUnknown then
  //  PreDecl:=PreDecl+Key+': times '+ Value.DataSize.ToString+' db 0'+sLineBreak;
  else
  begin
    //lua_pushlightuserdata(State,);
  end;
end;

class function TRTBLuaCompiler.TRTBLuaSource.GetFromStack(State:Plua_State):TValue;
begin
case lua_type(State,-1) of
LUA_TNIL:            Result:=TValue.Empty;
LUA_TBOOLEAN:        Result:=lua_toboolean(State,-1);
LUA_TLIGHTUSERDATA:  Result:=lua_touserdata(State,-1);
LUA_TNUMBER:
begin
  Result:=lua_tonumber(State,-1);
  if Result.AsType<lua_Number> =Round(Result.AsType<lua_Number>) then
    Result:=Round(Result.AsType<lua_Number>)
end;
LUA_TSTRING:Result:=lua_tostring(State,-1);
//LUA_TTABLE:Result:=lua_totable(State,-1);
//LUA_TFUNCTION:Result:=lua_tostring(State,-1);
LUA_TUSERDATA:Result:=lua_touserdata(State,-1);
LUA_TTHREAD:Result:=TValue.From<Plua_State>(lua_tothread(State,-1));
end;
lua_pop(State,1);
end;

function TRTBLuaCompiler.TRTBLuaSource.Compilate:TRTBModule;
  procedure ConstParse(key:string;value:TValue;var PreDecl:string;var base:NativeUInt);
  var
    i:NativeUInt;
    p0:PByte;
  begin
        if Value.IsType<AnsiString> or Value.IsType<RawByteString> or Value.IsType<UTF8String> then
        begin
          PreDecl:=PreDecl+Key+' db '+#39+Value.AsType<AnsiString>+#39+',0'+sLineBreak;
          inc(base,length(Value.AsType<AnsiString>));
        end
        else if Value.IsType<ShortString> then
        begin
          PreDecl:=PreDecl+Key+' db '+#39+Value.AsType<ShortString>+#39+',0'+sLineBreak;
          inc(base,length(Value.AsType<ShortString>));
        end
        else if Value.IsType<WideString> then
        begin
          PreDecl:=PreDecl+Key+' db ';
          p0:=Pointer(PWideChar(Value.AsType<WideString>));
          for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType<WideString>){$IFDEF NEXTGEN}-1{$ENDIF} do
          begin
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
          end;
          PreDecl:=PreDecl+'0,0'+sLineBreak;
          inc(base,length(Value.AsType<WideString>)*2);
        end
        else if Value.IsType<UCS4String> then
        begin
          PreDecl:=PreDecl+Key+' db ';
          p0:=Pointer(PWideChar(Value.AsType<UCS4String>));
          for i:={$IFDEF NEXTGEN}0{$ELSE}1{$ENDIF} to length(Value.AsType<UCS4String>){$IFDEF NEXTGEN}-1{$ENDIF} do
          begin
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
            PreDecl:=PreDecl+inttostr(p0^)+',';
            inc(p0);
          end;
          PreDecl:=PreDecl+'0,0,0,0'+sLineBreak;
          inc(base,length(Value.AsType<UCS4String>)*4);
        end
        else if Value.IsOrdinal then
          PreDecl:=PreDecl+Key+' equ '+Value.AsOrdinal.ToString+sLineBreak
        else if Value.Kind=tkFloat then
        begin
          if Value.IsType<Single> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Single>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Double> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Double>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Extended> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Extended>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Real> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Real>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Real48> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Real48>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Comp> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Comp>,ffFixed,1000,1000)+sLineBreak
          else if Value.IsType<Currency> then
            PreDecl:=PreDecl+Key+' equ '+FloatToStrF(Value.AsType<Currency>,ffFixed,1000,1000)+sLineBreak
          else
            PreDecl:=PreDecl+Key+' equ 0.0'+sLineBreak;
        end
        else if Value.Kind=tkPointer then
          PreDecl:=PreDecl+Key+' equ '+NativeUInt(Value.AsType<Pointer>).ToString+sLineBreak
        else if Value.IsArray then
        begin
          if Value.GetArrayLength=0 then
          begin
            PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
          end
          else
          begin
            PreDecl:=PreDecl+Key+':'+sLineBreak;
            for i:=0 to Value.GetArrayLength-1 do
              //VarParse(key+'.i'+i.ToString,Value.GetArrayElement(i),PreDecl,Base);
          end;
        end
        else //if Value.Kind=tkUnknown then
          PreDecl:=PreDecl+Key+' equ 0'+sLineBreak;
  end;
var
  s,PreDecl:string;
  i,sb:NativeUInt;
  RegVarDict:TDictionary<string,TPair<NativeUInt,PTypeInfo>>;
  p:pointer;
  State:Plua_State;
begin
PreDecl:='';
for s in libs do
  PreDecl:=PreDecl+'local '+s+'=require("'+s+'")';
{RegVarDict:=TDictionary<string,TPair<NativeUInt,PTypeInfo>>.Create();
with regvars do
  if Count<>0 then
    for i:=0 to Count-1 do
    begin
      PreDecl:=PreDecl+pointerDecl+Items[i].Key+sLineBreak;
      RegVarDict.Add(Items[i].Key,TPair<NativeUInt,PTypeInfo>.Create(base,Items[i].Value));
      inc(base,SizeOf(pointer));
    end;
with consts do
  if Count<>0 then
    for i:=0 to Count-1 do
      with Items[i] do
        ConstParse(Key,Value,PreDecl,base);}
State:=luaL_newstate();
if State=nil then
  ERTBError.Create(RTBBuildError,cCurLang,self);
luaL_openlibs(State);
luaL_loadbuffer(State,PAnsiChar(FText),length(s),'code');
Result:=TRTBLuaModule.Create(State);
end;

destructor TRTBLuaCompiler.TRTBLuaSource.Destroy;
begin
FreeAndNil(libs);
FreeAndNil(funcs);
FreeAndNil(regvars);
FreeAndNil(consts);
end;

constructor TRTBLuaCompiler.Create();
begin
inherited Create();
end;

function TRTBLuaCompiler.GenNewSrc():TRTBSource;
begin
Result:=TRTBLuaSource.Create(Self);
end;

end.