Changeset 234 for branches


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
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • branches/xpascal/Forms/FormMain.lfm

    r233 r234  
    2424    TabOrder = 0
    2525  end
    26   object PanelSource: TPanel
    27     Left = 7
    28     Height = 832
     26  object Splitter1: TSplitter
     27    Cursor = crVSplit
     28    Left = 0
     29    Height = 8
     30    Top = 824
     31    Width = 1491
     32    Align = alBottom
     33    ResizeAnchor = akBottom
     34  end
     35  object Panel1: TPanel
     36    Left = 0
     37    Height = 824
    2938    Top = 0
    30     Width = 829
     39    Width = 1491
    3140    Align = alClient
    32     BevelOuter = bvNone
    33     TabOrder = 1
    34   end
    35   object PanelOutput: TPanel
    36     Left = 836
    37     Height = 832
    38     Top = 0
    39     Width = 655
    40     Align = alRight
    41     BevelOuter = bvNone
     41    ClientHeight = 824
     42    ClientWidth = 1491
    4243    TabOrder = 2
    43   end
    44   object Splitter1: TSplitter
    45     Left = 0
    46     Height = 832
    47     Top = 0
    48     Width = 7
     44    object PanelSource: TPanel
     45      Left = 1
     46      Height = 822
     47      Top = 1
     48      Width = 826
     49      Align = alClient
     50      BevelOuter = bvNone
     51      TabOrder = 0
     52    end
     53    object PanelOutput: TPanel
     54      Left = 835
     55      Height = 822
     56      Top = 1
     57      Width = 655
     58      Align = alRight
     59      BevelOuter = bvNone
     60      TabOrder = 1
     61    end
     62    object Splitter2: TSplitter
     63      Left = 827
     64      Height = 822
     65      Top = 1
     66      Width = 8
     67      Align = alRight
     68      ResizeAnchor = akRight
     69    end
    4970  end
    5071  object MainMenu1: TMainMenu

  • branches/xpascal/Forms/FormMain.pas

    r233 r234  
    4141    MenuItemFile: TMenuItem;
    4242    OpenDialog1: TOpenDialog;
     43    Panel1: TPanel;
    4344    PanelOutput: TPanel;
    4445    PanelSource: TPanel;
    4546    PanelMessages: TPanel;
    4647    Splitter1: TSplitter;
     48    Splitter2: TSplitter;
    4749    procedure ACompileExecute(Sender: TObject);
    4850    procedure AConsoleExecute(Sender: TObject);

  • branches/xpascal/Forms/FormOutput.lfm

    r230 r234  
    11object FormOutput: TFormOutput
    2   Left = 563
     2  Left = 814
    33  Height = 544
    4   Top = 339
     4  Top = 448
    55  Width = 932
    66  Caption = 'Output'
    … …  
    1717    BorderSpacing.Around = 4
    1818    Anchors = [akTop, akLeft, akRight, akBottom]
     19    Color = clBlack
     20    Font.Color = clWhite
    1921    Font.Height = -20
    2022    Font.Name = 'DejaVu Sans Mono'

  • branches/xpascal/Forms/FormSource.lfm

    r227 r234  
    11object FormSource: TFormSource
    2   Left = 524
     2  Left = 692
    33  Height = 749
    4   Top = 299
     4  Top = 345
    55  Width = 1176
    66  Caption = 'Source'
    … …  
    1212    Left = 12
    1313    Height = 701
    14     Top = 36
     14    Top = 32
    1515    Width = 1156
    1616    Align = alCustom
    1717    BorderSpacing.Around = 4
    1818    Anchors = [akTop, akLeft, akRight, akBottom]
     19    Color = clBlack
     20    Font.Color = clWhite
    1921    Font.Height = -20
    2022    Font.Name = 'Liberation Mono'

  • 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

  • branches/xpascal/Languages/xpascal.cs.po

    r233 r234  
    174174msgid "Unsupported tokenizer state."
    175175msgstr "NepodporovanÜ stav tokenizeru."
     176

  • branches/xpascal/Parser.pas

    r230 r234  
    201201    ResultType := TypeBoolean;
    202202  end;
    203   with Block.Functions.AddNew('WriteLn') do begin
     203  with Block.Procedures.AddNew('WriteLn') do begin
    204204    InternalName := 'WriteLn';
    205205    Params.AddNew('Text', TypeString);
    206206  end;
    207   with Block.Functions.AddNew('Write') do begin
     207  with Block.Procedures.AddNew('Write') do begin
    208208    InternalName := 'Write';
    209209    Params.AddNew('Text', TypeString);
    210210  end;
    211   with Block.Functions.AddNew('ReadLn') do begin
     211  with Block.Procedures.AddNew('ReadLn') do begin
    212212    InternalName := 'ReadLn';
    213213    with Params.AddNew('Text', TypeString) do
    214214      Kind := pkVar;
    215215  end;
    216   with Block.Functions.AddNew('Read') do begin
     216  with Block.Procedures.AddNew('Read') do begin
    217217    InternalName := 'Read';
    218218    with Params.AddNew('Text', TypeString) do
Note: See TracChangeset for help on using the changeset viewer.