paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 10:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

Patch by Mohmed Abdrais to create classes (partial)

Browse Source 
git-svn-id: trunk@33603 -
This commit is contained in:
michael 2016-05-01 18:13:59 +00:00
parent ad8e20efb7
commit d92527fb50
1 changed files with 380 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -54,6 +54,14 @@ Type
Function TransFormFunctionName(El : TPasElement; AContext : TConvertContext) : String; Function TransFormFunctionName(El : TPasElement; AContext : TConvertContext) : String;
Function GetExceptionObjectname(AContext : TConvertContext) : String; Function GetExceptionObjectname(AContext : TConvertContext) : String;
Function ResolveType(El : TPasElement; AContext : TConvertContext) : TPasType; Function ResolveType(El : TPasElement; AContext : TConvertContext) : TPasType;
Function CreateCallStatement(const caltname: string;para: array of string): TJSCallExpression;
Function CreateCallStatement(const pex2: TJSElement;para: array of string): TJSCallExpression;
Function CreateProcedureDeclaration(const El: TPasElement):TJSFunctionDeclarationStatement;
Function CreateUnary(ms: array of string; E: TJSElement): TJSUnary;
Function CreateMemberExpression(ms: array of string): TJSDotMemberExpression;
Procedure Addproceduretoclass(sl: TJSStatementList; E: TJSElement;const P: TPasProcedure);
Function GetFunctionDefinitionInUnary(const fd: TJSFunctionDeclarationStatement;const funname: string; inunary: boolean): TJSFunctionDeclarationStatement;
Function GetFunctionUnaryName(var je: TJSElement;var fundec: TJSFunctionDeclarationStatement): TJSString;
// 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;
@ -106,7 +114,9 @@ Type
Function ConvertType(El: TPasElement; AContext : TConvertContext): TJSElement;virtual; Function ConvertType(El: TPasElement; AContext : TConvertContext): TJSElement;virtual;
Function ConvertVariable(El: TPasVariable; AContext : TConvertContext): TJSElement;virtual; Function ConvertVariable(El: TPasVariable; AContext : TConvertContext): TJSElement;virtual;
Function ConvertElement(El : TPasElement; AContext : TConvertContext) : TJSElement; virtual; Function ConvertElement(El : TPasElement; AContext : TConvertContext) : TJSElement; virtual;
function ConvertClassType(const EL: TPasClassType;const AContext: TConvertContext): TJSElement;
Function ConvertClassMember(El: TPasElement;AContext: TConvertContext): TJSElement;
Function ConvertClassconstructor(El: TPasConstructor;AContext: TConvertContext): TJSElement;
Property CurrentContext : TJSElement Read FCurrentContext Write SetCurrentContext; Property CurrentContext : TJSElement Read FCurrentContext Write SetCurrentContext;
Public Public
Function ConvertElement(El : TPasElement) : TJSElement; Function ConvertElement(El : TPasElement) : TJSElement;
@ -343,7 +353,8 @@ Var
R : TJSBinary; R : TJSBinary;
C : TJSBinaryClass; C : TJSBinaryClass;
A,B : TJSElement; A,B : TJSElement;
funname:String;
pex : TJSPrimaryExpressionIdent;
begin begin
Result:=Nil; Result:=Nil;
C:=BinClasses[EL.OpCode]; C:=BinClasses[EL.OpCode];
@ -379,14 +390,51 @@ begin
end; end;
eopSubIdent : eopSubIdent :
begin begin
Result:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El)); if (B is TJSPrimaryExpressionIdent) then
TJSDotMemberExpression(Result).Mexpr:=A; begin
if Not (B is TJSPrimaryExpressionIdent) then Result := TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
DOError('Member expression must be an identifier'); TJSDotMemberExpression(Result).Mexpr := A;
TJSDotMemberExpression(Result).Name:=TJSPrimaryExpressionIdent(B).Name; TJSDotMemberExpression(Result).Name := TJSPrimaryExpressionIdent(B).Name;
FreeAndNil(B); FreeAndNil(B);
end;
if (B is TJSCallExpression) then
begin
Result := B;
funname := TJSPrimaryExpressionIdent(TJSCallExpression(B).Expr).Name;
TJSCallExpression(B).Expr :=
TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
TJSDotMemberExpression(TJSCallExpression(B).Expr).Mexpr := A;
TJSDotMemberExpression(TJSCallExpression(B).Expr).Name := funname;
end;
if not ((B is TJSPrimaryExpressionIdent) or (B is TJSCallExpression)) then;
// DOError('Member expression must be an identifier');
end
else
if (A is TJSPrimaryExpressionIdent) and
(TJSPrimaryExpressionIdent(A).Name = '_super') then
begin
Result := B;
funname := TJSPrimaryExpressionIdent(TJSCallExpression(b).Expr).Name;
pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
pex.Name := 'self';
TJSCallExpression(b).Args.Elements.AddElement.Expr := pex;
if TJSCallExpression(b).Args.Elements.Count > 1 then
TJSCallExpression(b).Args.Elements.Exchange(
0, TJSCallExpression(b).Args.Elements.Count - 1);
if CompareText(funname, 'Create') = 0 then
begin
TJSCallExpression(B).Expr :=
TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
TJSDotMemberExpression(TJSCallExpression(b).Expr).Mexpr := A;
TJSDotMemberExpression(TJSCallExpression(b).Expr).Name := funname;
end
else
begin
TJSCallExpression(B).Expr :=
CreateMemberExpression(['call', funname, 'prototype', '_super']);
end;
end end
else else
DoError('Unknown/Unsupported operand type for binary expression'); DoError('Unknown/Unsupported operand type for binary expression');
end; end;
if (Result=Nil) and (C<>Nil) then if (Result=Nil) and (C<>Nil) then
@ -474,9 +522,12 @@ begin
end; end;
Function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr; AContext : TConvertContext): TJSElement; Function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr; AContext : TConvertContext): TJSElement;
var
je: TJSPrimaryExpressionIdent;
begin begin
Result:=Nil; je := TJSPrimaryExpressionIdent.Create(0, 0, '');
je.Name := '_super';
Result := je;
// TInheritedExpr = class(TPasExpr) // TInheritedExpr = class(TPasExpr)
end; end;
@ -612,6 +663,8 @@ Function TPasToJSConverter.CreateTypeDecl(El: TPasElement; AContext : TConvertCo
begin begin
Result:=Nil; Result:=Nil;
if (El is TPasClassType) then
Result := convertclassType(TPasClassType(El), AContext);
// Need to do something for classes and records. // Need to do something for classes and records.
end; end;
@ -668,6 +721,9 @@ begin
E:=ConvertElement(P as TPasProcedure,AContext) E:=ConvertElement(P as TPasProcedure,AContext)
else else
DoError('Unknown class: "%s" ',[P.ClassName]); DoError('Unknown class: "%s" ',[P.ClassName]);
if (Pos('.', P.Name) > 0) then
Addproceduretoclass(TJSStatementList(Result), E, P as TPasProcedure)
else
AddToSL; AddToSL;
end; end;
if (El is TProcedureBody) then if (El is TProcedureBody) then
@ -716,18 +772,146 @@ TPasTypeRef = class(TPasUnresolvedTypeRef)
} }
end; end;
function TPasToJSConverter.ConvertClassType(const El: TPasClassType;
const AContext: TConvertContext): TJSElement;
var
call: TJSCallExpression;
pex: TJSPrimaryExpressionIdent;
asi: TJSSimpleAssignStatement;
unary2: TJSUnary;
unary: TJSUnary;
je: TJSElement;
FD: TJSFuncDef;
cons: TJSFunctionDeclarationStatement;
FS: TJSFunctionDeclarationStatement;
memname: string;
ctname: string;
tmember: TPasElement;
j: integer;
ret: TJSReturnStatement;
begin
ctname := El.FullName;
unary := TJSUnary(CreateElement(TJSUnary,El));
asi := TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
unary.A := asi;
pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
pex.Name := El.Name;
asi.LHS := pex;
FS := TJSFunctionDeclarationStatement(
CreateElement(TJSFunctionDeclarationStatement, EL));
call := CreateCallStatement(FS, []);
asi.Expr := call;
Result := unary;
FD := TJSFuncDef.Create;
FS.AFunction := FD;
FD.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, El));
FD.Body.A := TJSSourceElements(CreateElement(TJSSourceElements, El));
if Assigned(El.AncestorType) then
begin
pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent, El));
call.Args := TJSArguments(CreateElement(TJSArguments, El));
pex.Name := El.AncestorType.Name;
call.Args.Elements.AddElement.Expr := pex;
FD.Params.Add('_super');
unary2 := TJSUnary(CreateElement(TJSUnary, El));
call := CreateCallStatement('__extends', [El.Name, '_super']);
unary2.A := call;
TJSSourceElements(FD.Body.A).Statements.AddNode.Node := unary2;
end;
//create default onstructor
cons := CreateProcedureDeclaration(El);
TJSSourceElements(FD.Body.A).Statements.AddNode.Node := cons;
cons.AFunction.Name := El.Name;
//convert class member
for j := 0 to El.Members.Count - 1 do
begin
tmember := TPasElement(El.Members[j]);
memname := tmember.FullName;
je := ConvertClassMember(tmember, AContext);
if Assigned(je) then
TJSSourceElements(FD.Body.A).Statements.AddNode.Node := je;
end;
//add return statment
ret := TJSReturnStatement(CreateElement(TJSReturnStatement, El));
TJSSourceElements(FD.Body.A).Statements.AddNode.Node := ret;
pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent, El));
ret.Expr := pex;
pex.Name := el.Name;
Result := unary;
end;
function TPasToJSConverter.ConvertClassMember(El: TPasElement;
AContext: TConvertContext): TJSElement;
var
FS: TJSFunctionDeclarationStatement;
par: string;
begin
Result := nil;
if (El is TPasProcedure) and (not (El is TPasConstructor)) then
begin
FS := CreateProcedureDeclaration(El);
Result := CreateUnary([TPasProcedure(El).Name, 'prototype',
El.Parent.FullName], FS);
end;
if (El is TPasConstructor)then
begin
Result:=ConvertClassconstructor(TPasClassConstructor(El),AContext);
end;
if (el is TPasProperty) then
ConvertProperty(TPasProperty(El), AContext);
end;
Function TPasToJSConverter.ConvertClassconstructor(El: TPasConstructor;
AContext: TConvertContext): TJSElement;
var
FS: TJSFunctionDeclarationStatement;
n: integer;
fun1sourceele: TJSSourceElements;
ret: TJSReturnStatement;
nmem: TJSNewMemberExpression;
pex: TJSPrimaryExpressionIdent;
begin
FS := CreateProcedureDeclaration(El);
FS.AFunction.Name := El.Name;
Fs.AFunction.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, EL.Body));
fun1sourceele := TJSSourceElements.Create(0, 0, '');
fs.AFunction.Body.A := fun1sourceele;
ret := TJSReturnStatement.Create(0, 0, '');
fun1sourceele.Statements.AddNode.Node := ret;
nmem := TJSNewMemberExpression.Create(0, 0, '');
ret.Expr := nmem;
pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
nmem.Mexpr := pex;
pex.Name := El.Parent.FullName;
for n := 0 to El.ProcType.Args.Count - 1 do
begin
if n = 0 then
nmem.Args := TJSArguments.Create(0, 0, '');
fs.AFunction.Params.Add(TPasArgument(El.ProcType.Args[n]).Name);
pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
pex.Name := TPasArgument(El.ProcType.Args[n]).Name;
nmem.Args.Elements.AddElement.Expr := pex;
end;
Result := CreateUnary([TPasProcedure(El).Name, El.Parent.FullName], FS);
end;
Function TPasToJSConverter.ConvertProcedure(El: TPasProcedure; AContext : TConvertContext): TJSElement; Function TPasToJSConverter.ConvertProcedure(El: TPasProcedure; AContext : TConvertContext): TJSElement;
Var Var
FS : TJSFunctionDeclarationStatement; FS : TJSFunctionDeclarationStatement;
FD : TJSFuncDef; FD : TJSFuncDef;
n:Integer;
begin begin
FS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,EL)); FS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,EL));
Result:=FS; Result:=FS;
FD:=TJSFuncDef.Create; FD:=TJSFuncDef.Create;
FD.Name:=TransFormFunctionName(El,AContext); FD.Name:=TransFormFunctionName(El,AContext);
FS.AFunction:=FD; FS.AFunction:=FD;
for n := 0 to El.ProcType.Args.Count - 1 do
FD.Params.Add(TPasArgument(El.ProcType.Args[0]).Name);
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);
{ {
@ -1220,7 +1404,190 @@ begin
else else
Result:=Nil; Result:=Nil;
end; end;
function TPasToJSConverter.CreateCallStatement(const caltname: string;
para: array of string): TJSCallExpression;
var
call: TJSCallExpression;
pex2: TJSPrimaryExpressionIdent;
begin
pex2 := TJSPrimaryExpressionIdent.Create(0, 0, '');
pex2.Name := caltname;
call := CreateCallStatement(pex2, para);
Result := call;
end;
function TPasToJSConverter.CreateCallStatement(const pex2: TJSElement;
para: array of string): TJSCallExpression;
var
p: string;
pex3: TJSPrimaryExpressionIdent;
call: TJSCallExpression;
argarray: TJSArguments;
begin
call := TJSCallExpression.Create(0, 0, '');
call.Expr := pex2;
argarray := TJSArguments.Create(0, 0, '');
call.Args := argarray;
for p in para do
begin
pex3 := TJSPrimaryExpressionIdent.Create(0, 0, '');
pex3.Name := p;
argarray.Elements.AddElement.Expr := pex3;
end;
Result := call;
end;
function TPasToJSConverter.CreateUnary(ms: array of string; E: TJSElement): TJSUnary;
var
unary: TJSUnary;
asi: TJSSimpleAssignStatement;
mem1: TJSDotMemberExpression;
begin
unary := TJSUnary.Create(0, 0, '');
//mainbody.A:=unary;
asi := TJSSimpleAssignStatement.Create(0, 0, '');
unary.A := asi;
asi.Expr := E;
asi.LHS := CreateMemberExpression(ms);
Result := unary;
end;
function TPasToJSConverter.CreateMemberExpression(ms: array of string): TJSDotMemberExpression;
var
pex: TJSPrimaryExpressionIdent;
mem2: TJSDotMemberExpression;
mem1: TJSDotMemberExpression;
k: integer;
m: string;
begin
if Length(ms) < 2 then
DoError('member exprision with les than two member');
k := 0;
for m in ms do
begin
mem1 := mem2;
mem2 := TJSDotMemberExpression.Create(0, 0, '');
mem2.Name := ms[k];
if k = 0 then
Result := mem2
else
mem1.Mexpr := mem2;
Inc(k);
end;
mem2.Free;
pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
pex.Name := ms[k - 1];
mem1.Mexpr := pex;
end;
Procedure TPasToJSConverter.Addproceduretoclass(sl: TJSStatementList;
E: TJSElement; const P: TPasProcedure);
var
clname, funname, varname: string;
classfound: boolean;
fundec, fd, main_const: TJSFunctionDeclarationStatement;
SL2: TJSStatementList;
un1: TJSUnary;
asi: TJSAssignStatement;
begin
SL2 := TJSStatementList(sl);
clname := Copy(p.Name, 1, Pos('.', P.Name) - 1);
funname := Copy(p.Name, Pos('.', P.Name) + 1, Length(p.Name) - Pos('.', P.Name));
classfound := False;
while Assigned(SL2) and (not classfound) do
begin
if SL2.A is TJSUnary then
begin
un1 := TJSUnary(SL2.A);
asi := TJSAssignStatement(un1.A);
varname := TJSPrimaryExpressionIdent(asi.LHS).Name;
if varname = (clname) then
begin
classfound := True;
fd := TJSFunctionDeclarationStatement(TJSCallExpression(asi.Expr).Expr);
end;
end;
SL2 := TJSStatementList(SL2.B);
end;
if not (classfound) then
Exit;
fundec := GetFunctionDefinitionInUnary(fd, funname, True);
if Assigned(fundec) then
begin
if (p is TPasConstructor) then
begin
main_const := GetFunctionDefinitionInUnary(fd, clname, False);
main_const.AFunction := TJSFunctionDeclarationStatement(E).AFunction;
main_const.AFunction.Name := clname;
end
else
begin
fundec.AFunction := TJSFunctionDeclarationStatement(E).AFunction;
fundec.AFunction.Name := '';
end;
end;
end;
function TPasToJSConverter.GetFunctionDefinitionInUnary(
const fd: TJSFunctionDeclarationStatement; const funname: string;
inunary: boolean): TJSFunctionDeclarationStatement;
var
k: integer;
fundec: TJSFunctionDeclarationStatement;
je: TJSElement;
cname: TJSString;
begin
Result := nil;
for k := 0 to TJSSourceElements(FD.AFunction.Body.A).Statements.Count - 1 do
begin
je := TJSSourceElements(FD.AFunction.Body.A).Statements.Nodes[k].Node;
if inunary then
cname := GetFunctionUnaryName(je, fundec)
else
begin
if je is TJSFunctionDeclarationStatement then
begin
cname := TJSFunctionDeclarationStatement(je).AFunction.Name;
fundec := TJSFunctionDeclarationStatement(je);
end;
end;
if funname = cname then
Result := fundec;
end;
end;
Function TPasToJSConverter.GetFunctionUnaryName(var je: TJSElement;
var fundec: TJSFunctionDeclarationStatement): TJSString;
var
cname: TJSString;
asi: TJSAssignStatement;
un1: TJSUnary;
begin
if not (je is TJSUnary) then
Exit;
un1 := TJSUnary(je);
asi := TJSAssignStatement(un1.A);
if not (asi.Expr is TJSFunctionDeclarationStatement) then
Exit;
fundec := TJSFunctionDeclarationStatement(asi.Expr);
cname := TJSDotMemberExpression(asi.LHS).Name;
Result := cname;
end;
function TPasToJSConverter.CreateProcedureDeclaration(const El: TPasElement):
TJSFunctionDeclarationStatement;
var
FD: TJSFuncDef;
FS: TJSFunctionDeclarationStatement;
begin
FS := TJSFunctionDeclarationStatement(
CreateElement(TJSFunctionDeclarationStatement, EL));
Result := FS;
FD := TJSFuncDef.Create;
FS.AFunction := FD;
Result := FS;
end;
Function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn; AContext : TConvertContext): TJSElement; Function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn; AContext : TConvertContext): TJSElement;
Var Var
@ -1379,3 +1746,4 @@ end;
end. end.