source: branches/xpascal/Generators/GeneratorCSharp.pas

unit GeneratorCSharp;

interface

uses
  Classes, SysUtils, strutils, Source, Generator;

type

  { TGeneratorCSharp }

  TGeneratorCSharp = class(TGenerator)
  private
    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 GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
    procedure GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
    procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock);
    procedure GenerateBlockProcedures(ParentBlock: TBlock; Block: TBlock);
    procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
    procedure GenerateCommand(Block: TBlock; Command: TCommand);
    procedure GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse);
    procedure GenerateWhileDo(Block: TBlock; WhileDo: TWhileDo);
    procedure GenerateRepeatUntil(Block: TBlock; RepeatUntil: TRepeatUntil);
    procedure GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
    procedure GenerateFunctionCall(Block: TBlock; FunctionCall: TFunctionCall);
    procedure GenerateProcedureCall(Block: TBlock; ProcedureCall: TProcedureCall);
    procedure GenerateAssignment(Block: TBlock; Assignment: TAssignment);
    procedure GenerateExpression(Block: TBlock; Expression: TExpression);
    procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation);
    procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand);
    procedure GenerateExpressionBrackets(Block: TBlock; Expression: TExpressionBrackets);
    procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
    procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
    procedure GenerateReturn(Block: TBlock; Return: TReturn);
    procedure GenerateTypeRef(TypeRef: TType);
    procedure GenerateValue(Value: TValue);
  public
    procedure Generate; override;
    constructor Create; override;
  end;


implementation

const
  ExpressionOperatorTextCSharp: array[TExpressionOperator] of string = ('', '+',
    '-', '*', '/', '/', '%', '&', '^', '|', '<<',
    '>>', '==', '!=', '<', '>', '<=','>=', '!');

{ TGeneratorCSharp }

procedure TGeneratorCSharp.GenerateCommand(Block: TBlock; Command: TCommand);
begin
  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))
  else if Command is TWhileDo then GenerateWhileDo(Block, TWhileDo(Command))
  else if Command is TRepeatUntil then GenerateRepeatUntil(Block, TRepeatUntil(Command))
  else if Command is TForToDo then GenerateForToDo(Block, TForToDo(Command))
  else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
  else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
  else if Command is TReturn then GenerateReturn(Block, TReturn(Command))
  else if Command is TEmptyCommand then
  else raise Exception.Create('Unsupported command type');
end;

procedure TGeneratorCSharp.GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse);
begin
  AddText('if (');
  GenerateExpression(Block, IfThenElse.Expression);
  AddText(' ) ');
  GenerateCommand(Block, IfThenElse.CommandThen);
  if Assigned(IfThenElse.CommandElse) and not (IfThenElse.CommandElse is TEmptyCommand) then begin
    if Copy(Output, Length(Output), 1) <> '}' then AddText(';');
    AddText(' else ');
    GenerateCommand(Block, IfThenElse.CommandElse);
  end;
end;

procedure TGeneratorCSharp.GenerateWhileDo(Block: TBlock; WhileDo: TWhileDo);
begin
  AddText('while (');
  GenerateExpression(Block, WhileDo.Expression);
  AddText(' ) ');
  GenerateCommand(Block, WhileDo.Command);
end;

procedure TGeneratorCSharp.GenerateRepeatUntil(Block: TBlock;
  RepeatUntil: TRepeatUntil);
var
  I: Integer;
begin
  AddTextLine('while (true)');
  AddTextLine('{');
  Indent := Indent + 1;
  for I := 0 to RepeatUntil.Commands.Count - 1 do begin
    GenerateCommand(Block, TCommand(RepeatUntil.Commands[I]));
    AddTextLine(';');
  end;
  AddText('if (');
  GenerateExpression(Block, RepeatUntil.Expression);
  AddTextLine(') break;');
  Indent := Indent - 1;
  AddTextLine('}');
end;

procedure TGeneratorCSharp.GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
begin
  AddText('for (');
  AddText(ForToDo.VariableRef.Name);
  AddText(' = ');
  GenerateExpression(Block, ForToDo.ExpressionFrom);
  AddText(' ; ');
  AddText(ForToDo.VariableRef.Name + ' <= ');
  GenerateExpression(Block, ForToDo.ExpressionTo);
  AddText(' ; ');
  AddText(ForToDo.VariableRef.Name + '++');
  AddText(' ) ');
  GenerateCommand(Block, ForToDo.Command);
end;

procedure TGeneratorCSharp.GenerateFunctionCall(Block: TBlock;
  FunctionCall: TFunctionCall);
var
  I: Integer;
begin
  AddText(FunctionCall.FunctionDef.Name);
  if FunctionCall.Params.Count > 0 then begin
    AddText('(');
    for I := 0 to FunctionCall.Params.Count - 1 do begin
      if FunctionCall.FunctionDef.Params[I].Kind = pkVar then
        AddText('ref ');
      GenerateExpression(Block, TExpression(FunctionCall.Params[I]));
    end;
    AddText(')');
  end;
