Ignore:
Timestamp:
Jun 27, 2023, 12:50:09 AM (17 months ago)
Author:
chronos
Message:
  • Fixed: Procedures generation.
  • Fixed: Splitters between panels.
Location:
branches/xpascal/Generators
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • branches/xpascal/Generators/GeneratorCSharp.pas

    r233 r234  
    1414    procedure GenerateProgram(Block: TBlock;  Prog:TProgram);
    1515    procedure GenerateFunction(ParentBlock: TBlock; FunctionDef: TFunction);
     16    procedure GenerateProcedure(ParentBlock: TBlock; ProcedureDef: TProcedure);
    1617    procedure GenerateBlock(ParentBlock: TBlock; Block: TBlock);
    1718    procedure GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
    1819    procedure GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
    1920    procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock);
     21    procedure GenerateBlockProcedures(ParentBlock: TBlock; Block: TBlock);
    2022    procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
    2123    procedure GenerateCommand(Block: TBlock; Command: TCommand);
    … …  
    2527    procedure GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
    2628    procedure GenerateFunctionCall(Block: TBlock; FunctionCall: TFunctionCall);
     29    procedure GenerateProcedureCall(Block: TBlock; ProcedureCall: TProcedureCall);
    2730    procedure GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    2831    procedure GenerateExpression(Block: TBlock; Expression: TExpression);
    … …  
    5457  if Command is TBeginEnd then GenerateBeginEnd(Block, TBeginEnd(Command))
    5558  else if Command is TFunctionCall then GenerateFunctionCall(Block, TFunctionCall(Command))
     59  else if Command is TProcedureCall then GenerateProcedureCall(Block, TProcedureCall(Command))
    5660  else if Command is TAssignment then GenerateAssignment(Block, TAssignment(Command))
    5761  else if Command is TIfThenElse then GenerateIfThenElse(Block, TIfThenElse(Command))
    … …  
    138142end;
    139143
     144procedure TGeneratorCSharp.GenerateProcedureCall(Block: TBlock;
     145  ProcedureCall: TProcedureCall);
     146var
     147  I: Integer;
     148begin
     149  AddText(ProcedureCall.ProcedureDef.Name);
     150  if ProcedureCall.Params.Count > 0 then begin
     151    AddText('(');
     152    for I := 0 to ProcedureCall.Params.Count - 1 do begin
     153      if ProcedureCall.ProcedureDef.Params[I].Kind = pkVar then
     154        AddText('ref ');
     155      GenerateExpression(Block, TExpression(ProcedureCall.Params[I]));
     156    end;
     157    AddText(')');
     158  end;
     159end;
     160
    140161procedure TGeneratorCSharp.GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    141162begin
    … …  
    238259  Indent := Indent + 1;
    239260  GenerateBlockFunctions(nil, Prog.SystemBlock);
     261  GenerateBlockProcedures(nil, Prog.SystemBlock);
    240262  GenerateBlock(nil, Prog.SystemBlock);
    241263  AddTextLine('public static void Main()');
    … …  
    246268  AddTextLine();
    247269  GenerateBlockFunctions(Prog.Block, Prog.Block);
     270  GenerateBlockProcedures(Prog.Block, Prog.Block);
    248271  AddTextLine('public void Entry()');
    249272  GenerateBlock(Block, Prog.Block);
    … …  
    320343    AddTextLine('{');
    321344    Indent := Indent + 1;
    322     if FunctionDef.InternalName = 'WriteLn' then AddTextLine('Console.Write(Text + "\n");')
    323     else if FunctionDef.InternalName = 'Write' then AddTextLine('Console.Write(Text);')
    324     else if FunctionDef.InternalName = 'ReadLn' then AddTextLine('Text = Console.ReadLine();')
    325     else if FunctionDef.InternalName = 'Read' then AddTextLine('Text = Console.ReadLine();')
    326     else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return Value.ToString();')
     345    if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return Value.ToString();')
    327346    else if FunctionDef.InternalName = 'StrToInt' then begin
    328347      AddTextLine('int x = 0;');
    … …  
    349368end;
    350369
     370procedure TGeneratorCSharp.GenerateProcedure(ParentBlock: TBlock;
     371  ProcedureDef: TProcedure);
     372var
     373  I: Integer;
     374  Param: TFunctionParameter;
     375begin
     376  AddText('void ' + ProcedureDef.Name + '(');
     377  for I := 0 to ProcedureDef.Params.Count - 1 do begin
     378    Param := TFunctionParameter(ProcedureDef.Params[I]);
     379    if Param.Kind = pkVar then AddText('ref ');
     380    GenerateTypeRef(Param.TypeRef);
     381    AddText(' ');
     382    AddText(Param.Name);
     383    if I > 0 then AddText(', ');
     384  end;
     385  AddTextLine(')');
     386  if ProcedureDef.InternalName <> '' then begin
     387    AddTextLine('{');
     388    Indent := Indent + 1;
     389    if ProcedureDef.InternalName = 'WriteLn' then AddTextLine('Console.Write(Text + "\n");')
     390    else if ProcedureDef.InternalName = 'Write' then AddTextLine('Console.Write(Text);')
     391    else if ProcedureDef.InternalName = 'ReadLn' then AddTextLine('Text = Console.ReadLine();')
     392    else if ProcedureDef.InternalName = 'Read' then AddTextLine('Text = Console.ReadLine();');
     393
     394    Indent := Indent - 1;
     395    AddTextLine('}');
     396  end else begin
     397    GenerateBlock(ParentBlock, ProcedureDef.Block);
     398    AddTextLine;
     399  end;
     400end;
     401
    351402procedure TGeneratorCSharp.GenerateBlockFunctions(ParentBlock: TBlock;
    352403  Block: TBlock);
    … …  
    360411end;
    361412
     413procedure TGeneratorCSharp.GenerateBlockProcedures(ParentBlock: TBlock;
     414  Block: TBlock);
     415var
     416  I: Integer;
     417begin
     418  for I := 0 to Block.Procedures.Count - 1 do begin
     419    GenerateProcedure(ParentBlock, TProcedure(Block.Procedures[I]));
     420    AddTextLine;
     421  end;
     422end;
     423
    362424procedure TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
    363425var

  • branches/xpascal/Generators/GeneratorPascal.pas

    r230 r234  
    1414    procedure GenerateProgram(Block: TBlock;  Prog:TProgram);
    1515    procedure GenerateFunction(ParentBlock: TBlock; FunctionDef: TFunction);
     16    procedure GenerateProcedure(ParentBlock: TBlock; ProcedureDef: TProcedure);
    1617    procedure GenerateBlock(ParentBlock: TBlock; Block: TBlock);
    1718    procedure GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
    1819    procedure GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
    1920    procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock);
     21    procedure GenerateBlockProcedures(ParentBlock: TBlock; Block: TBlock);
    2022    procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
    2123    procedure GenerateCommand(Block: TBlock; Command: TCommand);
    … …  
    2527    procedure GenerateRepeatUntil(Block: TBlock; RepeatUntil: TRepeatUntil);
    2628    procedure GenerateFunctionCall(Block: TBlock; FunctionCall: TFunctionCall);
     29    procedure GenerateProcedureCall(Block: TBlock; ProcedureCall: TProcedureCall);
    2730    procedure GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    2831    procedure GenerateExpression(Block: TBlock; Expression: TExpression);
    … …  
    4750  if Command is TBeginEnd then GenerateBeginEnd(Block, TBeginEnd(Command))
    4851  else if Command is TFunctionCall then GenerateFunctionCall(Block, TFunctionCall(Command))
     52  else if Command is TProcedureCall then GenerateProcedureCall(Block, TProcedureCall(Command))
    4953  else if Command is TAssignment then GenerateAssignment(Block, TAssignment(Command))
    5054  else if Command is TIfThenElse then GenerateIfThenElse(Block, TIfThenElse(Command))
    … …  
    120124end;
    121125
     126procedure TGeneratorPascal.GenerateProcedureCall(Block: TBlock;
     127  ProcedureCall: TProcedureCall);
     128var
     129  I: Integer;
     130begin
     131  AddText(ProcedureCall.ProcedureDef.Name);
     132  if ProcedureCall.Params.Count > 0 then begin
     133    AddText('(');
     134    for I := 0 to ProcedureCall.Params.Count - 1 do
     135      GenerateExpression(Block, TExpression(ProcedureCall.Params[I]));
     136    AddText(')');
     137  end;
     138end;
     139
    122140procedure TGeneratorPascal.GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    123141begin
    … …  
    228246    AddTextLine('begin');
    229247    Indent := Indent + 1;
    230     if FunctionDef.InternalName = 'WriteLn' then AddTextLine('System.WriteLn(Text);')
    231     else if FunctionDef.InternalName = 'Write' then AddTextLine('System.Write(Text);')
    232     else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return SysUtils.IntToStr(Value);')
     248    if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return SysUtils.IntToStr(Value);')
    233249    else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return SysUtils.StrToInt(Value);')
    234250    else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return SysUtils.BoolToStr(Value);')
    … …  
    242258end;
    243259
     260procedure TGeneratorPascal.GenerateProcedure(ParentBlock: TBlock;
     261  ProcedureDef: TProcedure);
     262var
     263  I: Integer;
     264begin
     265  AddText('procedure ' + ProcedureDef.Name);
     266  if ProcedureDef.Params.Count > 0 then begin
     267    AddText('(');
     268    for I := 0 to ProcedureDef.Params.Count - 1 do begin
     269      AddText(TFunctionParameter(ProcedureDef.Params[I]).Name);
     270      AddText(': ');
     271      AddText(TFunctionParameter(ProcedureDef.Params[I]).TypeRef.Name);
     272      if I > 0 then AddText(', ');
     273    end;
     274    AddText(')');
     275  end;
     276  AddTextLine(';');
     277  if ProcedureDef.InternalName <> '' then begin
     278    AddTextLine('begin');
     279    Indent := Indent + 1;
     280    if ProcedureDef.InternalName = 'WriteLn' then AddTextLine('System.WriteLn(Text);')
     281    else if ProcedureDef.InternalName = 'Write' then AddTextLine('System.Write(Text);')
     282    else if ProcedureDef.InternalName = 'ReadLn' then AddTextLine('System.ReadLn(Text);')
     283    else if ProcedureDef.InternalName = 'Read' then AddTextLine('System.Read(Text);');
     284    Indent := Indent - 1;
     285    AddTextLine('end;');
     286  end else begin
     287    GenerateBlock(ParentBlock, ProcedureDef.Block);
     288    AddTextLine(';');
     289  end;
     290end;
     291
    244292procedure TGeneratorPascal.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
    245293begin
    246294  GenerateBlockConst(ParentBlock, Block);
    247295  GenerateBlockVar(ParentBlock, Block);
     296  GenerateBlockProcedures(ParentBlock, Block);
    248297  GenerateBlockFunctions(ParentBlock, Block);
    249298  GenerateBeginEnd(ParentBlock, Block.BeginEnd);
    … …  
    317366end;
    318367
     368procedure TGeneratorPascal.GenerateBlockProcedures(ParentBlock: TBlock;
     369  Block: TBlock);
     370var
     371  I: Integer;
     372begin
     373  for I := 0 to Block.Procedures.Count - 1 do begin
     374    GenerateProcedure(ParentBlock, TProcedure(Block.Procedures[I]));
     375    AddTextLine;
     376  end;
     377end;
     378
    319379procedure TGeneratorPascal.Generate;
    320380begin

  • branches/xpascal/Generators/GeneratorPhp.pas

    r232 r234  
    1414    procedure GenerateProgram(Block: TBlock;  Prog:TProgram);
    1515    procedure GenerateFunction(ParentBlock: TBlock; FunctionDef: TFunction);
     16    procedure GenerateProcedure(ParentBlock: TBlock; ProcedureDef: TProcedure);
    1617    procedure GenerateBlock(ParentBlock: TBlock; Block: TBlock);
    1718    procedure GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
    1819    procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock);
     20    procedure GenerateBlockProcedures(ParentBlock: TBlock; Block: TBlock);
    1921    procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
    2022    procedure GenerateCommand(Block: TBlock; Command: TCommand);
    … …  
    2426    procedure GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
    2527    procedure GenerateFunctionCall(Block: TBlock; FunctionCall: TFunctionCall);
     28    procedure GenerateProcedureCall(Block: TBlock; ProcedureCall: TProcedureCall);
    2629    procedure GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    2730    procedure GenerateExpression(Block: TBlock; Expression: TExpression);
    … …  
    5255  if Command is TBeginEnd then GenerateBeginEnd(Block, TBeginEnd(Command))
    5356  else if Command is TFunctionCall then GenerateFunctionCall(Block, TFunctionCall(Command))
     57  else if Command is TProcedureCall then GenerateProcedureCall(Block, TProcedureCall(Command))
    5458  else if Command is TAssignment then GenerateAssignment(Block, TAssignment(Command))
    5559  else if Command is TIfThenElse then GenerateIfThenElse(Block, TIfThenElse(Command))
    … …  
    133137end;
    134138
     139procedure TGeneratorPhp.GenerateProcedureCall(Block: TBlock;
     140  ProcedureCall: TProcedureCall);
     141var
     142  I: Integer;
     143begin
     144  AddText(ProcedureCall.ProcedureDef.Name);
     145  if ProcedureCall.Params.Count > 0 then begin
     146    AddText('(');
     147    for I := 0 to ProcedureCall.Params.Count - 1 do
     148      GenerateExpression(Block, TExpression(ProcedureCall.Params[I]));
     149    AddText(')');
     150  end;
     151end;
     152
    135153procedure TGeneratorPhp.GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    136154begin
    … …  
    240258    AddTextLine('{');
    241259    Indent := Indent + 1;
    242     if FunctionDef.InternalName = 'WriteLn' then AddTextLine('echo($Text."\n");')
    243     else if FunctionDef.InternalName = 'Write' then AddTextLine('echo($Text);')
    244     else if FunctionDef.InternalName = 'ReadLn' then AddTextLine('$Text = readline();')
    245     else if FunctionDef.InternalName = 'Read' then AddTextLine('$Text = readline();')
    246     else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return $Value;')
     260    if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return $Value;')
    247261    else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return $Value;')
    248262    else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return $Value;')
    … …  
    256270end;
    257271
     272procedure TGeneratorPhp.GenerateProcedure(ParentBlock: TBlock;
     273  ProcedureDef: TProcedure);
     274var
     275  I: Integer;
     276begin
     277  AddText('function ' + ProcedureDef.Name + '(');
     278  for I := 0 to ProcedureDef.Params.Count - 1 do begin
     279    if ProcedureDef.Params[I].Kind = pkVar then
     280      AddText('&');
     281    AddText('$' + TFunctionParameter(ProcedureDef.Params[I]).Name);
     282    if I > 0 then AddText(', ');
     283  end;
     284  AddTextLine(')');
     285  if ProcedureDef.InternalName <> '' then begin
     286    AddTextLine('{');
     287    Indent := Indent + 1;
     288    if ProcedureDef.InternalName = 'WriteLn' then AddTextLine('echo($Text."\n");')
     289    else if ProcedureDef.InternalName = 'Write' then AddTextLine('echo($Text);')
     290    else if ProcedureDef.InternalName = 'ReadLn' then AddTextLine('$Text = readline();')
     291    else if ProcedureDef.InternalName = 'Read' then AddTextLine('$Text = readline();');
     292    Indent := Indent - 1;
     293    AddTextLine('}');
     294  end else begin
     295    GenerateBlock(ParentBlock, ProcedureDef.Block);
     296    AddTextLine;
     297  end;
     298end;
     299
    258300procedure TGeneratorPhp.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
    259301begin
    260302  GenerateBlockConst(ParentBlock, Block);
     303  GenerateBlockProcedures(ParentBlock, Block);
    261304  GenerateBlockFunctions(ParentBlock, Block);
    262305  if Block.BeginEnd.Commands.Count > 0 then begin
    … …  
    290333end;
    291334
     335procedure TGeneratorPhp.GenerateBlockProcedures(ParentBlock: TBlock;
     336  Block: TBlock);
     337var
     338  I: Integer;
     339begin
     340  for I := 0 to Block.Procedures.Count - 1 do begin
     341    GenerateProcedure(ParentBlock, TProcedure(Block.Procedures[I]));
     342    AddTextLine;
     343  end;
     344end;
     345
    292346procedure TGeneratorPhp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
    293347var
Note: See TracChangeset for help on using the changeset viewer.