Changeset 213
- Timestamp:
- Apr 22, 2020, 10:23:31 PM (5 years ago)
- Location:
- branches/interpreter2
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/interpreter2/Forms/UFormMain.lfm
r210 r213 108 108 OnExecute = AExitExecute 109 109 end 110 object AOptimize: TAction111 Caption = 'Optimize'112 OnExecute = AOptimizeExecute113 end114 110 object AGenerateXml: TAction 115 111 Caption = 'Generate XML' -
branches/interpreter2/Forms/UFormMain.pas
r211 r213 7 7 uses 8 8 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus, 9 ActnList, ExtCtrls, SynHighlighterPas, SynEdit, USource ;9 ActnList, ExtCtrls, SynHighlighterPas, SynEdit, USource, UOptimizer; 10 10 11 11 type … … 16 16 ACompile: TAction; 17 17 AGenerateXml: TAction; 18 AOptimize: TAction;19 18 AExit: TAction; 20 19 ARun: TAction; … … 44 43 procedure AGeneratePhpExecute(Sender: TObject); 45 44 procedure AGenerateXmlExecute(Sender: TObject); 46 procedure AOptimizeExecute(Sender: TObject);45 procedure Optimize(Features: TOptimizeFeatures); 47 46 procedure ARunExecute(Sender: TObject); 48 47 procedure FormActivate(Sender: TObject); … … 71 70 uses 72 71 UParser, UExecutor, UGeneratorPascal, UGeneratorPhp, UFormMessages, UFormSource, 73 UGeneratorCSharp, U Optimizer, UGeneratorXml, UFormOutput;72 UGeneratorCSharp, UGeneratorXml, UFormOutput; 74 73 75 74 { TFormMain } … … 127 126 begin 128 127 ACompile.Execute; 129 AOptimize.Execute;128 Optimize([ofReplaceResultByReturn, ofReplaceRepeatUntilByWhileDo]); 130 129 FormOutput.SynEditOutput.Highlighter := FormOutput.SynCppSyn1; 131 130 FormOutput.Clear; … … 145 144 begin 146 145 ACompile.Execute; 147 AOptimize.Execute;148 146 FormOutput.SynEditOutput.Highlighter := FormOutput.SynPasSyn1; 149 147 FormOutput.SynEditOutput.Lines.Clear; … … 163 161 begin 164 162 ACompile.Execute; 163 Optimize([ofReplaceResultByReturn, ofReplaceRepeatUntilByWhileDo]); 165 164 FormOutput.SynEditOutput.Highlighter := FormOutput.SynPhpSyn1; 166 165 FormOutput.SynEditOutput.Lines.Clear; … … 192 191 end; 193 192 194 procedure TFormMain. AOptimizeExecute(Sender: TObject);193 procedure TFormMain.Optimize(Features: TOptimizeFeatures); 195 194 var 196 195 Optimizer: TOptimizer; … … 198 197 if Assigned(Prog) then begin 199 198 Optimizer := TOptimizer.Create; 199 Optimizer.Features := Features; 200 200 Optimizer.Prog := Prog; 201 201 Optimizer.Optimize; … … 209 209 begin 210 210 ACompile.Execute; 211 AOptimize.Execute;212 211 FormOutput.SynEditOutput.Highlighter := nil; 213 212 FormOutput.SynEditOutput.Lines.Clear; -
branches/interpreter2/UGeneratorCSharp.pas
r212 r213 20 20 procedure GenerateBlockVar(ParentBlock: TBlock; Block: TBlock); 21 21 procedure GenerateBlockFunctions(ParentBlock: TBlock; Block: TBlock); 22 procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd );22 procedure GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True); 23 23 procedure GenerateCommand(Block: TBlock; Command: TCommand); 24 24 procedure GenerateIfThenElse(Block: TBlock; IfThenElse: TIfThenElse); … … 33 33 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak); 34 34 procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue); 35 procedure GenerateReturn(Block: TBlock; Return: TReturn); 35 36 procedure GenerateTypeRef(TypeRef: TType); 36 37 procedure GenerateValue(Value: TValue); … … 55 56 else if Command is TBreak then GenerateBreak(Block, TBreak(Command)) 56 57 else if Command is TContinue then GenerateContinue(Block, TContinue(Command)) 58 else if Command is TReturn then GenerateReturn(Block, TReturn(Command)) 57 59 else if Command is TEmptyCommand then 58 60 else raise Exception.Create('Unsupported command type'); … … 184 186 end; 185 187 188 procedure TGeneratorCSharp.GenerateReturn(Block: TBlock; Return: TReturn); 189 begin 190 AddText('return '); 191 GenerateExpression(Block, Return.Expression); 192 end; 193 186 194 procedure TGeneratorCSharp.GenerateTypeRef(TypeRef: TType); 187 195 begin … … 209 217 AddTextLine('{'); 210 218 Indent := Indent + 1; 219 GenerateBlockFunctions(nil, Prog.SystemBlock); 211 220 GenerateBlock(nil, Prog.SystemBlock); 212 221 AddTextLine('public static void Main()'); … … 216 225 AddTextLine('}'); 217 226 AddTextLine(); 227 GenerateBlockFunctions(Prog.Block, Prog.Block); 218 228 AddTextLine('public void Entry()'); 219 229 GenerateBlock(Block, Prog.Block); … … 223 233 224 234 procedure TGeneratorCSharp.GenerateBlock(ParentBlock: TBlock; Block: TBlock); 225 begin 226 GenerateBlockVar(Block, Block); 227 GenerateBlockConst(Block, Block); 228 GenerateBlockFunctions(Block, Block); 235 var 236 I: Integer; 237 begin 229 238 if Block.BeginEnd.Commands.Count > 0 then begin 230 GenerateBeginEnd(ParentBlock, Block.BeginEnd); 231 AddTextLine; 239 AddTextLine('{'); 240 Indent := Indent + 1; 241 GenerateBlockVar(Block, Block); 242 GenerateBlockConst(Block, Block); 243 GenerateBeginEnd(ParentBlock, Block.BeginEnd, False); 244 Indent := Indent - 1; 245 AddTextLine('}'); 232 246 end; 233 247 end; … … 245 259 AddTextLine(';'); 246 260 end; 261 if Block.Constants.Count > 0 then AddTextLine; 247 262 end; 248 263 … … 251 266 I: Integer; 252 267 Variable: TVariable; 253 begin 254 if Block.Variables.Count > 0 then begin 268 VarCount: Integer; 269 begin 270 VarCount := 0; 271 for I := 0 to Block.Variables.Count - 1 do 272 if not TVariable(Block.Variables[I]).Internal then Inc(VarCount); 273 if VarCount > 0 then begin 255 274 for I := 0 to Block.Variables.Count - 1 do 256 275 if not TVariable(Block.Variables[I]).Internal then begin … … 259 278 AddTextLine(' ' + Variable.Name + ';'); 260 279 end; 261 AddTextLine;262 end;280 end; 281 if VarCount > 0 then AddTextLine; 263 282 end; 264 283 … … 310 329 end; 311 330 312 procedure TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd); 313 var 314 I: Integer; 315 begin 316 AddTextLine('{'); 317 Indent := Indent + 1; 331 procedure TGeneratorCSharp.GenerateBeginEnd(Block: TBlock; BeginEnd: TBeginEnd; Enclosed: Boolean = True); 332 var 333 I: Integer; 334 begin 335 if Enclosed then begin 336 AddTextLine('{'); 337 Indent := Indent + 1; 338 end; 318 339 for I := 0 to BeginEnd.Commands.Count - 1 do begin 319 340 GenerateCommand(Block, TCommand(BeginEnd.Commands[I])); 320 341 AddTextLine(';'); 321 342 end; 322 Indent := Indent - 1; 323 AddText('}'); 343 if Enclosed then begin 344 Indent := Indent - 1; 345 AddText('}'); 346 end; 324 347 end; 325 348 -
branches/interpreter2/UGeneratorPhp.pas
r212 r213 31 31 procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand); 32 32 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak); 33 procedure GenerateReturn(Block: TBlock; Return: TReturn); 33 34 procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue); 34 35 procedure GenerateValue(Value: TValue); … … 53 54 else if Command is TBreak then GenerateBreak(Block, TBreak(Command)) 54 55 else if Command is TContinue then GenerateContinue(Block, TContinue(Command)) 56 else if Command is TReturn then GenerateReturn(Block, TReturn(Command)) 55 57 else if Command is TEmptyCommand then 56 58 else raise Exception.Create('Unsupported command type'); … … 177 179 begin 178 180 AddText('break'); 181 end; 182 183 procedure TGeneratorPhp.GenerateReturn(Block: TBlock; Return: TReturn); 184 begin 185 AddText('return '); 186 GenerateExpression(Block, Return.Expression); 179 187 end; 180 188 -
branches/interpreter2/UOptimizer.pas
r211 r213 9 9 10 10 type 11 TOptimizeFeature = (ofReplaceRepeatUntilByWhileDo, ofReplaceResultByReturn); 12 TOptimizeFeatures = set of TOptimizeFeature; 11 13 12 14 { TOptimizer } … … 18 20 public 19 21 Prog: TProgram; 22 Features: TOptimizeFeatures; 20 23 procedure Optimize; 21 24 end; … … 29 32 var 30 33 I: Integer; 34 TempNewNode: TSourceNode; 31 35 begin 32 36 for I := 0 to SourceNodes.Count - 1 do begin 33 37 if SourceNodes[I] is TSourceNode then begin 34 OptimizeNode(TSourceNode(SourceNodes[I]), NewNode);35 if Assigned( NewNode) and (NewNode <> TSourceNode(SourceNodes[I])) then begin36 SourceNodes[I] := NewNode;38 OptimizeNode(TSourceNode(SourceNodes[I]), TempNewNode); 39 if Assigned(TempNewNode) and (TempNewNode <> TSourceNode(SourceNodes[I])) then begin 40 SourceNodes[I] := TempNewNode; 37 41 end; 38 42 end else raise Exception.Create('Unsupported node type'); … … 46 50 WhileDo: TWhileDo; 47 51 Condition: TIfThenElse; 52 Return: TReturn; 48 53 Field: TField; 49 54 Obj: TObject; 55 TempNewNode: TSourceNode; 50 56 begin 51 57 NewNode := nil; … … 55 61 OptimizeNodes(TSourceNodes(SourceNode), NewNode) 56 62 end else 57 if SourceNode is TRepeatUntilthen begin63 if (ofReplaceRepeatUntilByWhileDo in Features) and (SourceNode is TRepeatUntil) then begin 58 64 WhileDo := TWhileDo.Create; 59 65 WhileDo.Command := TBeginEnd.Create; … … 79 85 NewNode := WhileDo; 80 86 end else 87 if (ofReplaceResultByReturn in Features) and (SourceNode is TAssignment) then begin 88 if TAssignment(SourceNode).Variable.Name = 'Result' then begin 89 Return := TReturn.Create; 90 Return.Parent := TAssignment(SourceNode).Parent; 91 Return.Expression.Free; 92 Return.Expression := TAssignment(SourceNode).Expression; 93 Return.Expression.Parent := Return; 94 TAssignment(SourceNode).Expression := TExpression.Create; 95 NewNode := Return; 96 end; 97 end else 81 98 if SourceNode is TSourceNode then begin 82 99 for I := 0 to SourceNode.FieldsCount - 1 do begin … … 85 102 SourceNode.GetValue(I, Obj); 86 103 if Obj is TSourceNode then begin 87 OptimizeNode(TSourceNode(Obj), NewNode);88 if Assigned( NewNode) and (NewNode <> TSourceNode(Obj)) then begin89 SourceNode.SetValueObject(I, NewNode);104 OptimizeNode(TSourceNode(Obj), TempNewNode); 105 if Assigned(TempNewNode) and (TempNewNode <> TSourceNode(Obj)) then begin 106 SourceNode.SetValueObject(I, TempNewNode); 90 107 end; 91 108 end; -
branches/interpreter2/USource.pas
r212 r213 308 308 end; 309 309 310 { TReturn } 311 312 TReturn = class(TCommand) 313 private 314 function GetFieldsCount: Integer; override; 315 public 316 Expression: TExpression; 317 procedure GetValue(Index: Integer; out Value); override; 318 function GetField(Index: Integer): TField; override; 319 procedure SetValue(Index: Integer; var Value); override; 320 constructor Create; 321 destructor Destroy; override; 322 end; 323 310 324 { TIfThenElse } 311 325 … … 437 451 SYes = 'Yes'; 438 452 SNo = 'No'; 453 454 { TReturn } 455 456 function TReturn.GetFieldsCount: Integer; 457 begin 458 Result := 1; 459 end; 460 461 procedure TReturn.GetValue(Index: Integer; out Value); 462 begin 463 if Index = 0 then TExpression(Value) := Expression 464 else inherited; 465 end; 466 467 function TReturn.GetField(Index: Integer): TField; 468 begin 469 if Index = 0 then Result := TField.Create(dtObject, 'Expression') 470 else inherited; 471 end; 472 473 procedure TReturn.SetValue(Index: Integer; var Value); 474 begin 475 if Index = 0 then Expression := TExpression(Value) 476 else inherited; 477 end; 478 479 constructor TReturn.Create; 480 begin 481 Expression := TExpression.Create; 482 end; 483 484 destructor TReturn.Destroy; 485 begin 486 Expression.Free; 487 inherited Destroy; 488 end; 439 489 440 490 { TField }
Note:
See TracChangeset
for help on using the changeset viewer.