end;

procedure TGeneratorCSharp.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 begin
      if ProcedureCall.ProcedureDef.Params[I].Kind = pkVar then
        AddText('ref ');
      GenerateExpression(Block, TExpression(ProcedureCall.Params[I]));
    end;
    AddText(')');
  end;
end;

procedure TGeneratorCSharp.GenerateAssignment(Block: TBlock; Assignment: TAssignment);
begin
  AddText(Assignment.Variable.Name);
  AddText(' = ');
  GenerateExpression(Block, Assignment.Expression);
end;

procedure TGeneratorCSharp.GenerateExpression(Block: TBlock; Expression: TExpression);
begin
  if Expression is TExpressionOperation then
    GenerateExpressionOperation(Block, TExpressionOperation(Expression))
  else
  if Expression is TExpressionOperand then
    GenerateExpressionOperand(Block, TExpressionOperand(Expression))
  else
  if Expression is TExpressionBrackets then
    GenerateExpressionBrackets(Block, TExpressionBrackets(Expression))
  else raise Exception.Create('Unknown expression class.');
end;

procedure TGeneratorCSharp.GenerateExpressionOperation(Block: TBlock;
  Expression: TExpressionOperation);
var
  I: Integer;
begin
  for I := 0 to Expression.Items.Count - 1 do begin
    if I > 0 then begin
      AddText(' ' + ExpressionOperatorTextCSharp[Expression.Operation] + ' ');
    end;
    GenerateExpression(Block, TExpression(Expression.Items[I]));
  end;
end;

procedure TGeneratorCSharp.GenerateExpressionOperand(Block: TBlock;
  Expression: TExpressionOperand);
begin
  case Expression.OperandType of
    otFunctionCall: GenerateFunctionCall(Block, Expression.FunctionCall);
    otConstantDirect: GenerateValue(Expression.ConstantDirect.Value);
    otConstantRef: AddText(Expression.ConstantRef.Name);
    otVariableRef: AddText(Expression.VariableRef.Name);
    else raise Exception.Create('Unsupported exception operand type.');
  end;
end;

procedure TGeneratorCSharp.GenerateExpressionBrackets(Block: TBlock;
  Expression: TExpressionBrackets);
begin
  AddText('(');
  GenerateExpression(Block, Expression.Expression);
  AddText(')');
end;

procedure TGeneratorCSharp.GenerateBreak(Block: TBlock; BreakCmd: TBreak);
begin
  AddText('break');
end;

procedure TGeneratorCSharp.GenerateContinue(Block: TBlock;
  ContinueCmd: TContinue);
begin
  AddText('continue');
end;

procedure TGeneratorCSharp.GenerateReturn(Block: TBlock; Return: TReturn);
begin
  AddText('return ');
  GenerateExpression(Block, Return.Expression);
end;

procedure TGeneratorCSharp.GenerateTypeRef(TypeRef: TType);
begin
  if Assigned(TypeRef) then begin
    if TypeRef.Name = 'string' then AddText('string')
    else if TypeRef.Name = 'Integer' then AddText('int')
    else if TypeRef.Name = 'Boolean' then AddText('bool');
  end else AddText('void');
end;

