paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 09:29:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Mattias Gaertner

Browse Source 
-init simple variables
 -init function result variable and return function result variable
 -unit initialization
 -program main begin..end
 -CreateMemberExpression: members are now passed in order
 -convert unit and program
 -interface functions and vars are now declared with 'this.'

git-svn-id: trunk@34227 -
This commit is contained in:
michael 2016-07-29 14:27:02 +00:00
parent 7712f049df
commit 1228b043c0
2 changed files with 361 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

493
packages/pastojs/src/fppas2js.pp
View File

@ -19,7 +19,7 @@ unit fppas2js;
interface interface
uses uses
Classes, SysUtils, jsbase, jstree, pastree, pparser; Classes, SysUtils, jsbase, jstree, pastree;
Type Type
EPas2JS = Class(Exception); EPas2JS = Class(Exception);
@ -40,7 +40,7 @@ Type
Function CreateBuiltInIdentifierExpr(AName: string): TJSPrimaryExpressionIdent; Function CreateBuiltInIdentifierExpr(AName: string): TJSPrimaryExpressionIdent;
Function CreateIdentifierExpr(AName: string; El: TPasElement; AContext: TConvertContext): TJSPrimaryExpressionIdent; Function CreateIdentifierExpr(AName: string; El: TPasElement; AContext: TConvertContext): TJSPrimaryExpressionIdent;
Function CreateTypeDecl(El: TPasType; AContext: TConvertContext): TJSElement; Function CreateTypeDecl(El: TPasType; AContext: TConvertContext): TJSElement;
Function CreateVarDecl(El: TPasVariable; AContext: TConvertContext): TJSElement; Function CreateVarDecl(El: TPasVariable; AContext: TConvertContext; TopLvl: boolean): TJSElement;
procedure SetCurrentContext(AValue: TJSElement); procedure SetCurrentContext(AValue: TJSElement);
procedure RaiseNotYetImplemented(El: TPasElement; AContext: TConvertContext); procedure RaiseNotYetImplemented(El: TPasElement; AContext: TConvertContext);
protected protected
@ -61,12 +61,16 @@ Type
Function CreateCallStatement(const JSCallName: string; JSArgs: array of string): TJSCallExpression; Function CreateCallStatement(const JSCallName: string; JSArgs: array of string): TJSCallExpression;
Function CreateCallStatement(const FunNameEx: TJSElement; JSArgs: array of string): TJSCallExpression; Function CreateCallStatement(const FunNameEx: TJSElement; JSArgs: array of string): TJSCallExpression;
Function CreateProcedureDeclaration(const El: TPasElement):TJSFunctionDeclarationStatement; Function CreateProcedureDeclaration(const El: TPasElement):TJSFunctionDeclarationStatement;
Function CreateUnary(ms: array of string; E: TJSElement): TJSUnary; Function CreateUnary(Members: array of string; E: TJSElement): TJSUnary;
Function CreateMemberExpression(ReversedValues: array of string): TJSDotMemberExpression; Function CreateMemberExpression(Members: array of string): TJSDotMemberExpression;
Procedure AddProcedureToClass(sl: TJSStatementList; E: TJSElement;const P: TPasProcedure); Procedure AddProcedureToClass(sl: TJSStatementList; E: TJSElement;const P: TPasProcedure);
Function GetFunctionDefinitionInUnary(const fd: TJSFunctionDeclarationStatement;const funname: TJSString; inunary: boolean): TJSFunctionDeclarationStatement; Function GetFunctionDefinitionInUnary(const fd: TJSFunctionDeclarationStatement;const funname: TJSString; inunary: boolean): TJSFunctionDeclarationStatement;
Function GetFunctionUnaryName(var je: TJSElement;out fundec: TJSFunctionDeclarationStatement): TJSString; Function GetFunctionUnaryName(var je: TJSElement;out fundec: TJSFunctionDeclarationStatement): TJSString;
Function CreateUsesList(UsesList: TFPList; AContext : TConvertContext): TJSArrayLiteral; Function CreateUsesList(UsesList: TFPList; AContext : TConvertContext): TJSArrayLiteral;
Procedure AddToStatementList(var First, Last: TJSStatementList;
Add: TJSElement; Src: TPasElement);
Function CreateValInit(PasType: TPasType; Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;virtual;
Function CreateVarInit(El: TPasVariable; AContext: TConvertContext): TJSElement;virtual;
// Statements // Statements
Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext): TJSElement;virtual; Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext): TJSElement;virtual;
Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext): TJSElement;virtual; Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext): TJSElement;virtual;
@ -133,6 +137,7 @@ Type
var var
DefaultJSExceptionObject: string = 'exceptObject'; DefaultJSExceptionObject: string = 'exceptObject';
implementation implementation
resourcestring resourcestring
@ -174,21 +179,20 @@ end;
function TPasToJSConverter.ConvertModule(El: TPasModule; function TPasToJSConverter.ConvertModule(El: TPasModule;
AContext: TConvertContext): TJSElement; AContext: TConvertContext): TJSElement;
(* ToDo: (* Format:
rtl.module('<unitname>', rtl.module('<unitname>',
[<interface uses1>,<uses2>, ...], [<interface uses1>,<uses2>, ...],
function(uses,unit){ function(){
<interface> <interface>
<implementation> <implementation>
$<unitname>_init:function(){ this.$init=function(){
<initialization> <initialization>
}; };
this.impl=$impl;
}, },
[<implementation uses1>,<uses2>, ...]); [<implementation uses1>,<uses2>, ...]);
*) *)
Var Var
Src , UnitSrc: TJSSourceElements; OuterSrc , Src: TJSSourceElements;
RegModuleCall: TJSCallExpression; RegModuleCall: TJSCallExpression;
ArgArray: TJSArguments; ArgArray: TJSArguments;
UsesList: TFPList; UsesList: TFPList;
@ -196,85 +200,90 @@ Var
FunBody: TJSFunctionBody; FunBody: TJSFunctionBody;
FunDecl: TJSFunctionDeclarationStatement; FunDecl: TJSFunctionDeclarationStatement;
ArgEx: TJSLiteral; ArgEx: TJSLiteral;
UsesSection: TPasSection;
ModuleName: String;
begin begin
Result:=Nil; Result:=Nil;
if (El.ClassType=TPasModule) or (El is TPasUnitModule) then OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
begin Result:=OuterSrc;
Src:=TJSSourceElements(CreateElement(TJSSourceElements, El));
Result:=Src;
// create 'rtl.module(...)' // create 'rtl.module(...)'
RegModuleCall:=TJSCallExpression(CreateElement(TJSCallExpression,El)); RegModuleCall:=TJSCallExpression(CreateElement(TJSCallExpression,El));
AddToSourceElements(Src,RegModuleCall); AddToSourceElements(OuterSrc,RegModuleCall);
RegModuleCall.Expr:=CreateMemberExpression(['module','rtl']); RegModuleCall.Expr:=CreateMemberExpression(['rtl','module']);
ArgArray := TJSArguments.Create(0, 0, ''); ArgArray := TJSArguments.Create(0, 0, '');
RegModuleCall.Args:=ArgArray; RegModuleCall.Args:=ArgArray;
// add parameter: unitname // add parameter: unitname
ArgEx := TJSLiteral.Create(0,0,''); ArgEx := TJSLiteral.Create(0,0,'');
ArgEx.Value.AsString:=TJSString(TransformVariableName(El.Name,AContext)); ModuleName:=El.Name;
ArgArray.Elements.AddElement.Expr:=ArgEx; if El is TPasProgram then
ModuleName:='program';
ArgEx.Value.AsString:=TJSString(TransformVariableName(ModuleName,AContext));
ArgArray.Elements.AddElement.Expr:=ArgEx;
// add parameter: [<interface uses1>,<uses2>, ...] // add parameter: [<interface uses1>,<uses2>, ...]
UsesList:=nil; UsesSection:=nil;
if Assigned(El.InterfaceSection) then if (El is TPasProgram) then
UsesList:=El.InterfaceSection.UsesList; UsesSection:=TPasProgram(El).ProgramSection
ArgArray.Elements.AddElement.Expr:=CreateUsesList(UsesList,AContext); else if (El is TPasLibrary) then
UsesSection:=TPasLibrary(El).LibrarySection
else
UsesSection:=El.InterfaceSection;
UsesList:=nil;
if UsesSection<>nil then
UsesList:=UsesSection.UsesList;
ArgArray.Elements.AddElement.Expr:=CreateUsesList(UsesList,AContext);
// add parameter: function(uses, unit){} // add parameter: function(){}
FunDecl:=TJSFunctionDeclarationStatement.Create(0,0,''); FunDecl:=TJSFunctionDeclarationStatement.Create(0,0,'');
ArgArray.Elements.AddElement.Expr:=FunDecl; ArgArray.Elements.AddElement.Expr:=FunDecl;
FunDef:=TJSFuncDef.Create; FunDef:=TJSFuncDef.Create;
FunDecl.AFunction:=FunDef; FunDecl.AFunction:=FunDef;
FunDef.Name:=''; FunDef.Name:='';
FunDef.Params.Add('uses'); FunBody:=TJSFunctionBody.Create(0,0,'');
FunDef.Params.Add('unit'); FunDef.Body:=FunBody;
FunBody:=TJSFunctionBody.Create(0,0,''); Src:=TJSSourceElements(CreateElement(TJSSourceElements, El));
FunDef.Body:=FunBody; FunBody.A:=Src;
UnitSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
FunBody.A:=UnitSrc;
// add interface section if (El is TPasProgram) then
if Assigned(El.InterfaceSection) then begin // program
AddToSourceElements(UnitSrc,ConvertElement(El.InterfaceSection,AContext)); if Assigned(TPasProgram(El).ProgramSection) then
// add implementation section AddToSourceElements(Src,ConvertElement(TPasProgram(El).ProgramSection,AContext));
if Assigned(El.ImplementationSection) then // add main section
AddToSourceElements(UnitSrc,ConvertElement(El.ImplementationSection,AContext)); if Assigned(El.InitializationSection) then
// add initialization section AddToSourceElements(Src,ConvertElement(El.InitializationSection,AContext));
if Assigned(El.InitializationSection) then end
AddToSourceElements(UnitSrc,ConvertElement(El.InitializationSection,AContext)); else if El is TPasLibrary then
if Assigned(El.FinalizationSection) then begin // library
raise Exception.Create('TPasToJSConverter.ConvertModule: finalization section is not supported'); if Assigned(TPasLibrary(El).LibrarySection) then
AddToSourceElements(Src,ConvertElement(TPasLibrary(El).LibrarySection,AContext));
// add parameter: [<implementation uses1>,<uses2>, ...] // add initialization section
UsesList:=nil; if Assigned(El.InitializationSection) then
if Assigned(El.ImplementationSection) then AddToSourceElements(Src,ConvertElement(El.InitializationSection,AContext));
UsesList:=El.ImplementationSection.UsesList;
ArgArray.Elements.AddElement.Expr:=CreateUsesList(UsesList,AContext);
end end
else else
begin begin // unit
Src:=TJSSourceElements(CreateElement(TJSSourceElements,El)); // add interface section
Result:=Src; if Assigned(El.InterfaceSection) then
if Assigned(El.InterfaceSection) then AddToSourceElements(Src,ConvertElement(El.InterfaceSection,AContext));
AddToSourceElements(Src,ConvertElement(El.InterfaceSection,AContext)); // add implementation section
if assigned(El.ImplementationSection) then if Assigned(El.ImplementationSection) then
AddToSourceElements(Src,ConvertElement(El.ImplementationSection,AContext)); AddToSourceElements(Src,ConvertElement(El.ImplementationSection,AContext));
if (El is TPasProgram) then // add initialization section
begin if Assigned(El.InitializationSection) then
if Assigned(TPasProgram(El).ProgramSection) then AddToSourceElements(Src,ConvertElement(El.InitializationSection,AContext));
AddToSourceElements(Src,ConvertElement(TPasProgram(El).ProgramSection,AContext)); // finalization: not supported
end; if Assigned(El.FinalizationSection) then
if Assigned(El.InitializationSection) then raise Exception.Create('TPasToJSConverter.ConvertModule: finalization section is not supported');
AddToSourceElements(Src,ConvertElement(El.InitializationSection,AContext)); // add optional implementation uses list: [<implementation uses1>,<uses2>, ...]
if Assigned(El.FinalizationSection) then if Assigned(El.ImplementationSection) then
//AddToSourceElements(Src,ConvertElement(El.FinalizationSection,AContext)); begin
raise Exception.Create('TPasToJSConverter.ConvertModule: finalization section is not supported'); UsesList:=El.ImplementationSection.UsesList;
if (UsesList<>nil) and (UsesList.Count>0) then
ArgArray.Elements.AddElement.Expr:=CreateUsesList(UsesList,AContext);
end;
end; end;
{
TPasUnitModule = Class(TPasModule)
TPasLibrary = class(TPasModule)
}
end; end;
function TPasToJSConverter.CreateElement(C: TJSElementClass; Src: TPasElement function TPasToJSConverter.CreateElement(C: TJSElementClass; Src: TPasElement
@ -512,7 +521,7 @@ begin
else else
begin begin
TJSCallExpression(B).Expr := TJSCallExpression(B).Expr :=
CreateMemberExpression(['call', funname, 'prototype', '_super']); CreateMemberExpression(['_super', 'prototype', funname, 'call']);
end; end;
end end
else else
@ -782,52 +791,87 @@ begin
end; end;
function TPasToJSConverter.CreateVarDecl(El: TPasVariable; function TPasToJSConverter.CreateVarDecl(El: TPasVariable;
AContext: TConvertContext): TJSElement; AContext: TConvertContext; TopLvl: boolean): TJSElement;
Var Var
C : TJSElement; C : TJSElement;
V : TJSVariableStatement; V : TJSVariableStatement;
AssignSt: TJSSimpleAssignStatement;
VarName: String;
begin begin
C:=ConvertElement(El,AContext); if TopLvl then
V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El)); begin
V.A:=C; // create 'this.A=initvalue'
Result:=V; AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
Result:=AssignSt;
VarName:=TransformVariableName(El.Name,AContext);
AssignSt.LHS:=CreateMemberExpression(['this',VarName]);
AssignSt.Expr:=CreateVarInit(El,AContext);
end
else
begin
// create 'var A=initvalue'
C:=ConvertElement(El,AContext);
V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
V.A:=C;
Result:=V;
end;
end; end;
function TPasToJSConverter.ConvertDeclarations(El: TPasDeclarations; function TPasToJSConverter.ConvertDeclarations(El: TPasDeclarations;
AContext: TConvertContext): TJSElement; AContext: TConvertContext): TJSElement;
Var Var
SL : TJSStatementList;
E : TJSElement; E : TJSElement;
SLFirst, SLLast: TJSStatementList;
P: TPasElement;
IsTopLvl, IsProcBody, IsFunction: boolean;
I : Integer;
Procedure AddToStatementList; Procedure AddFunctionResultInit;
var var
SL2: TJSStatementList; VarSt: TJSVariableStatement;
AssignSt: TJSSimpleAssignStatement;
PasFun: TPasFunction;
FunType: TPasFunctionType;
ResultEl: TPasResultElement;
begin begin
if Assigned(E) then PasFun:=El.Parent as TPasFunction;
begin FunType:=PasFun.FuncType;
if Assigned(SL.A) then ResultEl:=FunType.ResultEl;
begin
SL2:=TJSStatementList(CreateElement(TJSStatementList,El)); // add 'var result=initvalue'
SL.B:=SL2; VarSt:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
SL:=SL2; AddToStatementList(SLFirst,SLLast,VarSt,El);
end; Result:=SLFirst;
SL.A:=E; AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
end; VarSt.A:=AssignSt;
AssignSt.LHS:=CreateBuiltInIdentifierExpr('result');
AssignSt.Expr:=CreateValInit(ResultEl.ResultType,nil,El,AContext);
end; end;
Var Procedure AddFunctionResultReturn;
P : TPasElement; var
I : Integer; RetSt: TJSReturnStatement;
begin begin
if (El.Declarations.Count=0) then RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
exit(nil); RetSt.Expr:=CreateBuiltInIdentifierExpr('result');
AddToStatementList(SLFirst,SLLast,RetSt,El);
end;
begin
Result:=nil;
SLFirst:=nil;
SLLast:=nil;
IsTopLvl:=El.Parent is TPasModule;
IsProcBody:=(El is TProcedureBody) and (TProcedureBody(El).Body<>nil);
IsFunction:=IsProcBody and (El.Parent is TPasFunction);
if IsProcBody and IsFunction then
AddFunctionResultInit;
SL:=TJSStatementList(CreateElement(TJSStatementList,El));
Result:=SL;
For I:=0 to El.Declarations.Count-1 do For I:=0 to El.Declarations.Count-1 do
begin begin
E:=Nil; E:=Nil;
@ -835,23 +879,30 @@ begin
if P is TPasConst then if P is TPasConst then
E:=CreateConstDecl(TPasConst(P),AContext) E:=CreateConstDecl(TPasConst(P),AContext)
else if P is TPasVariable then else if P is TPasVariable then
E:=CreateVarDecl(TPasVariable(P),AContext) E:=CreateVarDecl(TPasVariable(P),AContext,IsTopLvl)
else if P is TPasType then else if P is TPasType then
E:=CreateTypeDecl(TPasType(P),AContext) E:=CreateTypeDecl(TPasType(P),AContext)
else if P is TPasProcedure then else if P is TPasProcedure then
E:=ConvertElement(P,AContext) E:=ConvertProcedure(TPasProcedure(P),AContext)
else else
DoError('Unknown class: "%s" ',[P.ClassName]); DoError('Unknown class: "%s" ',[P.ClassName]);
if (Pos('.', P.Name) > 0) then if (Pos('.', P.Name) > 0) then
AddProcedureToClass(TJSStatementList(Result), E, P as TPasProcedure) AddProcedureToClass(TJSStatementList(Result), E, P as TPasProcedure)
else else
AddToStatementList; AddToStatementList(SLFirst,SLLast,E,El);
Result:=SLFirst;
end; end;
if (El is TProcedureBody) then
if IsProcBody then
begin begin
E:=ConvertElement(TProcedureBody(El).Body,AContext); E:=ConvertElement(TProcedureBody(El).Body,AContext);
AddToStatementList; AddToStatementList(SLFirst,SLLast,E,El);
Result:=SLFirst;
end; end;
if IsProcBody and IsFunction then
AddFunctionResultReturn;
{ {
TPasDeclarations = class(TPasElement) TPasDeclarations = class(TPasElement)
TPasSection = class(TPasDeclarations) TPasSection = class(TPasDeclarations)
@ -967,8 +1018,7 @@ begin
if (El is TPasProcedure) and (not (El is TPasConstructor)) then if (El is TPasProcedure) and (not (El is TPasConstructor)) then
begin begin
FS := CreateProcedureDeclaration(El); FS := CreateProcedureDeclaration(El);
Result := CreateUnary([TPasProcedure(El).Name, 'prototype', Result := CreateUnary([El.Parent.FullName, 'prototype', TPasProcedure(El).Name], FS);
El.Parent.FullName], FS);
end; end;
if (El is TPasConstructor)then if (El is TPasConstructor)then
begin begin
@ -1007,7 +1057,7 @@ begin
Arg := TPasArgument(El.ProcType.Args[n]); Arg := TPasArgument(El.ProcType.Args[n]);
nmem.Args.Elements.AddElement.Expr := CreateIdentifierExpr(Arg.Name,Arg,AContext); nmem.Args.Elements.AddElement.Expr := CreateIdentifierExpr(Arg.Name,Arg,AContext);
end; end;
Result := CreateUnary([TPasProcedure(El).Name, El.Parent.FullName], FS); Result := CreateUnary([El.Parent.FullName, TPasProcedure(El).Name], FS);
end; end;
function TPasToJSConverter.ConvertProcedure(El: TPasProcedure; function TPasToJSConverter.ConvertProcedure(El: TPasProcedure;
@ -1017,16 +1067,36 @@ Var
FS : TJSFunctionDeclarationStatement; FS : TJSFunctionDeclarationStatement;
FD : TJSFuncDef; FD : TJSFuncDef;
n:Integer; n:Integer;
IsTopLvl: Boolean;
FunName: String;
AssignSt: TJSSimpleAssignStatement;
begin begin
FS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,EL)); Result:=nil;
Result:=FS; IsTopLvl:=El.Parent is TPasSection;
FunName:=TransformFunctionName(El,AContext);
AssignSt:=nil;
if IsTopLvl then
begin
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
Result:=AssignSt;
AssignSt.LHS:=CreateMemberExpression(['this',FunName]);
end;
FS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,El));
if AssignSt<>nil then
AssignSt.Expr:=FS
else
Result:=FS;
FD:=TJSFuncDef.Create; FD:=TJSFuncDef.Create;
FD.Name:=TJSString(TransformFunctionName(El,AContext)); if AssignSt=nil then
FD.Name:=TJSString(FunName);
FS.AFunction:=FD; FS.AFunction:=FD;
for n := 0 to El.ProcType.Args.Count - 1 do for n := 0 to El.ProcType.Args.Count - 1 do
FD.Params.Add(TPasArgument(El.ProcType.Args[0]).Name); FD.Params.Add(TransformVariableName(TPasArgument(El.ProcType.Args[0]).Name,AContext));
FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,EL.Body)); FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El.Body));
FD.Body.A:=ConvertElement(El.Body,AContext); FD.Body.A:=ConvertElement(El.Body,AContext);
{ {
TPasProcedureBase = class(TPasElement) TPasProcedureBase = class(TPasElement)
@ -1107,9 +1177,36 @@ end;
function TPasToJSConverter.ConvertInitializationSection( function TPasToJSConverter.ConvertInitializationSection(
El: TInitializationSection; AContext: TConvertContext): TJSElement; El: TInitializationSection; AContext: TConvertContext): TJSElement;
var
FDS: TJSFunctionDeclarationStatement;
FD: TJSFuncDef;
FunName: String;
IsMain, ok: Boolean;
AssignSt: TJSSimpleAssignStatement;
begin begin
// ToDo: enclose in a function $init_unitname // create: 'this.$init=function(){}'
Result:=ConvertImplBlockElements(El,AContext);
IsMain:=(El.Parent<>nil) and (El.Parent is TPasProgram);
if IsMain then
FunName:='$main'
else
FunName:='$init';
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
Result:=AssignSt;
ok:=false;
try
AssignSt.LHS:=CreateMemberExpression(['this',FunName]);
FDS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,El));
AssignSt.Expr:=FDS;
FD:=TJSFuncDef.Create;
FDS.AFunction:=FD;
FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
FD.Body.A:=ConvertImplBlockElements(El,AContext);
ok:=true;
finally
if not ok then FreeAndNil(Result);
end;
end; end;
function TPasToJSConverter.ConvertFinalizationSection(El: TFinalizationSection; function TPasToJSConverter.ConvertFinalizationSection(El: TFinalizationSection;
@ -1237,9 +1334,10 @@ function TPasToJSConverter.ConvertResultElement(El: TPasResultElement;
AContext: TConvertContext): TJSElement; AContext: TConvertContext): TJSElement;
begin begin
// is this still needed?
RaiseNotYetImplemented(El,AContext); RaiseNotYetImplemented(El,AContext);
Result:=Nil; Result:=Nil;
// ToDo: TPasResultElement // TPasResultElement
end; end;
function TPasToJSConverter.ConvertVariable(El: TPasVariable; function TPasToJSConverter.ConvertVariable(El: TPasVariable;
@ -1247,21 +1345,10 @@ function TPasToJSConverter.ConvertVariable(El: TPasVariable;
Var Var
V : TJSVarDeclaration; V : TJSVarDeclaration;
T : TPasType;
begin begin
V:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El)); V:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
V.Name:=TransformVariableName(EL,AContext); V.Name:=TransformVariableName(El,AContext);
T:=ResolveType(EL.VarType,AContext); V.Init:=CreateVarInit(El,AContext);
if (T is TPasArrayType) then
begin
V.Init:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,EL.VarType));
If Assigned(EL.Expr) then
Raise EPasToJS.Create(SerrInitalizedArray);
end
else If Assigned(EL.Expr) then
V.Init:=ConvertElement(El.Expr,AContext)
else
; // ToDo: init with default value to create a typed variable (faster)
Result:=V; Result:=V;
end; end;
@ -1331,7 +1418,7 @@ begin
LHS:=ConvertElement(El.left); LHS:=ConvertElement(El.left);
ok:=false; ok:=false;
try try
RHS:=ConvertElement(El.Right); RHS:=ConvertElement(El.right);
ok:=true; ok:=true;
finally finally
if not ok then if not ok then
@ -1614,7 +1701,7 @@ begin
Result := Call; Result := Call;
end; end;
function TPasToJSConverter.CreateUnary(ms: array of string; E: TJSElement): TJSUnary; function TPasToJSConverter.CreateUnary(Members: array of string; E: TJSElement): TJSUnary;
var var
unary: TJSUnary; unary: TJSUnary;
asi: TJSSimpleAssignStatement; asi: TJSSimpleAssignStatement;
@ -1623,32 +1710,32 @@ begin
asi := TJSSimpleAssignStatement.Create(0, 0, ''); asi := TJSSimpleAssignStatement.Create(0, 0, '');
unary.A := asi; unary.A := asi;
asi.Expr := E; asi.Expr := E;
asi.LHS := CreateMemberExpression(ms); asi.LHS := CreateMemberExpression(Members);
Result := unary; Result := unary;
end; end;
function TPasToJSConverter.CreateMemberExpression(ReversedValues: array of string): TJSDotMemberExpression; function TPasToJSConverter.CreateMemberExpression(Members: array of string): TJSDotMemberExpression;
var var
pex: TJSPrimaryExpressionIdent; pex: TJSPrimaryExpressionIdent;
MExpr: TJSDotMemberExpression; MExpr: TJSDotMemberExpression;
LastMExpr: TJSDotMemberExpression; LastMExpr: TJSDotMemberExpression;
k: integer; k: integer;
begin begin
if Length(ReversedValues) < 2 then if Length(Members) < 2 then
DoError('member expression with less than two members'); DoError('member expression with less than two members');
LastMExpr := nil; LastMExpr := nil;
for k:=Low(ReversedValues) to High(ReversedValues)-1 do for k:=High(Members) downto Low(Members)+1 do
begin begin
MExpr := TJSDotMemberExpression.Create(0, 0, ''); MExpr := TJSDotMemberExpression.Create(0, 0, '');
MExpr.Name := TJSString(ReversedValues[k]); MExpr.Name := TJSString(Members[k]);
if k = 0 then if LastMExpr=nil then
Result := MExpr Result := MExpr
else else
LastMExpr.MExpr := MExpr; LastMExpr.MExpr := MExpr;
LastMExpr := MExpr; LastMExpr := MExpr;
end; end;
pex := TJSPrimaryExpressionIdent.Create(0, 0, ''); pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
pex.Name := TJSString(ReversedValues[High(ReversedValues)]); pex.Name := TJSString(Members[Low(Members)]);
LastMExpr.MExpr := pex; LastMExpr.MExpr := pex;
end; end;
@ -1773,6 +1860,124 @@ begin
Result:=ArgArray; Result:=ArgArray;
end; end;
procedure TPasToJSConverter.AddToStatementList(var First,
Last: TJSStatementList; Add: TJSElement; Src: TPasElement);
var
SL2: TJSStatementList;
begin
if not Assigned(Add) then exit;
if Add is TJSStatementList then
begin
// add list
if TJSStatementList(Add).A=nil then
begin
// empty list -> skip
if TJSStatementList(Add).B<>nil then
raise Exception.Create('internal error: AddToStatementList add list A=nil, B<>nil');
FreeAndNil(Add);
end
else if Last=nil then
begin
// our list is not yet started -> simply take the extra list
Last:=TJSStatementList(Add);
First:=Last;
end
else
begin
// merge lists (append)
if Last.B<>nil then
raise Exception.Create('internal error: TPasToJSConverter.ConvertDeclarations.AddToStatementList add list');
Last.B:=Add;
while Last.B is TJSStatementList do
Last:=TJSStatementList(Last.B);
if Last.B<>nil then
begin
SL2:=TJSStatementList(CreateElement(TJSStatementList,Src));
SL2.A:=Last.B;
Last.B:=SL2;
Last:=SL2;
end;
end;
end
else
begin
if Last=nil then
begin
Last:=TJSStatementList(CreateElement(TJSStatementList,Src));
First:=Last;
end
else
begin
if Last.B<>nil then
raise Exception.Create('internal error: TPasToJSConverter.ConvertDeclarations.AddToStatementList add element');
SL2:=TJSStatementList(CreateElement(TJSStatementList,Src));
Last.B:=SL2;
Last:=SL2;
end;
Last.A:=Add;
end;
end;
function TPasToJSConverter.CreateValInit(PasType: TPasType; Expr: TPasElement;
El: TPasElement; AContext: TConvertContext): TJSElement;
var
T: TPasType;
Lit: TJSLiteral;
begin
T:=ResolveType(PasType,AContext);
if (T is TPasArrayType) then
begin
Result:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,PasType));
If Assigned(Expr) then
Raise EPasToJS.Create(SerrInitalizedArray);
end
else If Assigned(Expr) then
Result:=ConvertElement(Expr,AContext)
else
begin
// always init with a default value to create a typed variable (faster and more readable)
Lit:=TJSLiteral(CreateElement(TJSLiteral,El));
Result:=Lit;
if T is TPasAliasType then
T:=ResolveType(TPasAliasType(T).DestType,AContext);
if T is TPasPointerType then
Lit.Value.IsNull:=true
else if T is TPasStringType then
Lit.Value.AsString:=''
else if T is TPasUnresolvedTypeRef then
begin
if (CompareText(T.Name,'integer')=0)
or (CompareText(T.Name,'double')=0)
then
Lit.Value.AsNumber:=0.0
else if (CompareText(T.Name,'boolean')=0)
then
Lit.Value.AsBoolean:=false
else if (CompareText(T.Name,'string')=0)
or (CompareText(T.Name,'char')=0)
then
Lit.Value.AsString:=''
else
begin
Lit.Value.IsUndefined:=true;
//writeln('TPasToJSConverter.CreateVarInit unknown PasType class=',T.ClassName,' name=',T.Name);
end;
end
else
begin
Lit.Value.IsUndefined:=true;
//writeln('TPasToJSConverter.CreateVarInit unknown PasType class=',T.ClassName,' name=',T.Name);
end;
end;
end;
function TPasToJSConverter.CreateVarInit(El: TPasVariable;
AContext: TConvertContext): TJSElement;
begin
Result:=CreateValInit(El.VarType,El.Expr,El,AContext);
end;
function TPasToJSConverter.CreateProcedureDeclaration(const El: TPasElement): function TPasToJSConverter.CreateProcedureDeclaration(const El: TPasElement):
TJSFunctionDeclarationStatement; TJSFunctionDeclarationStatement;
var var

