Ignore:
Timestamp:
Apr 20, 2020, 1:10:44 AM (5 years ago)
Author:
chronos
Message:
  • Added: Support for repeat-until.
Location:
branches/interpreter2
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/interpreter2

    • Property svn:ignore

      •  

        old new  
        44interpreter.res
        55heaptrclog.trc
         6Generated

  • branches/interpreter2/UGenerator.pas

    r204 r205  
    66
    77uses
    8   Classes, SysUtils, strutils, USource;
     8  Classes, SysUtils, strutils;
    99
    1010type
    11 
    12   { TGenerator }
    13 
    1411  TGenerator = class
    1512  private
    16     Indent: Integer;
     13    FIndent: Integer;
     14    procedure SetIndent(AValue: Integer);
     15  public
     16    Output: string;
    1717    procedure AddText(Text: string);
    1818    procedure AddTextLine(Text: string = '');
    19     procedure GenerateProgram(Block: TBlock;  Prog:TProgram);
    20     procedure GenerateBlock(ParentBlock: TBlock; Block: TBlock);
    21     procedure GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
    22     procedure GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
    23     procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
    24     procedure GenerateCommand(Block: TBlock; Command: TCommand);
    25     procedure GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse);
    26     procedure GenerateWhileDo(Block: TBlock; WhileDo: TWhileDo);
    27     procedure GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
    28     procedure GenerateFunctionCall(Block: TBlock; FunctionCall: TFunctionCall);
    29     procedure GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    30     procedure GenerateExpression(Block: TBlock; Expression: TExpression);
    31     procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation);
    32     procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand);
    33     procedure GenerateValue(Value: TValue);
    34   public
    35     Prog: TProgram;
    36     Output: string;
    37     procedure Generate;
     19    property Indent: Integer read FIndent write SetIndent;
    3820  end;
     21
    3922
    4023implementation
    4124
    42 { TGenerator }
    43 
    44 procedure TGenerator.GenerateCommand(Block: TBlock; Command: TCommand);
     25procedure TGenerator.SetIndent(AValue: Integer);
    4526begin
    46   if Command is TBeginEnd then GenerateBeginEnd(Block, TBeginEnd(Command))
    47   else if Command is TFunctionCall then GenerateFunctionCall(Block, TFunctionCall(Command))
    48   else if Command is TAssignment then GenerateAssignment(Block, TAssignment(Command))
    49   else if Command is TIfThenElse then GenerateIfThenElse(Block, TIfThenElse(Command))
    50   else if Command is TWhileDo then GenerateWhileDo(Block, TWhileDo(Command))
    51   else if Command is TForToDo then GenerateForToDo(Block, TForToDo(Command))
    52   else raise Exception.Create('Unsupported command type');
    53 end;
    54 
    55 procedure TGenerator.GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse);
    56 begin
    57   AddText('if ');
    58   GenerateExpression(Block, IfThenElse.Expression);
    59   AddText(' then ');
    60   GenerateCommand(Block, IfThenElse.CommandThen);
    61   if Assigned(IfThenElse.CommandElse) then begin
    62     AddText(' else ');
    63     GenerateCommand(Block, IfThenElse.CommandElse);
     27  if FIndent = AValue then Exit;
     28  if AValue > FIndent then begin
     29    Output := Output + DupeString('  ', AValue - FIndent);
     30  end else
     31  if AValue < FIndent then begin
     32    Output := Copy(Output, 1, Length(Output) - (FIndent - AValue) * 2);
    6433  end;
    65 end;
    66 
    67 procedure TGenerator.GenerateWhileDo(Block: TBlock; WhileDo: TWhileDo);
    68 begin
    69   AddText('while ');
    70   GenerateExpression(Block, WhileDo.Expression);
    71   AddText(' do ');
    72   GenerateCommand(Block, WhileDo.Command);
    73 end;
    74 
    75 procedure TGenerator.GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
    76 begin
    77   AddText('for ');
    78   AddText(ForToDo.VariableRef.Name);
    79   AddText(' := ');
    80   GenerateExpression(Block, ForToDo.ExpressionFrom);
    81   AddText(' to ');
    82   GenerateExpression(Block, ForToDo.ExpressionTo);
    83   AddText(' do ');
    84   GenerateCommand(Block, ForToDo.Command);
    85 end;
    86 
    87 procedure TGenerator.GenerateFunctionCall(Block: TBlock;
    88   FunctionCall: TFunctionCall);
    89 var
    90   I: Integer;
    91 begin
    92   AddText(FunctionCall.FunctionDef.Name);
    93   if FunctionCall.Params.Count > 0 then begin
    94     AddText('(');
    95     for I := 0 to FunctionCall.Params.Count - 1 do
    96       GenerateExpression(Block, TExpression(FunctionCall.Params[I]));
    97     AddText(')');
    98   end;
    99 end;
    100 
    101 procedure TGenerator.GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    102 begin
    103   AddText(Assignment.Variable.Name);
    104   AddText(' := ');
    105   GenerateExpression(Block, Assignment.Expression);
    106 end;
    107 
    108 procedure TGenerator.GenerateExpression(Block: TBlock; Expression: TExpression);
    109 begin
    110   if Expression is TExpressionOperation then
    111     GenerateExpressionOperation(Block, TExpressionOperation(Expression))
    112   else
    113   if Expression is TExpressionOperand then
    114     GenerateExpressionOperand(Block, TExpressionOperand(Expression))
    115   else raise Exception.Create('Unknown expression class.');
    116 end;
    117 
    118 procedure TGenerator.GenerateExpressionOperation(Block: TBlock;
    119   Expression: TExpressionOperation);
    120 var
    121   I: Integer;
    122 begin
    123   for I := 0 to Expression.Items.Count - 1 do begin
    124     if I > 0 then begin
    125       AddText(' ');
    126       if Expression.Operation = eoAdd then AddText('+')
    127       else if Expression.Operation = eoSub then AddText('-')
    128       else if Expression.Operation = eoEqual then AddText('=')
    129       else if Expression.Operation = eoNotEqual then AddText('<>');
    130       AddText(' ');
    131     end;
    132     GenerateExpression(Block, TExpression(Expression.Items[I]));
    133   end;
    134 end;
    135 
    136 procedure TGenerator.GenerateExpressionOperand(Block: TBlock;
    137   Expression: TExpressionOperand);
    138 begin
    139   case Expression.OperandType of
    140     otFunctionCall: GenerateFunctionCall(Block, Expression.FunctionCall);
    141     otConstantDirect: GenerateValue(Expression.ConstantDirect.Value);
    142     otConstantRef: AddText(Expression.ConstantRef.Name);
    143     otVariableRef: AddText(Expression.VariableRef.Name);
    144     else raise Exception.Create('Unsupported exception operand type.');
    145   end;
    146 end;
    147 
    148 procedure TGenerator.GenerateValue(Value: TValue);
    149 begin
    150   if Value is TValueBoolean then begin
    151     if TValueBoolean(Value).Value then AddText('True') else AddText('False');
    152   end else if Value is TValueString then AddText('''' + StringReplace(TValueString(Value).Value, '''', '''''', [rfReplaceAll]) + '''')
    153   else if Value is TValueInteger then AddText(IntToStr(TValueInteger(Value).Value))
    154   else raise Exception.Create('Unsupported value type.');
     34  FIndent := AValue;
    15535end;
    15636
    … …  
    16545end;
    16646
    167 procedure TGenerator.GenerateProgram(Block: TBlock; Prog: TProgram);
    168 begin
    169   if Prog.Name <> '' then AddTextLine('program ' + Prog.Name + ';');
    170   GenerateBlock(Block, Prog.Block);
    171   AddTextLine('.');
    172 end;
    173 
    174 procedure TGenerator.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
    175 begin
    176   GenerateBlockConst(ParentBlock, Block);
    177   GenerateBlockVar(ParentBlock, Block);
    178   GenerateBeginEnd(ParentBlock, Block.BeginEnd);
    179 end;
    180 
    181 procedure TGenerator.GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
    182 var
    183   I: Integer;
    184   Variable: TVariable;
    185 begin
    186   if Block.Variables.Count > 0 then begin
    187     AddText('var');
    188     Inc(Indent);
    189     AddTextLine;
    190     for I := 0 to Block.Variables.Count - 1 do begin
    191       Variable := TVariable(Block.Variables[I]);
    192       AddTextLine(Variable.Name + ': ' + Variable.TypeRef.Name + ';');
    193     end;
    194     Dec(Indent);
    195     AddTextLine;
    196   end;
    197 end;
    198 
    199 procedure TGenerator.GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
    200 var
    201   I: Integer;
    202   Constant: TConstant;
    203 begin
    204   if Block.Constants.Count > 0 then begin
    205     AddText('const');
    206     Inc(Indent);
    207     AddTextLine;
    208     for I := 0 to Block.Constants.Count - 1 do begin
    209       Constant := TConstant(Block.Constants[I]);
    210       AddText(Constant.Name + ': ' + Constant.TypeRef.Name + ' = ');
    211       GenerateValue(Constant.Value);
    212       AddTextLine(';');
    213     end;
    214     Dec(Indent);
    215     AddTextLine;
    216   end;
    217 end;
    218 
    219 procedure TGenerator.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd);
    220 var
    221   I: Integer;
    222 begin
    223   AddText('begin');
    224   Inc(Indent);
    225   AddTextLine('');
    226   for I := 0 to BeginEnd.Commands.Count - 1 do begin
    227     GenerateCommand(Block, TCommand(BeginEnd.Commands[I]));
    228     AddText(';');
    229     if I < BeginEnd.Commands.Count - 1 then AddTextLine('');
    230   end;
    231   Dec(Indent);
    232   AddTextLine('');
    233   AddText('end');
    234 end;
    235 
    236 procedure TGenerator.Generate;
    237 begin
    238   Output := '';
    239   GenerateProgram(Prog.SystemBlock, Prog);
    240 end;
    241 
    24247end.
    24348
Note: See TracChangeset for help on using the changeset viewer.