Changeset 212 for branches/interpreter2/UGeneratorPascal.pas

Timestamp:

Apr 22, 2020, 12:04:22 PM (5 years ago)

Author:

chronos

Message:

• Added: Support for custom functions.

File:

• branches/interpreter2/UGeneratorPascal.pas (modified) (4 diffs)

branches/interpreter2/UGeneratorPascal.pas

@@ -15 +15 @@
   private
     procedure GenerateProgram(Block: TBlock;  Prog:TProgram);
+    procedure GenerateFunction(ParentBlock: TBlock; FunctionDef: TFunction);
     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 GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
     procedure GenerateCommand(Block: TBlock; Command: TCommand);
@@ -188 +190 @@
 begin
   if Prog.Name <> '' then AddTextLine('program ' + Prog.Name + ';');
+  AddTextLine('{$mode delphi}');
+  AddTextLine('uses SysUtils;');
   GenerateBlock(Block, Prog.Block);
   AddTextLine('.');
 end;
 
+procedure TGeneratorPascal.GenerateFunction(ParentBlock: TBlock;
+  FunctionDef: TFunction);
+var
+  I: Integer;
+begin
+  AddText('function ' + FunctionDef.Name);
+  if FunctionDef.Params.Count > 0 then begin
+    AddText('(');
+    for I := 0 to FunctionDef.Params.Count - 1 do begin
+      AddText(TFunctionParameter(FunctionDef.Params[I]).Name);
+      AddText(': ');
+      AddText(TFunctionParameter(FunctionDef.Params[I]).TypeRef.Name);
+      if I > 0 then AddText(', ');
+    end;
+    AddText(')');
+  end;
+  if Assigned(FunctionDef.ResultType) then begin
+    AddText(': ');
+    AddText(FunctionDef.ResultType.Name);
+  end;
+  AddTextLine(';');
+  if FunctionDef.InternalName <> '' then begin
+    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);')
+    else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return SysUtils.StrToInt(Value);');
+    Indent := Indent - 1;
+    AddTextLine('end;');
+  end else begin
+    GenerateBlock(ParentBlock, FunctionDef.Block);
+    AddTextLine(';');
+  end;
+end;
+
 procedure TGeneratorPascal.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
 begin
   GenerateBlockConst(ParentBlock, Block);
   GenerateBlockVar(ParentBlock, Block);
+  GenerateBlockFunctions(ParentBlock, Block);
   GenerateBeginEnd(ParentBlock, Block.BeginEnd);
 end;
@@ -203 +244 @@
   I: Integer;
   Variable: TVariable;
-begin
-  if Block.Variables.Count > 0 then begin
+  VarCount: Integer;
+begin
+  VarCount := 0;
+  for I := 0 to Block.Variables.Count - 1 do
+    if not TVariable(Block.Variables[I]).Internal then Inc(VarCount);
+
+  if VarCount > 0 then begin
     AddTextLine('var');
     Indent := Indent + 1;
-    for I := 0 to Block.Variables.Count - 1 do begin
+    for I := 0 to Block.Variables.Count - 1 do
+    if not TVariable(Block.Variables[I]).Internal then begin
       Variable := TVariable(Block.Variables[I]);
       AddTextLine(Variable.Name + ': ' + Variable.TypeRef.Name + ';');
@@ -249 +296 @@
 end;
 
+procedure TGeneratorPascal.GenerateBlockFunctions(ParentBlock: TBlock;
+  Block: TBlock);
+var
+  I: Integer;
+begin
+  for I := 0 to Block.Functions.Count - 1 do begin
+    GenerateFunction(ParentBlock, TFunction(Block.Functions[I]));
+    AddTextLine;
+  end;
+end;
+
 procedure TGeneratorPascal.Generate;
 begin