21
packages/pastojs/tests/tcconverter.pp
View File

@ -11,7 +11,11 @@
but WITHOUT ANY WARRANTY; without even the implied warranty of but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************
Examples:
./testpas2js --suite=TTestExpressionConverter.TestVariable
}
unit tcconverter; unit tcconverter;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@ -19,7 +23,7 @@ unit tcconverter;
interface interface
uses uses
Classes, SysUtils, fpcunit, testutils, testregistry, fppas2js, jsbase, jstree, pastree; Classes, SysUtils, fpcunit, testregistry, fppas2js, jsbase, jstree, pastree;
type type
@ -599,7 +603,7 @@ Var
begin begin
// Try a:=B except on E : exception do b:=c end; // Try a:=B except on E : exception do b:=c end;
// Try a:=B except on E : exception do b:=c end; // Try a:=B except on E : exception do b:=c end;
{ (*
Becomes: Becomes:
try { try {
a=b; a=b;
@ -609,7 +613,7 @@ begin
b = c; b = c;
} }
} }
} *)
T:=TPasImplTry.Create('',Nil); T:=TPasImplTry.Create('',Nil);
T.AddElement(CreateAssignStatement('a','b')); T.AddElement(CreateAssignStatement('a','b'));
F:=T.AddExcept; F:=T.AddExcept;
@ -647,7 +651,7 @@ Var
begin begin
// Try a:=B except on E : exception do b:=c end; // Try a:=B except on E : exception do b:=c end;
{ (*
Becomes: Becomes:
try { try {
a=b; a=b;
@ -657,7 +661,7 @@ begin
throw jsexception; throw jsexception;
} }
} }
} *)
T:=TPasImplTry.Create('',Nil); T:=TPasImplTry.Create('',Nil);
T.AddElement(CreateAssignStatement('a','b')); T.AddElement(CreateAssignStatement('a','b'));
F:=T.AddExcept; F:=T.AddExcept;
@ -1119,8 +1123,6 @@ end;
Procedure TTestExpressionConverter.TestMemberExpressionArrayTwoDim; Procedure TTestExpressionConverter.TestMemberExpressionArrayTwoDim;
Var Var
B : TParamsExpr; B : TParamsExpr;
E : TJSBracketMemberExpression;
begin begin
// a[b,c]; // a[b,c];
B:=TParamsExpr.Create(Nil,pekArrayParams,eopNone); B:=TParamsExpr.Create(Nil,pekArrayParams,eopNone);
@ -1140,7 +1142,7 @@ begin
R:=TPasVariable.Create('A',Nil); R:=TPasVariable.Create('A',Nil);
VD:=TJSVarDeclaration(Convert(R,TJSVarDeclaration)); VD:=TJSVarDeclaration(Convert(R,TJSVarDeclaration));
AssertEquals('Correct name, lowercased','a',VD.Name); AssertEquals('Correct name, lowercased','a',VD.Name);
AssertNull('No init',VD.Init); AssertNotNull('No init',VD.Init);
end; end;
Procedure TTestExpressionConverter.TestArrayVariable; Procedure TTestExpressionConverter.TestArrayVariable;
@ -1176,6 +1178,7 @@ begin
pex:=TJSPrimaryExpressionIdent(AssertElement('Asi.LHS is TJSPrimaryExpressionIdent',TJSPrimaryExpressionIdent,Asi.LHS)); pex:=TJSPrimaryExpressionIdent(AssertElement('Asi.LHS is TJSPrimaryExpressionIdent',TJSPrimaryExpressionIdent,Asi.LHS));
AssertEquals('Correct name','myclass',pex.Name); AssertEquals('Correct name','myclass',pex.Name);
Call:=TJSCallExpression(AssertElement('Asi.Expr is TJSCallExpression',TJSCallExpression,Asi.Expr)); Call:=TJSCallExpression(AssertElement('Asi.Expr is TJSCallExpression',TJSCallExpression,Asi.Expr));
if Call=nil then ;
end; end;
procedure TTestTestConverter.TestEmpty; procedure TTestTestConverter.TestEmpty;
begin begin