Changeset 234 for branches/xpascal/Generators/GeneratorPhp.pas

Timestamp:

Jun 27, 2023, 12:50:09 AM (17 months ago)

Author:

chronos

Message:

• Fixed: Procedures generation.
• Fixed: Splitters between panels.

File:

• branches/xpascal/Generators/GeneratorPhp.pas (modified) (7 diffs)

branches/xpascal/Generators/GeneratorPhp.pas

@@ -14 +14 @@
     procedure GenerateProgram(Block: TBlock;  Prog:TProgram);
     procedure GenerateFunction(ParentBlock: TBlock; FunctionDef: TFunction);
+    procedure GenerateProcedure(ParentBlock: TBlock; ProcedureDef: TProcedure);
     procedure GenerateBlock(ParentBlock: TBlock; Block: TBlock);
     procedure GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
     procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock);
+    procedure GenerateBlockProcedures(ParentBlock: TBlock; Block: TBlock);
     procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
     procedure GenerateCommand(Block: TBlock; Command: TCommand);
@@ -24 +26 @@
     procedure GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
     procedure GenerateFunctionCall(Block: TBlock; FunctionCall: TFunctionCall);
+    procedure GenerateProcedureCall(Block: TBlock; ProcedureCall: TProcedureCall);
     procedure GenerateAssignment(Block: TBlock; Assignment: TAssignment);
     procedure GenerateExpression(Block: TBlock; Expression: TExpression);
@@ -52 +55 @@
   if Command is TBeginEnd then GenerateBeginEnd(Block, TBeginEnd(Command))
   else if Command is TFunctionCall then GenerateFunctionCall(Block, TFunctionCall(Command))
+  else if Command is TProcedureCall then GenerateProcedureCall(Block, TProcedureCall(Command))
   else if Command is TAssignment then GenerateAssignment(Block, TAssignment(Command))
   else if Command is TIfThenElse then GenerateIfThenElse(Block, TIfThenElse(Command))
@@ -133 +137 @@
 end;
 
+procedure TGeneratorPhp.GenerateProcedureCall(Block: TBlock;
+  ProcedureCall: TProcedureCall);
+var
+  I: Integer;
+begin
+  AddText(ProcedureCall.ProcedureDef.Name);
+  if ProcedureCall.Params.Count > 0 then begin
+    AddText('(');
+    for I := 0 to ProcedureCall.Params.Count - 1 do
+      GenerateExpression(Block, TExpression(ProcedureCall.Params[I]));
+    AddText(')');
+  end;
+end;
+
 procedure TGeneratorPhp.GenerateAssignment(Block: TBlock; Assignment: TAssignment);
 begin
@@ -240 +258 @@
     AddTextLine('{');
     Indent := Indent + 1;
-    if FunctionDef.InternalName = 'WriteLn' then AddTextLine('echo($Text."\n");')
-    else if FunctionDef.InternalName = 'Write' then AddTextLine('echo($Text);')
-    else if FunctionDef.InternalName = 'ReadLn' then AddTextLine('$Text = readline();')
-    else if FunctionDef.InternalName = 'Read' then AddTextLine('$Text = readline();')
-    else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return $Value;')
+    if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return $Value;')
     else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return $Value;')
     else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return $Value;')
@@ -256 +270 @@
 end;
 
+procedure TGeneratorPhp.GenerateProcedure(ParentBlock: TBlock;
+  ProcedureDef: TProcedure);
+var
+  I: Integer;
+begin
+  AddText('function ' + ProcedureDef.Name + '(');
+  for I := 0 to ProcedureDef.Params.Count - 1 do begin
+    if ProcedureDef.Params[I].Kind = pkVar then
+      AddText('&');
+    AddText('$' + TFunctionParameter(ProcedureDef.Params[I]).Name);
+    if I > 0 then AddText(', ');
+  end;
+  AddTextLine(')');
+  if ProcedureDef.InternalName <> '' then begin
+    AddTextLine('{');
+    Indent := Indent + 1;
+    if ProcedureDef.InternalName = 'WriteLn' then AddTextLine('echo($Text."\n");')
+    else if ProcedureDef.InternalName = 'Write' then AddTextLine('echo($Text);')
+    else if ProcedureDef.InternalName = 'ReadLn' then AddTextLine('$Text = readline();')
+    else if ProcedureDef.InternalName = 'Read' then AddTextLine('$Text = readline();');
+    Indent := Indent - 1;
+    AddTextLine('}');
+  end else begin
+    GenerateBlock(ParentBlock, ProcedureDef.Block);
+    AddTextLine;
+  end;
+end;
+
 procedure TGeneratorPhp.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
 begin
   GenerateBlockConst(ParentBlock, Block);
+  GenerateBlockProcedures(ParentBlock, Block);
   GenerateBlockFunctions(ParentBlock, Block);
   if Block.BeginEnd.Commands.Count > 0 then begin
@@ -290 +333 @@
 end;
 
+procedure TGeneratorPhp.GenerateBlockProcedures(ParentBlock: TBlock;
+  Block: TBlock);
+var
+  I: Integer;
+begin
+  for I := 0 to Block.Procedures.Count - 1 do begin
+    GenerateProcedure(ParentBlock, TProcedure(Block.Procedures[I]));
+    AddTextLine;
+  end;
+end;
+
 procedure TGeneratorPhp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
 var