Changeset 234 for branches/xpascal/Generators/GeneratorPascal.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/GeneratorPascal.pas (modified) (7 diffs)

branches/xpascal/Generators/GeneratorPascal.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 GenerateBlockVar(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);
@@ -25 +27 @@
     procedure GenerateRepeatUntil(Block: TBlock; RepeatUntil: TRepeatUntil);
     procedure GenerateFunctionCall(Block: TBlock; FunctionCall: TFunctionCall);
+    procedure GenerateProcedureCall(Block: TBlock; ProcedureCall: TProcedureCall);
     procedure GenerateAssignment(Block: TBlock; Assignment: TAssignment);
     procedure GenerateExpression(Block: TBlock; Expression: TExpression);
@@ -47 +50 @@
   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))
@@ -120 +124 @@
 end;
 
+procedure TGeneratorPascal.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 TGeneratorPascal.GenerateAssignment(Block: TBlock; Assignment: TAssignment);
 begin
@@ -228 +246 @@
     AddTextLine('begin');
     Indent := Indent + 1;
-    if FunctionDef.InternalName = 'WriteLn' then AddTextLine('System.WriteLn(Text);')
-    else if FunctionDef.InternalName = 'Write' then AddTextLine('System.Write(Text);')
-    else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return SysUtils.IntToStr(Value);')
+    if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return SysUtils.IntToStr(Value);')
     else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return SysUtils.StrToInt(Value);')
     else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return SysUtils.BoolToStr(Value);')
@@ -242 +258 @@
 end;
 
+procedure TGeneratorPascal.GenerateProcedure(ParentBlock: TBlock;
+  ProcedureDef: TProcedure);
+var
+  I: Integer;
+begin
+  AddText('procedure ' + ProcedureDef.Name);
+  if ProcedureDef.Params.Count > 0 then begin
+    AddText('(');
+    for I := 0 to ProcedureDef.Params.Count - 1 do begin
+      AddText(TFunctionParameter(ProcedureDef.Params[I]).Name);
+      AddText(': ');
+      AddText(TFunctionParameter(ProcedureDef.Params[I]).TypeRef.Name);
+      if I > 0 then AddText(', ');
+    end;
+    AddText(')');
+  end;
+  AddTextLine(';');
+  if ProcedureDef.InternalName <> '' then begin
+    AddTextLine('begin');
+    Indent := Indent + 1;
+    if ProcedureDef.InternalName = 'WriteLn' then AddTextLine('System.WriteLn(Text);')
+    else if ProcedureDef.InternalName = 'Write' then AddTextLine('System.Write(Text);')
+    else if ProcedureDef.InternalName = 'ReadLn' then AddTextLine('System.ReadLn(Text);')
+    else if ProcedureDef.InternalName = 'Read' then AddTextLine('System.Read(Text);');
+    Indent := Indent - 1;
+    AddTextLine('end;');
+  end else begin
+    GenerateBlock(ParentBlock, ProcedureDef.Block);
+    AddTextLine(';');
+  end;
+end;
+
 procedure TGeneratorPascal.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
 begin
   GenerateBlockConst(ParentBlock, Block);
   GenerateBlockVar(ParentBlock, Block);
+  GenerateBlockProcedures(ParentBlock, Block);
   GenerateBlockFunctions(ParentBlock, Block);
   GenerateBeginEnd(ParentBlock, Block.BeginEnd);
@@ -317 +366 @@
 end;
 
+procedure TGeneratorPascal.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 TGeneratorPascal.Generate;
 begin