procedure TGeneratorCSharp.GenerateValue(Value: TValue);
begin
  if Value is TValueBoolean then begin
    if TValueBoolean(Value).Value then AddText('true') else AddText('false');
  end else if Value is TValueString then AddText('"' + StringReplace(TValueString(Value).Value, '''', '\''', [rfReplaceAll]) + '"')
  else if Value is TValueInteger then AddText(IntToStr(TValueInteger(Value).Value))
  else raise Exception.Create('Unsupported value type.');
end;

procedure TGeneratorCSharp.GenerateProgram(Block: TBlock; Prog: TProgram);
var
  MainClass: string;
begin
  if Prog.Name <> '' then MainClass := Prog.Name
    else MainClass := 'App';
  AddTextLine('using System;');
  AddTextLine;
  AddTextLine('public class ' + MainClass);
  AddTextLine('{');
  Indent := Indent + 1;
  GenerateBlockFunctions(nil, Prog.SystemBlock);
  GenerateBlockProcedures(nil, Prog.SystemBlock);
  GenerateBlock(nil, Prog.SystemBlock);
  AddTextLine('public static void Main()');
  AddTextLine('{');
  AddTextLine('  ' + MainClass + ' app = new ' + MainClass + '();');
  AddTextLine('  app.Entry();');
  AddTextLine('}');
  AddTextLine();
  GenerateBlockFunctions(Prog.Block, Prog.Block);
  GenerateBlockProcedures(Prog.Block, Prog.Block);
  AddTextLine('public void Entry()');
  GenerateBlock(Block, Prog.Block);
  Indent := Indent - 1;
  AddTextLine('}');
end;

procedure TGeneratorCSharp.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
begin
  if Block.BeginEnd.Commands.Count > 0 then begin
    AddTextLine('{');
    Indent := Indent + 1;
    GenerateBlockVar(Block, Block);
    GenerateBlockConst(Block, Block);
    GenerateBeginEnd(ParentBlock, Block.BeginEnd, False);
    Indent := Indent - 1;
    AddTextLine('}');
  end;
end;

procedure TGeneratorCSharp.GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
var
  I: Integer;
  Constant: TConstant;
begin
  for I := 0 to Block.Constants.Count - 1 do begin
    Constant := TConstant(Block.Constants[I]);
    GenerateTypeRef(Constant.TypeRef);
    AddText(' ' + Constant.Name + ' = ');
    GenerateValue(Constant.Value);
    AddTextLine(';');
  end;
  if Block.Constants.Count > 0 then AddTextLine;
end;

procedure TGeneratorCSharp.GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
var
  I: Integer;
  Variable: TVariable;
  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
    for I := 0 to Block.Variables.Count - 1 do
    if not TVariable(Block.Variables[I]).Internal then begin
      Variable := TVariable(Block.Variables[I]);
      GenerateTypeRef(Variable.TypeRef);
      AddTextLine(' ' + Variable.Name + ';');
    end;
  end;
  if VarCount > 0 then AddTextLine;
end;

procedure TGeneratorCSharp.GenerateFunction(ParentBlock: TBlock;
  FunctionDef: TFunction);
var
  I: Integer;
  Param: TFunctionParameter;
begin
  GenerateTypeRef(FunctionDef.ResultType);
  AddText(' ' + FunctionDef.Name + '(');
  for I := 0 to FunctionDef.Params.Count - 1 do begin
    Param := TFunctionParameter(FunctionDef.Params[I]);
    if Param.Kind = pkVar then AddText('ref ');
    GenerateTypeRef(Param.TypeRef);
    AddText(' ');
    AddText(Param.Name);
    if I > 0 then AddText(', ');
  end;
  AddTextLine(')');
  if FunctionDef.InternalName <> '' then begin
    AddTextLine('{');
    Indent := Indent + 1;
    if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return Value.ToString();')
    else if FunctionDef.InternalName = 'StrToInt' then begin
      AddTextLine('int x = 0;');
      AddTextLine('if (int.TryParse(Value, out x))');
      AddTextLine('{');
      AddTextLine('  return x;');
      AddTextLine('} else return 0;');
    end
    else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return Value.ToString();')
    else if FunctionDef.InternalName = 'StrToBool' then begin
      AddTextLine('bool x = false;');
      AddTextLine('if (bool.TryParse(Value, out x))');
      AddTextLine('{');
      AddTextLine('  return x;');
      AddTextLine('} else return false;');
    end;

    Indent := Indent - 1;
    AddTextLine('}');
  end else begin
    GenerateBlock(ParentBlock, FunctionDef.Block);
    AddTextLine;
  end;
end;

procedure TGeneratorCSharp.GenerateProcedure(ParentBlock: TBlock;
  ProcedureDef: TProcedure);
var
  I: Integer;
  Param: TFunctionParameter;
begin
  AddText('void ' + ProcedureDef.Name + '(');
  for I := 0 to ProcedureDef.Params.Count - 1 do begin
    Param := TFunctionParameter(ProcedureDef.Params[I]);
    if Param.Kind = pkVar then AddText('ref ');
    GenerateTypeRef(Param.TypeRef);
    AddText(' ');
    AddText(Param.Name);
    if I > 0 then AddText(', ');
  end;
  AddTextLine(')');
  if ProcedureDef.InternalName <> '' then begin
    AddTextLine('{');
    Indent := Indent + 1;
    if ProcedureDef.InternalName = 'WriteLn' then AddTextLine('Console.Write(Text + "\n");')
    else if ProcedureDef.InternalName = 'Write' then AddTextLine('Console.Write(Text);')
    else if ProcedureDef.InternalName = 'ReadLn' then AddTextLine('Text = Console.ReadLine();')
    else if ProcedureDef.InternalName = 'Read' then AddTextLine('Text = Console.ReadLine();');

    Indent := Indent - 1;
    AddTextLine('}');
  end else begin
    GenerateBlock(ParentBlock, ProcedureDef.Block);
    AddTextLine;
  end;
end;

procedure TGeneratorCSharp.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 TGeneratorCSharp.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 TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
var
  I: Integer;
begin
  if Enclosed then begin
    AddTextLine('{');
    Indent := Indent + 1;
  end;
  for I := 0 to BeginEnd.Commands.Count - 1 do begin
    GenerateCommand(Block, TCommand(BeginEnd.Commands[I]));
    AddTextLine(';');
  end;
  if Enclosed then begin
    Indent := Indent - 1;
    AddText('}');
  end;
end;

procedure TGeneratorCSharp.Generate;
begin
  Output := '';
  GenerateProgram(Prog.SystemBlock, Prog);
end;

constructor TGeneratorCSharp.Create;
begin
  inherited;
  Name := 'CSharp';
  FileExt := '.cs';
end;

end.