160 lines
9.9 KiB
ObjectPascal
160 lines
9.9 KiB
ObjectPascal
unit RuntimeBuilder;
|
||
|
||
interface
|
||
|
||
//************************************
|
||
//*Copyright (c) 2018 Artem Gavrilov.*
|
||
//*Website: https://teamfnd.ru *
|
||
//*License: GPL or *
|
||
//************************************
|
||
|
||
uses
|
||
{$IFNDEF FPC}System.TypInfo{$ELSE}TypInfo{$ENDIF},
|
||
{$IFNDEF FPC}System.SysUtils{$ELSE}SysUtils{$ENDIF},
|
||
{$IFNDEF FPC}System.Rtti,{$ENDIF}Variants;
|
||
|
||
const
|
||
CRTBCallTypeNil=ccStdCall;
|
||
CRTBCallTypeRegister=ccReg;
|
||
CRTBCallTypeStdCall=ccStdCall;
|
||
CRTBCallTypeCdecl=ccCdecl;
|
||
CRTBCallTypePascal=ccPascal;
|
||
CRTBCallTypeSafeCall=ccSafeCall;
|
||
CRTBCallType64Call=CRTBCallTypeNil;
|
||
CRTBCallTypeScript=CRTBCallTypeNil;
|
||
CRTBCallTypeDefault=CRTBCallTypeNil;
|
||
|
||
type
|
||
TRTBCompiler=class;
|
||
|
||
TRTBCallType=TCallConv;
|
||
|
||
TRTBType=PTypeInfo;
|
||
|
||
{$ifdef fpc}
|
||
TValue = Variant;
|
||
{$endif}
|
||
|
||
TRTBArgArray = {$ifdef fpc}specialize{$endif} TArray<TValue>;
|
||
|
||
TRTBFunc=class abstract
|
||
public
|
||
function Call(OutType:PTypeInfo;args:TRTBArgArray;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract;
|
||
end;
|
||
|
||
TRTBCallBackOut=TValue;
|
||
TRTBCallBack={$ifndef fpc}reference to{$endif} function(arg:array of const):TRTBCallBackOut;
|
||
|
||
TRTBVar=class abstract
|
||
protected
|
||
procedure SetVal(Val:TValue);virtual;abstract;
|
||
function GetVal:TValue;virtual;abstract;
|
||
public
|
||
property Val:TValue read GetVal write SetVal;
|
||
end;
|
||
|
||
TRTBModule=class abstract
|
||
protected
|
||
function GetFuntion(Name:string):TRTBFunc;virtual;abstract;
|
||
function GetVar(Name:string):TRTBVar;virtual;abstract;
|
||
public
|
||
property Funtion[Name:string]:TRTBFunc read GetFuntion;
|
||
property &Var[Name:string]:TRTBVar read GetVar;
|
||
end;
|
||
|
||
TRTBSource=class abstract
|
||
protected
|
||
Compiler:TRTBCompiler;
|
||
function GetText:string;virtual;abstract;
|
||
procedure SetText(const S:string);virtual;abstract;
|
||
public
|
||
constructor Create(ACompiler:TRTBCompiler);
|
||
|
||
procedure LoadLib(const Name:string);virtual;abstract;
|
||
procedure UnLoadLib(const Name:string);virtual;abstract;
|
||
|
||
procedure AddNameSpace(const Name:string);virtual;abstract;
|
||
procedure DelNameSpace(const Name:string);virtual;abstract;
|
||
|
||
procedure AddType(const NameSpace,Name:string;&Type:TRTBType);virtual;abstract;//добавляет тип
|
||
procedure DelType(const NameSpace,Name:string);virtual;abstract;
|
||
|
||
procedure AddConst(const NameSpace,Name:string;Val:TValue);virtual;abstract;//добавляет константу
|
||
procedure DelConst(const NameSpace,Name:string);virtual;abstract;
|
||
|
||
procedure AddVariable(const NameSpace,Name:string;var Data);virtual;abstract;//добавляет переменную,инициализируя её значение
|
||
procedure ExportVariable(const NameSpace,Name:string;var Data);virtual;abstract;//добавляет переменную,синххронизированную с Data
|
||
procedure DelVariable(const NameSpace,Name:string);virtual;abstract;
|
||
|
||
procedure AddCallBack(const NameSpace,Name:string;CallBack:TRTBCallBack);virtual;abstract;//добавляет функцию/процедуру/метод
|
||
procedure DelCallBack(const NameSpace,Name:string);virtual;abstract;
|
||
|
||
procedure &Register(const NameSpace,Name:string;&Type:TRTBType);virtual;abstract;//регистрирует переменную объявленную в скрипте
|
||
procedure UnRegister(const NameSpace,Name:string);virtual;abstract;
|
||
procedure &RegisterFunction(const NameSpace,Name:string);virtual;abstract;//регистрирует функцию объявленную в скрипте
|
||
procedure UnRegisterFunction(const NameSpace,Name:string);virtual;abstract;
|
||
|
||
function Compilate:TRTBModule;virtual;abstract;
|
||
procedure LoadFromFile(const &File:string);virtual;
|
||
procedure SaveToFile(const &File:string);virtual;
|
||
property Text:string read GetText write SetText;
|
||
end;
|
||
|
||
TRTBCompiler=class abstract
|
||
public
|
||
function GenNewSrc():TRTBSource;virtual;abstract;
|
||
end;
|
||
|
||
ERTBError=class(Exception)
|
||
public
|
||
type
|
||
TRTBError=(
|
||
RTBUnknownError,
|
||
RTBBuildError
|
||
);
|
||
var
|
||
Error:TRTBError;
|
||
ProgLangName:String;
|
||
Obj:TObject;
|
||
constructor Create(AError:TRTBError;AProgLangName:String;AObj:TObject);
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses
|
||
{$IFNDEF FPC}System.Classes{$ELSE}Classes{$ENDIF};
|
||
|
||
constructor TRTBSource.Create(ACompiler:TRTBCompiler);
|
||
begin
|
||
Self.Compiler:=ACompiler;
|
||
end;
|
||
|
||
procedure TRTBSource.LoadFromFile(const &File:string);
|
||
var
|
||
Data:TStrings;
|
||
begin
|
||
Data:=TStringList.Create;
|
||
Data.LoadFromFile(&File);
|
||
Text:=Data.Text;
|
||
FreeAndNil(Data);
|
||
end;
|
||
|
||
procedure TRTBSource.SaveToFile(const &File:string);
|
||
var
|
||
Data:TStrings;
|
||
begin
|
||
Data:=TStringList.Create;
|
||
Data.Text:=Text;
|
||
Data.SaveToFile(&File);
|
||
FreeAndNil(Data);
|
||
end;
|
||
|
||
constructor ERTBError.Create(AError:TRTBError;AProgLangName:String;AObj:TObject);
|
||
begin
|
||
Error:=AError;
|
||
ProgLangName:=AProgLangName;
|
||
Obj:=AObj;
|
||
inherited Create('Programming Langguage"'+AProgLangName+'" error in '+Obj.ClassName);
|
||
end;
|
||
|
||
end. |