source: branches/xpascal/Generators/GeneratorCSharp.pas

Last change on this file was 234, checked in by chronos, 2 years ago
  • Fixed: Procedures generation.
  • Fixed: Splitters between panels.
File size: 14.7 KB
Line 
1unit GeneratorCSharp;
2
3interface
4
5uses
6 Classes, SysUtils, strutils, Source, Generator;
7
8type
9
10 { TGeneratorCSharp }
11
12 TGeneratorCSharp = class(TGenerator)
13 private
14 procedure GenerateProgram(Block: TBlock; Prog:TProgram);
15 procedure GenerateFunction(ParentBlock: TBlock; FunctionDef: TFunction);
16 procedure GenerateProcedure(ParentBlock: TBlock; ProcedureDef: TProcedure);
17 procedure GenerateBlock(ParentBlock: TBlock; Block: TBlock);
18 procedure GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
19 procedure GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
20 procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock);
21 procedure GenerateBlockProcedures(ParentBlock: TBlock; Block: TBlock);
22 procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
23 procedure GenerateCommand(Block: TBlock; Command: TCommand);
24 procedure GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse);
25 procedure GenerateWhileDo(Block: TBlock; WhileDo: TWhileDo);
26 procedure GenerateRepeatUntil(Block: TBlock; RepeatUntil: TRepeatUntil);
27 procedure GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
28 procedure GenerateFunctionCall(Block: TBlock; FunctionCall: TFunctionCall);
29 procedure GenerateProcedureCall(Block: TBlock; ProcedureCall: TProcedureCall);
30 procedure GenerateAssignment(Block: TBlock; Assignment: TAssignment);
31 procedure GenerateExpression(Block: TBlock; Expression: TExpression);
32 procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation);
33 procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand);
34 procedure GenerateExpressionBrackets(Block: TBlock; Expression: TExpressionBrackets);
35 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak);
36 procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue);
37 procedure GenerateReturn(Block: TBlock; Return: TReturn);
38 procedure GenerateTypeRef(TypeRef: TType);
39 procedure GenerateValue(Value: TValue);
40 public
41 procedure Generate; override;
42 constructor Create; override;
43 end;
44
45
46implementation
47
48const
49 ExpressionOperatorTextCSharp: array[TExpressionOperator] of string = ('', '+',
50 '-', '*', '/', '/', '%', '&', '^', '|', '<<',
51 '>>', '==', '!=', '<', '>', '<=','>=', '!');
52
53{ TGeneratorCSharp }
54
55procedure TGeneratorCSharp.GenerateCommand(Block: TBlock; Command: TCommand);
56begin
57 if Command is TBeginEnd then GenerateBeginEnd(Block, TBeginEnd(Command))
58 else if Command is TFunctionCall then GenerateFunctionCall(Block, TFunctionCall(Command))
59 else if Command is TProcedureCall then GenerateProcedureCall(Block, TProcedureCall(Command))
60 else if Command is TAssignment then GenerateAssignment(Block, TAssignment(Command))
61 else if Command is TIfThenElse then GenerateIfThenElse(Block, TIfThenElse(Command))
62 else if Command is TWhileDo then GenerateWhileDo(Block, TWhileDo(Command))
63 else if Command is TRepeatUntil then GenerateRepeatUntil(Block, TRepeatUntil(Command))
64 else if Command is TForToDo then GenerateForToDo(Block, TForToDo(Command))
65 else if Command is TBreak then GenerateBreak(Block, TBreak(Command))
66 else if Command is TContinue then GenerateContinue(Block, TContinue(Command))
67 else if Command is TReturn then GenerateReturn(Block, TReturn(Command))
68 else if Command is TEmptyCommand then
69 else raise Exception.Create('Unsupported command type');
70end;
71
72procedure TGeneratorCSharp.GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse);
73begin
74 AddText('if (');
75 GenerateExpression(Block, IfThenElse.Expression);
76 AddText(' ) ');
77 GenerateCommand(Block, IfThenElse.CommandThen);
78 if Assigned(IfThenElse.CommandElse) and not (IfThenElse.CommandElse is TEmptyCommand) then begin
79 if Copy(Output, Length(Output), 1) <> '}' then AddText(';');
80 AddText(' else ');
81 GenerateCommand(Block, IfThenElse.CommandElse);
82 end;
83end;
84
85procedure TGeneratorCSharp.GenerateWhileDo(Block: TBlock; WhileDo: TWhileDo);
86begin
87 AddText('while (');
88 GenerateExpression(Block, WhileDo.Expression);
89 AddText(' ) ');
90 GenerateCommand(Block, WhileDo.Command);
91end;
92
93procedure TGeneratorCSharp.GenerateRepeatUntil(Block: TBlock;
94 RepeatUntil: TRepeatUntil);
95var
96 I: Integer;
97begin
98 AddTextLine('while (true)');
99 AddTextLine('{');
100 Indent := Indent + 1;
101 for I := 0 to RepeatUntil.Commands.Count - 1 do begin
102 GenerateCommand(Block, TCommand(RepeatUntil.Commands[I]));
103 AddTextLine(';');
104 end;
105 AddText('if (');
106 GenerateExpression(Block, RepeatUntil.Expression);
107 AddTextLine(') break;');
108 Indent := Indent - 1;
109 AddTextLine('}');
110end;
111
112procedure TGeneratorCSharp.GenerateForToDo(Block: TBlock; ForToDo: TForToDo);
113begin
114 AddText('for (');
115 AddText(ForToDo.VariableRef.Name);
116 AddText(' = ');
117 GenerateExpression(Block, ForToDo.ExpressionFrom);
118 AddText(' ; ');
119 AddText(ForToDo.VariableRef.Name + ' <= ');
120 GenerateExpression(Block, ForToDo.ExpressionTo);
121 AddText(' ; ');
122 AddText(ForToDo.VariableRef.Name + '++');
123 AddText(' ) ');
124 GenerateCommand(Block, ForToDo.Command);
125end;
126
127procedure TGeneratorCSharp.GenerateFunctionCall(Block: TBlock;
128 FunctionCall: TFunctionCall);
129var
130 I: Integer;
131begin
132 AddText(FunctionCall.FunctionDef.Name);
133 if FunctionCall.Params.Count > 0 then begin
134 AddText('(');
135 for I := 0 to FunctionCall.Params.Count - 1 do begin
136 if FunctionCall.FunctionDef.Params[I].Kind = pkVar then
137 AddText('ref ');
138 GenerateExpression(Block, TExpression(FunctionCall.Params[I]));
139 end;
140 AddText(')');
141 end;
142end;
143
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
161procedure TGeneratorCSharp.GenerateAssignment(Block: TBlock; Assignment: TAssignment);
162begin
163 AddText(Assignment.Variable.Name);
164 AddText(' = ');
165 GenerateExpression(Block, Assignment.Expression);
166end;
167
168procedure TGeneratorCSharp.GenerateExpression(Block: TBlock; Expression: TExpression);
169begin
170 if Expression is TExpressionOperation then
171 GenerateExpressionOperation(Block, TExpressionOperation(Expression))
172 else
173 if Expression is TExpressionOperand then
174 GenerateExpressionOperand(Block, TExpressionOperand(Expression))
175 else
176 if Expression is TExpressionBrackets then
177 GenerateExpressionBrackets(Block, TExpressionBrackets(Expression))
178 else raise Exception.Create('Unknown expression class.');
179end;
180
181procedure TGeneratorCSharp.GenerateExpressionOperation(Block: TBlock;
182 Expression: TExpressionOperation);
183var
184 I: Integer;
185begin
186 for I := 0 to Expression.Items.Count - 1 do begin
187 if I > 0 then begin
188 AddText(' ' + ExpressionOperatorTextCSharp[Expression.Operation] + ' ');
189 end;
190 GenerateExpression(Block, TExpression(Expression.Items[I]));
191 end;
192end;
193
194procedure TGeneratorCSharp.GenerateExpressionOperand(Block: TBlock;
195 Expression: TExpressionOperand);
196begin
197 case Expression.OperandType of
198 otFunctionCall: GenerateFunctionCall(Block, Expression.FunctionCall);
199 otConstantDirect: GenerateValue(Expression.ConstantDirect.Value);
200 otConstantRef: AddText(Expression.ConstantRef.Name);
201 otVariableRef: AddText(Expression.VariableRef.Name);
202 else raise Exception.Create('Unsupported exception operand type.');
203 end;
204end;
205
206procedure TGeneratorCSharp.GenerateExpressionBrackets(Block: TBlock;
207 Expression: TExpressionBrackets);
208begin
209 AddText('(');
210 GenerateExpression(Block, Expression.Expression);
211 AddText(')');
212end;
213
214procedure TGeneratorCSharp.GenerateBreak(Block: TBlock; BreakCmd: TBreak);
215begin
216 AddText('break');
217end;
218
219procedure TGeneratorCSharp.GenerateContinue(Block: TBlock;
220 ContinueCmd: TContinue);
221begin
222 AddText('continue');
223end;
224
225procedure TGeneratorCSharp.GenerateReturn(Block: TBlock; Return: TReturn);
226begin
227 AddText('return ');
228 GenerateExpression(Block, Return.Expression);
229end;
230
231procedure TGeneratorCSharp.GenerateTypeRef(TypeRef: TType);
232begin
233 if Assigned(TypeRef) then begin
234 if TypeRef.Name = 'string' then AddText('string')
235 else if TypeRef.Name = 'Integer' then AddText('int')
236 else if TypeRef.Name = 'Boolean' then AddText('bool');
237 end else AddText('void');
238end;
239
240procedure TGeneratorCSharp.GenerateValue(Value: TValue);
241begin
242 if Value is TValueBoolean then begin
243 if TValueBoolean(Value).Value then AddText('true') else AddText('false');
244 end else if Value is TValueString then AddText('"' + StringReplace(TValueString(Value).Value, '''', '\''', [rfReplaceAll]) + '"')
245 else if Value is TValueInteger then AddText(IntToStr(TValueInteger(Value).Value))
246 else raise Exception.Create('Unsupported value type.');
247end;
248
249procedure TGeneratorCSharp.GenerateProgram(Block: TBlock; Prog: TProgram);
250var
251 MainClass: string;
252begin
253 if Prog.Name <> '' then MainClass := Prog.Name
254 else MainClass := 'App';
255 AddTextLine('using System;');
256 AddTextLine;
257 AddTextLine('public class ' + MainClass);
258 AddTextLine('{');
259 Indent := Indent + 1;
260 GenerateBlockFunctions(nil, Prog.SystemBlock);
261 GenerateBlockProcedures(nil, Prog.SystemBlock);
262 GenerateBlock(nil, Prog.SystemBlock);
263 AddTextLine('public static void Main()');
264 AddTextLine('{');
265 AddTextLine(' ' + MainClass + ' app = new ' + MainClass + '();');
266 AddTextLine(' app.Entry();');
267 AddTextLine('}');
268 AddTextLine();
269 GenerateBlockFunctions(Prog.Block, Prog.Block);
270 GenerateBlockProcedures(Prog.Block, Prog.Block);
271 AddTextLine('public void Entry()');
272 GenerateBlock(Block, Prog.Block);
273 Indent := Indent - 1;
274 AddTextLine('}');
275end;
276
277procedure TGeneratorCSharp.GenerateBlock(ParentBlock: TBlock; Block: TBlock);
278begin
279 if Block.BeginEnd.Commands.Count > 0 then begin
280 AddTextLine('{');
281 Indent := Indent + 1;
282 GenerateBlockVar(Block, Block);
283 GenerateBlockConst(Block, Block);
284 GenerateBeginEnd(ParentBlock, Block.BeginEnd, False);
285 Indent := Indent - 1;
286 AddTextLine('}');
287 end;
288end;
289
290procedure TGeneratorCSharp.GenerateBlockConst(ParentBlock: TBlock; Block: TBlock);
291var
292 I: Integer;
293 Constant: TConstant;
294begin
295 for I := 0 to Block.Constants.Count - 1 do begin
296 Constant := TConstant(Block.Constants[I]);
297 GenerateTypeRef(Constant.TypeRef);
298 AddText(' ' + Constant.Name + ' = ');
299 GenerateValue(Constant.Value);
300 AddTextLine(';');
301 end;
302 if Block.Constants.Count > 0 then AddTextLine;
303end;
304
305procedure TGeneratorCSharp.GenerateBlockVar(ParentBlock: TBlock; Block: TBlock);
306var
307 I: Integer;
308 Variable: TVariable;
309 VarCount: Integer;
310begin
311 VarCount := 0;
312 for I := 0 to Block.Variables.Count - 1 do
313 if not TVariable(Block.Variables[I]).Internal then Inc(VarCount);
314 if VarCount > 0 then begin
315 for I := 0 to Block.Variables.Count - 1 do
316 if not TVariable(Block.Variables[I]).Internal then begin
317 Variable := TVariable(Block.Variables[I]);
318 GenerateTypeRef(Variable.TypeRef);
319 AddTextLine(' ' + Variable.Name + ';');
320 end;
321 end;
322 if VarCount > 0 then AddTextLine;
323end;
324
325procedure TGeneratorCSharp.GenerateFunction(ParentBlock: TBlock;
326 FunctionDef: TFunction);
327var
328 I: Integer;
329 Param: TFunctionParameter;
330begin
331 GenerateTypeRef(FunctionDef.ResultType);
332 AddText(' ' + FunctionDef.Name + '(');
333 for I := 0 to FunctionDef.Params.Count - 1 do begin
334 Param := TFunctionParameter(FunctionDef.Params[I]);
335 if Param.Kind = pkVar then AddText('ref ');
336 GenerateTypeRef(Param.TypeRef);
337 AddText(' ');
338 AddText(Param.Name);
339 if I > 0 then AddText(', ');
340 end;
341 AddTextLine(')');
342 if FunctionDef.InternalName <> '' then begin
343 AddTextLine('{');
344 Indent := Indent + 1;
345 if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return Value.ToString();')
346 else if FunctionDef.InternalName = 'StrToInt' then begin
347 AddTextLine('int x = 0;');
348 AddTextLine('if (int.TryParse(Value, out x))');
349 AddTextLine('{');
350 AddTextLine(' return x;');
351 AddTextLine('} else return 0;');
352 end
353 else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return Value.ToString();')
354 else if FunctionDef.InternalName = 'StrToBool' then begin
355 AddTextLine('bool x = false;');
356 AddTextLine('if (bool.TryParse(Value, out x))');
357 AddTextLine('{');
358 AddTextLine(' return x;');
359 AddTextLine('} else return false;');
360 end;
361
362 Indent := Indent - 1;
363 AddTextLine('}');
364 end else begin
365 GenerateBlock(ParentBlock, FunctionDef.Block);
366 AddTextLine;
367 end;
368end;
369
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
402procedure TGeneratorCSharp.GenerateBlockFunctions(ParentBlock: TBlock;
403 Block: TBlock);
404var
405 I: Integer;
406begin
407 for I := 0 to Block.Functions.Count - 1 do begin
408 GenerateFunction(ParentBlock, TFunction(Block.Functions[I]));
409 AddTextLine;
410 end;
411end;
412
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
424procedure TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True);
425var
426 I: Integer;
427begin
428 if Enclosed then begin
429 AddTextLine('{');
430 Indent := Indent + 1;
431 end;
432 for I := 0 to BeginEnd.Commands.Count - 1 do begin
433 GenerateCommand(Block, TCommand(BeginEnd.Commands[I]));
434 AddTextLine(';');
435 end;
436 if Enclosed then begin
437 Indent := Indent - 1;
438 AddText('}');
439 end;
440end;
441
442procedure TGeneratorCSharp.Generate;
443begin
444 Output := '';
445 GenerateProgram(Prog.SystemBlock, Prog);
446end;
447
448constructor TGeneratorCSharp.Create;
449begin
450 inherited;
451 Name := 'CSharp';
452 FileExt := '.cs';
453end;
454
455end.
456
Note: See TracBrowser for help on using the repository browser.