Changeset 222
- Timestamp:
- Nov 25, 2020, 12:18:45 AM (4 years ago)
- Location:
- branches/interpreter2
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/interpreter2/Forms/UFormMain.lfm
r221 r222 48 48 end 49 49 object MainMenu1: TMainMenu 50 Left = 7 9051 Top = 7 5350 Left = 760 51 Top = 760 52 52 object MenuItemFile: TMenuItem 53 53 Caption = 'File' … … 99 99 Caption = 'Run' 100 100 OnExecute = ARunExecute 101 ShortCut = 120 101 102 end 102 103 object ACompile: TAction 103 104 Caption = 'Compile' 104 105 OnExecute = ACompileExecute 106 ShortCut = 16497 105 107 end 106 108 object AExit: TAction -
branches/interpreter2/Forms/UFormMain.pas
r221 r222 7 7 uses 8 8 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus, 9 ActnList, ExtCtrls, SynHighlighterPas, SynEdit, USource, UOptimizer; 9 ActnList, ExtCtrls, SynHighlighterPas, SynEdit, USource, UOptimizer, 10 UGenerator; 10 11 11 12 type … … 52 53 Prog: TProgram; 53 54 Initialized: Boolean; 55 procedure Generate(GeneratorClass: TGeneratorClass); 54 56 procedure ExecutorOutput(Text: string); 55 57 procedure InterpreterError(Pos: TPoint; Text: string); … … 90 92 procedure TFormMain.FormDestroy(Sender: TObject); 91 93 begin 92 if Assigned(Prog) then Prog.Free;94 if Assigned(Prog) then FreeAndNil(Prog); 93 95 end; 94 96 … … 99 101 DockForm(FormOutput, PanelOutput); 100 102 UpdateInterface; 103 end; 104 105 procedure TFormMain.Generate(GeneratorClass: TGeneratorClass); 106 var 107 Generator: TGenerator; 108 TargetFileName: string; 109 begin 110 Generator := GeneratorClass.Create; 111 try 112 Generator.Prog := Prog; 113 Generator.Generate; 114 FormOutput.SetText(Generator.Output); 115 TargetFileName := 'Generated' + DirectorySeparator + 116 Generator.Name + DirectorySeparator + 'Test' + Generator.FileExt; 117 ForceDirectories(ExtractFileDir(TargetFileName)); 118 FormOutput.SynEditOutput.Lines.SaveToFile(TargetFileName); 119 finally 120 Generator.Free; 121 end; 101 122 end; 102 123 … … 122 143 123 144 procedure TFormMain.AGenerateCSharpExecute(Sender: TObject); 124 var125 Generator: TGeneratorCSharp;126 145 begin 127 146 ACompile.Execute; … … 130 149 FormOutput.Clear; 131 150 if Assigned(Prog) then begin 132 Generator := TGeneratorCSharp.Create; 133 Generator.Prog := Prog; 134 Generator.Generate; 135 FormOutput.SetText(Generator.Output); 136 Generator.Free; 137 FormOutput.SynEditOutput.Lines.SaveToFile('Generated' + DirectorySeparator + 'Test.cs'); 151 Generate(TGeneratorCSharp); 138 152 end; 139 153 end; 140 154 141 155 procedure TFormMain.AGeneratePascalExecute(Sender: TObject); 142 var143 Generator: TGeneratorPascal;144 156 begin 145 157 ACompile.Execute; … … 147 159 FormOutput.SynEditOutput.Lines.Clear; 148 160 if Assigned(Prog) then begin 149 Generator := TGeneratorPascal.Create; 150 Generator.Prog := Prog; 151 Generator.Generate; 152 FormOutput.SynEditOutput.Lines.Text := Generator.Output; 153 Generator.Free; 154 FormOutput.SynEditOutput.Lines.SaveToFile('Generated' + DirectorySeparator + 'Test.pas'); 161 Generate(TGeneratorPascal); 155 162 end; 156 163 end; 157 164 158 165 procedure TFormMain.AGeneratePhpExecute(Sender: TObject); 159 var160 Generator: TGeneratorPhp;161 166 begin 162 167 ACompile.Execute; … … 165 170 FormOutput.SynEditOutput.Lines.Clear; 166 171 if Assigned(Prog) then begin 167 Generator := TGeneratorPhp.Create; 168 Generator.Prog := Prog; 169 Generator.Generate; 170 FormOutput.SynEditOutput.Lines.Text := Generator.Output; 171 Generator.Free; 172 FormOutput.SynEditOutput.Lines.SaveToFile('Generated' + DirectorySeparator + 'Test.php'); 172 Generate(TGeneratorPhp); 173 173 end; 174 174 end; 175 175 176 176 procedure TFormMain.AGenerateXmlExecute(Sender: TObject); 177 var178 Generator: TGeneratorXml;179 177 begin 180 178 ACompile.Execute; … … 182 180 FormOutput.SynEditOutput.Lines.Clear; 183 181 if Assigned(Prog) then begin 184 Generator := TGeneratorXml.Create; 185 Generator.Prog := Prog; 186 Generator.Generate; 187 FormOutput.SynEditOutput.Lines.Text := Generator.Output; 188 Generator.Free; 189 FormOutput.SynEditOutput.Lines.SaveToFile('Generated' + DirectorySeparator + 'Test.xml'); 182 Generate(TGeneratorXml); 190 183 end; 191 184 end; -
branches/interpreter2/Generators/UGeneratorCSharp.pas
r221 r222 31 31 procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation); 32 32 procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand); 33 procedure GenerateExpressionBrackets(Block: TBlock; Expression: TExpressionBrackets); 33 34 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak); 34 35 procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue); … … 37 38 procedure GenerateValue(Value: TValue); 38 39 public 39 Prog: TProgram;40 40 procedure Generate; override; 41 end; 41 constructor Create; override; 42 end; 43 42 44 43 45 implementation 46 47 const 48 ExpressionOperatorTextCSharp: array[TExpressionOperator] of string = ('', '+', 49 '-', '*', '/', '/', '%', '&', '^', '|', '<<', 50 '>>', '==', '!=', '<', '>', '<=','>=', '!'); 44 51 45 52 { TGeneratorCSharp } … … 144 151 if Expression is TExpressionOperand then 145 152 GenerateExpressionOperand(Block, TExpressionOperand(Expression)) 153 else 154 if Expression is TExpressionBrackets then 155 GenerateExpressionBrackets(Block, TExpressionBrackets(Expression)) 146 156 else raise Exception.Create('Unknown expression class.'); 147 157 end; … … 154 164 for I := 0 to Expression.Items.Count - 1 do begin 155 165 if I > 0 then begin 156 if Expression.Operation = eoAdd then AddText(' + ') 157 else if Expression.Operation = eoSub then AddText(' - ') 158 else if Expression.Operation = eoEqual then AddText(' == ') 159 else if Expression.Operation = eoNotEqual then AddText(' != '); 166 AddText(' ' + ExpressionOperatorTextCSharp[Expression.Operation] + ' '); 160 167 end; 161 168 GenerateExpression(Block, TExpression(Expression.Items[I])); … … 173 180 else raise Exception.Create('Unsupported exception operand type.'); 174 181 end; 182 end; 183 184 procedure TGeneratorCSharp.GenerateExpressionBrackets(Block: TBlock; 185 Expression: TExpressionBrackets); 186 begin 187 AddText('('); 188 GenerateExpression(Block, Expression.Expression); 189 AddText(')'); 175 190 end; 176 191 … … 233 248 234 249 procedure TGeneratorCSharp.GenerateBlock(ParentBlock: TBlock; Block: TBlock); 235 var236 I: Integer;237 250 begin 238 251 if Block.BeginEnd.Commands.Count > 0 then begin … … 353 366 end; 354 367 368 constructor TGeneratorCSharp.Create; 369 begin 370 inherited; 371 Name := 'CSharp'; 372 FileExt := '.cs'; 373 end; 374 355 375 end. 356 376 -
branches/interpreter2/Generators/UGeneratorPascal.pas
r221 r222 31 31 procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation); 32 32 procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand); 33 procedure GenerateExpressionBrackets(Block: TBlock; Expression: TExpressionBrackets); 33 34 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak); 34 35 procedure GenerateContinue(Block: TBlock; ContinueCmd: TContinue); 35 36 procedure GenerateValue(Value: TValue); 36 37 public 37 Prog: TProgram;38 38 procedure Generate; override; 39 constructor Create; override; 39 40 end; 40 41 … … 134 135 if Expression is TExpressionOperand then 135 136 GenerateExpressionOperand(Block, TExpressionOperand(Expression)) 137 else 138 if Expression is TExpressionBrackets then 139 GenerateExpressionBrackets(Block, TExpressionBrackets(Expression)) 136 140 else raise Exception.Create('Unknown expression class.'); 137 141 end; … … 145 149 if I > 0 then begin 146 150 AddText(' '); 147 if Expression.Operation = eoAdd then AddText('+') 148 else if Expression.Operation = eoSub then AddText('-') 149 else if Expression.Operation = eoEqual then AddText('=') 150 else if Expression.Operation = eoNotEqual then AddText('<>'); 151 AddText(ExpressionOperatorText[Expression.Operation]); 151 152 AddText(' '); 152 153 end; … … 165 166 else raise Exception.Create('Unsupported exception operand type.'); 166 167 end; 168 end; 169 170 procedure TGeneratorPascal.GenerateExpressionBrackets(Block: TBlock; 171 Expression: TExpressionBrackets); 172 begin 173 AddText('('); 174 GenerateExpression(Block, Expression.Expression); 175 AddText(')'); 167 176 end; 168 177 … … 313 322 end; 314 323 324 constructor TGeneratorPascal.Create; 325 begin 326 inherited; 327 Name := 'Pascal'; 328 FileExt := '.pas'; 329 end; 330 315 331 end. 316 332 -
branches/interpreter2/Generators/UGeneratorPhp.pas
r221 r222 30 30 procedure GenerateExpressionOperation(Block: TBlock; Expression: TExpressionOperation); 31 31 procedure GenerateExpressionOperand(Block: TBlock; Expression: TExpressionOperand); 32 procedure GenerateExpressionBrackets(Block: TBlock; Expression: TExpressionBrackets); 32 33 procedure GenerateBreak(Block: TBlock; BreakCmd: TBreak); 33 34 procedure GenerateReturn(Block: TBlock; Return: TReturn); … … 35 36 procedure GenerateValue(Value: TValue); 36 37 public 37 Prog: TProgram;38 38 procedure Generate; override; 39 end; 39 constructor Create; override; 40 end; 41 40 42 41 43 implementation 44 45 const 46 ExpressionOperatorTextPhp: array[TExpressionOperator] of string = ('', '+', 47 '-', '*', '/', '/', '%', 'and', 'xor', 'or', '<<', 48 '>>', '==', '!=', '<', '>', '<=','>=', '!'); 42 49 43 50 { TGeneratorPhp } … … 142 149 if Expression is TExpressionOperand then 143 150 GenerateExpressionOperand(Block, TExpressionOperand(Expression)) 151 else 152 if Expression is TExpressionBrackets then 153 GenerateExpressionBrackets(Block, TExpressionBrackets(Expression)) 144 154 else raise Exception.Create('Unknown expression class.'); 145 155 end; … … 156 166 else AddText(' + '); 157 167 end 158 else if Expression.Operation = eoSub then AddText(' - ') 159 else if Expression.Operation = eoEqual then AddText(' == ') 160 else if Expression.Operation = eoNotEqual then AddText(' != '); 168 else AddText(' ' + ExpressionOperatorTextPhp[Expression.Operation] + ' '); 161 169 end; 162 170 GenerateExpression(Block, TExpression(Expression.Items[I])); … … 174 182 else raise Exception.Create('Unsupported exception operand type.'); 175 183 end; 184 end; 185 186 procedure TGeneratorPhp.GenerateExpressionBrackets(Block: TBlock; 187 Expression: TExpressionBrackets); 188 begin 189 AddText('('); 190 GenerateExpression(Block, Expression.Expression); 191 AddText(')'); 176 192 end; 177 193 … … 290 306 end; 291 307 308 constructor TGeneratorPhp.Create; 309 begin 310 inherited; 311 Name := 'PHP'; 312 FileExt := '.php'; 313 end; 314 292 315 end. 293 316 -
branches/interpreter2/Generators/UGeneratorXml.pas
r221 r222 16 16 procedure GenerateNode(SourceNode: TSourceNode); 17 17 public 18 Prog: TProgram;19 18 procedure Generate; override; 19 constructor Create; override; 20 20 end; 21 21 … … 73 73 end; 74 74 75 constructor TGeneratorXml.Create; 76 begin 77 inherited; 78 Name := 'XML'; 79 FileExt := '.xml'; 80 end; 81 75 82 end. 76 83 -
branches/interpreter2/Parsers/UParserPascal.pas
r221 r222 9 9 10 10 type 11 12 { TParserPascal } 13 11 14 TParserPascal = class(TParser) 12 15 protected … … 21 24 function ParseFunctionParameter(Block: TBlock; out Parameter: TFunctionParameter): Boolean; 22 25 function ParseAssignment(Block: TBlock; out Assignment: TAssignment): Boolean; 23 function ParseExpression(Block: TBlock; out Expression: TExpression): Boolean; 26 function ParseExpression(Block: TBlock; out Expression: TExpression; 27 WithOperation: Boolean = True): Boolean; 24 28 function ParseExpressionOperation(Block: TBlock; out ExpressionOperation: TExpressionOperation): Boolean; 25 29 function ParseExpressionOperand(Block: TBlock; out ExpressionOperand: TExpressionOperand): Boolean; 30 function ParseExpressionBrackets(Block: TBlock; out ExpressionBrackets: TExpressionBrackets): Boolean; 26 31 function ParseConstantRef(Block: TBlock; out ConstantRef: TConstant): Boolean; 27 32 function ParseConstant(Block: TBlock; out ConstantRef: TConstant): Boolean; … … 42 47 Command: TCommand; 43 48 begin 44 if Tokenizer.CheckNext('begin', tkKeyword) then begin 45 Tokenizer.Expect('begin', tkKeyword); 49 if Tokenizer.CheckNextAndRead('begin', tkKeyword) then begin 46 50 BeginEnd := TBeginEnd.Create; 47 51 Result := True; … … 77 81 FunctionCall := TFunctionCall.Create; 78 82 FunctionCall.FunctionDef := FunctionDef; 79 if Tokenizer.CheckNext('(', tkSpecialSymbol) then begin 80 Tokenizer.Expect('(', tkSpecialSymbol); 83 if Tokenizer.CheckNextAndRead('(', tkSpecialSymbol) then begin 81 84 for I := 0 to FunctionDef.Params.Count - 1 do begin 82 85 if I > 0 then Tokenizer.Expect(',', tkSpecialSymbol); … … 160 163 Prog.SystemBlock.Free; 161 164 Prog.SystemBlock := SystemBlock; 162 if Tokenizer.CheckNext('program', tkKeyword) then begin 163 Tokenizer.Expect('program', tkKeyword); 165 if Tokenizer.CheckNextAndRead('program', tkKeyword) then begin 164 166 Token := Tokenizer.GetNext; 165 167 if Token.Kind = tkIdentifier then … … 216 218 TypeRef: TType; 217 219 begin 218 if Tokenizer.CheckNext('var', tkKeyword) then begin 219 Result := True; 220 Tokenizer.Expect('var', tkKeyword); 220 if Tokenizer.CheckNextAndRead('var', tkKeyword) then begin 221 Result := True; 221 222 while Tokenizer.CheckNextKind(tkIdentifier) do begin 222 223 Token := Tokenizer.GetNext; … … 251 252 TypeRef: TType; 252 253 begin 253 if Tokenizer.CheckNext('const', tkKeyword) then begin 254 Result := True; 255 Tokenizer.Expect('const', tkKeyword); 254 if Tokenizer.CheckNextAndRead('const', tkKeyword) then begin 255 Result := True; 256 256 while Tokenizer.CheckNextKind(tkIdentifier) do begin 257 257 Token := Tokenizer.GetNext; … … 300 300 begin 301 301 Result := False; 302 if Tokenizer.CheckNext('function', tkKeyword) then begin 303 Tokenizer.Expect('function', tkKeyword); 302 if Tokenizer.CheckNextAndRead('function', tkKeyword) then begin 304 303 Result := True; 305 304 Func := TFunction.Create; … … 307 306 if Token.Kind = tkIdentifier then begin 308 307 Func.Name := Token.Text; 309 if Tokenizer.CheckNext('(', tkSpecialSymbol) then begin 310 Tokenizer.Expect('(', tkSpecialSymbol); 308 if Tokenizer.CheckNextAndRead('(', tkSpecialSymbol) then begin 311 309 while not Tokenizer.CheckNext(')', tkSpecialSymbol) do begin 312 310 if Func.Params.Count > 0 then Tokenizer.Expect(',', tkSpecialSymbol); … … 324 322 end; 325 323 end; 326 if Tokenizer.CheckNext(':', tkSpecialSymbol) then begin 327 Tokenizer.Expect(':', tkSpecialSymbol); 324 if Tokenizer.CheckNextAndRead(':', tkSpecialSymbol) then begin 328 325 Token := Tokenizer.GetNext; 329 326 if Token.Kind = tkIdentifier then begin … … 402 399 end; 403 400 404 function TParserPascal.ParseExpression(Block: TBlock; out Expression: TExpression 405 ): Boolean;401 function TParserPascal.ParseExpression(Block: TBlock; out Expression: TExpression; 402 WithOperation: Boolean = True): Boolean; 406 403 var 407 404 ExpressionOperation: TExpressionOperation; 408 405 ExpressionOperand: TExpressionOperand; 409 begin 410 Result := False; 411 if ParseExpressionOperation(Block, ExpressionOperation) then begin 406 ExpressionBrackets: TExpressionBrackets; 407 begin 408 Result := False; 409 if WithOperation and ParseExpressionOperation(Block, ExpressionOperation) then begin 412 410 Result := True; 413 411 Expression := ExpressionOperation; 412 end else 413 if ParseExpressionBrackets(Block, ExpressionBrackets) then begin 414 Result := True; 415 Expression := ExpressionBrackets; 414 416 end else 415 417 if ParseExpressionOperand(Block, ExpressionOperand) then begin … … 422 424 ExpressionOperation: TExpressionOperation): Boolean; 423 425 var 424 Operand: TExpressionOperand;425 Token: TToken;426 426 Expression: TExpression; 427 Token: TToken; 427 428 LastPos: TTokenizerPos; 428 429 I: Integer; … … 431 432 Result := False; 432 433 LastPos := Tokenizer.Pos; 433 if ParseExpression Operand(Block, Operand) then begin434 if ParseExpression(Block, Expression, False) then begin 434 435 Token := Tokenizer.GetNext; 435 if (Token.Kind = tkSpecialSymbol) andTokenizer.IsOperator(Token.Text) then begin436 if Tokenizer.IsOperator(Token.Text) then begin 436 437 Result := True; 437 438 ExpressionOperation := TExpressionOperation.Create; 438 ExpressionOperation.TypeRef := Operand.GetType; 439 if Token.Text = '+' then ExpressionOperation.Operation := eoAdd 440 else if Token.Text = '-' then ExpressionOperation.Operation := eoSub 441 else if Token.Text = '=' then ExpressionOperation.Operation := eoEqual 442 else if Token.Text = '<>' then ExpressionOperation.Operation := eoNotEqual 443 else Error('Unsupported operator ' + Token.Text); 439 ExpressionOperation.Items.Add(Expression); 440 ExpressionOperation.TypeRef := Expression.GetType; 441 ExpressionOperation.Operation := GetOperatorByName(Token.Text); 442 if ExpressionOperation.Operation = eoNone then 443 Error('Unsupported operator ' + Token.Text); 444 444 ExpressionOperation.FunctionRef := ExpressionOperation.TypeRef.Functions.SearchByName(ExpressionOperation.GetFunctionName); 445 if not Assigned(ExpressionOperation.FunctionRef.ResultType) then 446 raise Exception.Create('Missing result type for function'); 447 ExpressionOperation.TypeRef := ExpressionOperation.FunctionRef.ResultType; 448 ExpressionOperation.Items.Add(Operand); 449 I := 1; 450 if ParseExpression(Block, Expression) then begin 451 ExpectedType := TFunctionParameter(ExpressionOperation.FunctionRef.Params[I]).TypeRef; 452 if Expression.GetType = ExpectedType then 453 ExpressionOperation.Items.Add(Expression) 454 else Error('Expression operands needs to be same type. Expected ' + ExpectedType.Name + ' but found ' + Expression.GetType.Name); 455 end else Error('Missing operand.'); 456 end else Operand.Free; 445 if Assigned(ExpressionOperation.FunctionRef) then begin 446 if not Assigned(ExpressionOperation.FunctionRef.ResultType) then 447 raise Exception.Create('Missing result type for function'); 448 ExpressionOperation.TypeRef := ExpressionOperation.FunctionRef.ResultType; 449 I := 1; 450 if ParseExpression(Block, Expression) then begin 451 ExpectedType := TFunctionParameter(ExpressionOperation.FunctionRef.Params[I]).TypeRef; 452 if Expression.GetType = ExpectedType then 453 ExpressionOperation.Items.Add(Expression) 454 else Error('Expression operands needs to be same type. Expected ' + ExpectedType.Name + ' but found ' + Expression.GetType.Name); 455 end else Error('Missing operand.'); 456 end else Error('Operator ' + Token.Text + ' not defind for type ' + ExpressionOperation.TypeRef.Name + '.'); 457 end else Expression.Free; 457 458 end; 458 459 if not Result then Tokenizer.Pos := LastPos; … … 490 491 ExpressionOperand.VariableRef := Variable; 491 492 ExpressionOperand.OperandType := otVariableRef; 492 end else Error('Expected expression operand.'); 493 end else 494 Error('Expected expression operand.'); 495 end; 496 497 function TParserPascal.ParseExpressionBrackets(Block: TBlock; out 498 ExpressionBrackets: TExpressionBrackets): Boolean; 499 var 500 Expression: TExpression; 501 begin 502 Result := False; 503 if Tokenizer.CheckNextAndRead('(', tkSpecialSymbol) then begin 504 Result := True; 505 if ParseExpression(Block, Expression) then begin 506 ExpressionBrackets := TExpressionBrackets.Create; 507 ExpressionBrackets.Expression := Expression; 508 end; 509 Tokenizer.Expect(')', tkSpecialSymbol); 510 end; 493 511 end; 494 512 … … 562 580 begin 563 581 Result := False; 564 if Tokenizer.CheckNext('if', tkKeyword) then begin 565 Tokenizer.Expect('if', tkKeyword); 582 if Tokenizer.CheckNextAndRead('if', tkKeyword) then begin 566 583 Result := True; 567 584 IfThenElse := TIfThenElse.Create; … … 574 591 IfThenElse.CommandThen := Command; 575 592 Command.Parent := IfThenElse; 576 if Tokenizer.CheckNext('else', tkKeyword) then begin 577 Tokenizer.Expect('else', tkKeyword); 593 if Tokenizer.CheckNextAndRead('else', tkKeyword) then begin 578 594 if ParseCommand(Block, Command) then begin 579 595 IfThenElse.CommandElse.Free; … … 593 609 begin 594 610 Result := False; 595 if Tokenizer.CheckNext('while', tkKeyword) then begin 596 Tokenizer.Expect('while', tkKeyword); 611 if Tokenizer.CheckNextAndRead('while', tkKeyword) then begin 597 612 Result := True; 598 613 WhileDo := TWhileDo.Create; … … 617 632 begin 618 633 Result := False; 619 if Tokenizer.CheckNext('repeat', tkKeyword) then begin 620 Tokenizer.Expect('repeat', tkKeyword); 634 if Tokenizer.CheckNextAndRead('repeat', tkKeyword) then begin 621 635 RepeatUntil := TRepeatUntil.Create; 622 636 Result := True; … … 647 661 begin 648 662 Result := False; 649 if Tokenizer.CheckNext('for', tkKeyword) then begin 650 Tokenizer.Expect('for', tkKeyword); 663 if Tokenizer.CheckNextAndRead('for', tkKeyword) then begin 651 664 Result := True; 652 665 ForToDo := TForToDo.Create; … … 676 689 begin 677 690 Result := False; 678 if Tokenizer.CheckNext('break', tkKeyword) then begin 679 Tokenizer.Expect('break', tkKeyword); 691 if Tokenizer.CheckNextAndRead('break', tkKeyword) then begin 680 692 Result := True; 681 693 BreakCmd := TBreak.Create; … … 687 699 begin 688 700 Result := False; 689 if Tokenizer.CheckNext('continue', tkKeyword) then begin 690 Tokenizer.Expect('continue', tkKeyword); 701 if Tokenizer.CheckNextAndRead('continue', tkKeyword) then begin 691 702 Result := True; 692 703 ContinueCmd := TContinue.Create; -
branches/interpreter2/Test.pas
r214 r222 15 15 16 16 begin 17 WriteLn('10 * 3 = ' + IntToStr((1 + 2) * (3 + 4))); 18 17 19 X := 'A' + 'B'; 18 20 WriteLn(X); … … 20 22 B := IntToStr(C); 21 23 A := B; 22 24 23 25 // If-Then-Else 24 26 if A = '2' then begin -
branches/interpreter2/UExecutor.pas
r221 r222 92 92 function ExecuteStrToInt(Params: array of TValue): TValue; 93 93 function ExecuteBooleanAssign(Params: array of TValue): TValue; 94 function ExecuteBooleanNot(Params: array of TValue): TValue; 94 95 function ExecuteBooleanEqual(Params: array of TValue): TValue; 95 96 function ExecuteBooleanNotEqual(Params: array of TValue): TValue; … … 101 102 function ExecuteIntegerAdd(Params: array of TValue): TValue; 102 103 function ExecuteIntegerSub(Params: array of TValue): TValue; 104 function ExecuteIntegerMul(Params: array of TValue): TValue; 105 function ExecuteIntegerIntDiv(Params: array of TValue): TValue; 106 function ExecuteIntegerMod(Params: array of TValue): TValue; 103 107 function ExecuteIntegerEqual(Params: array of TValue): TValue; 104 108 function ExecuteIntegerNotEqual(Params: array of TValue): TValue; 109 function ExecuteIntegerLesser(Params: array of TValue): TValue; 110 function ExecuteIntegerHigher(Params: array of TValue): TValue; 111 function ExecuteIntegerLesserOrEqual(Params: array of TValue): TValue; 112 function ExecuteIntegerHigherOrEqual(Params: array of TValue): TValue; 113 function ExecuteIntegerAnd(Params: array of TValue): TValue; 114 function ExecuteIntegerOr(Params: array of TValue): TValue; 115 function ExecuteIntegerXor(Params: array of TValue): TValue; 116 function ExecuteIntegerShr(Params: array of TValue): TValue; 117 function ExecuteIntegerShl(Params: array of TValue): TValue; 105 118 procedure InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock); 106 119 public … … 121 134 function ExecuteExpressionOperation(Block: TExecutorBlock; Expression: TExpressionOperation): TValue; 122 135 function ExecuteExpressionOperand(Block: TExecutorBlock; Expression: TExpressionOperand): TValue; 136 function ExecuteExpressionBrackets(Block: TExecutorBlock; Expression: TExpressionBrackets): TValue; 123 137 procedure Run; 124 138 procedure Output(Text: string); … … 323 337 end; 324 338 339 function TExecutor.ExecuteBooleanNot(Params: array of TValue): TValue; 340 begin 341 Result := TValueBoolean.Create; 342 TValueBoolean(Result).Value := not TValueBoolean(Params[0]).Value; 343 end; 344 325 345 function TExecutor.ExecuteBooleanEqual(Params: array of TValue): TValue; 326 346 begin … … 377 397 end; 378 398 399 function TExecutor.ExecuteIntegerMul(Params: array of TValue): TValue; 400 begin 401 Result := TValueInteger.Create; 402 TValueInteger(Result).Value := TValueInteger(Params[0]).Value * TValueInteger(Params[1]).Value; 403 end; 404 405 function TExecutor.ExecuteIntegerIntDiv(Params: array of TValue): TValue; 406 begin 407 Result := TValueInteger.Create; 408 TValueInteger(Result).Value := TValueInteger(Params[0]).Value div TValueInteger(Params[1]).Value; 409 end; 410 411 function TExecutor.ExecuteIntegerMod(Params: array of TValue): TValue; 412 begin 413 Result := TValueInteger.Create; 414 TValueInteger(Result).Value := TValueInteger(Params[0]).Value mod TValueInteger(Params[1]).Value; 415 end; 416 379 417 function TExecutor.ExecuteIntegerEqual(Params: array of TValue): TValue; 380 418 begin … … 387 425 Result := TValueBoolean.Create; 388 426 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value <> TValueInteger(Params[1]).Value; 427 end; 428 429 function TExecutor.ExecuteIntegerLesser(Params: array of TValue): TValue; 430 begin 431 Result := TValueBoolean.Create; 432 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value < TValueInteger(Params[1]).Value; 433 end; 434 435 function TExecutor.ExecuteIntegerHigher(Params: array of TValue): TValue; 436 begin 437 Result := TValueBoolean.Create; 438 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value > TValueInteger(Params[1]).Value; 439 end; 440 441 function TExecutor.ExecuteIntegerLesserOrEqual(Params: array of TValue): TValue; 442 begin 443 Result := TValueBoolean.Create; 444 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value <= TValueInteger(Params[1]).Value; 445 end; 446 447 function TExecutor.ExecuteIntegerHigherOrEqual(Params: array of TValue): TValue; 448 begin 449 Result := TValueBoolean.Create; 450 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value >= TValueInteger(Params[1]).Value; 451 end; 452 453 function TExecutor.ExecuteIntegerAnd(Params: array of TValue): TValue; 454 begin 455 Result := TValueInteger.Create; 456 TValueInteger(Result).Value := TValueInteger(Params[0]).Value and TValueInteger(Params[1]).Value; 457 end; 458 459 function TExecutor.ExecuteIntegerOr(Params: array of TValue): TValue; 460 begin 461 Result := TValueInteger.Create; 462 TValueInteger(Result).Value := TValueInteger(Params[0]).Value or TValueInteger(Params[1]).Value; 463 end; 464 465 function TExecutor.ExecuteIntegerXor(Params: array of TValue): TValue; 466 begin 467 Result := TValueInteger.Create; 468 TValueInteger(Result).Value := TValueInteger(Params[0]).Value xor TValueInteger(Params[1]).Value; 469 end; 470 471 function TExecutor.ExecuteIntegerShr(Params: array of TValue): TValue; 472 begin 473 Result := TValueInteger.Create; 474 TValueInteger(Result).Value := TValueInteger(Params[0]).Value shr TValueInteger(Params[1]).Value; 475 end; 476 477 function TExecutor.ExecuteIntegerShl(Params: array of TValue): TValue; 478 begin 479 Result := TValueInteger.Create; 480 TValueInteger(Result).Value := TValueInteger(Params[0]).Value shl TValueInteger(Params[1]).Value; 389 481 end; 390 482 … … 410 502 ExecutorFunction.Callback := ExecuteBooleanNotEqual; 411 503 end; 504 if ExecutorFunction.FunctionDef.Name = '_Not' then begin 505 ExecutorFunction.Callback := ExecuteBooleanNot; 506 end else 412 507 end else 413 508 if ExecutorType.TypeRef.Name = 'string' then begin … … 435 530 ExecutorFunction.Callback := ExecuteIntegerSub; 436 531 end else 532 if ExecutorFunction.FunctionDef.Name = '_Mul' then begin 533 ExecutorFunction.Callback := ExecuteIntegerMul; 534 end else 535 if ExecutorFunction.FunctionDef.Name = '_IntDiv' then begin 536 ExecutorFunction.Callback := ExecuteIntegerIntDiv; 537 end else 538 if ExecutorFunction.FunctionDef.Name = '_IntMod' then begin 539 ExecutorFunction.Callback := ExecuteIntegerMod; 540 end else 437 541 if ExecutorFunction.FunctionDef.Name = '_Equal' then begin 438 542 ExecutorFunction.Callback := ExecuteIntegerEqual; … … 440 544 if ExecutorFunction.FunctionDef.Name = '_NotEqual' then begin 441 545 ExecutorFunction.Callback := ExecuteIntegerNotEqual; 546 end; 547 if ExecutorFunction.FunctionDef.Name = '_Lesser' then begin 548 ExecutorFunction.Callback := ExecuteIntegerLesser; 549 end else 550 if ExecutorFunction.FunctionDef.Name = '_Higher' then begin 551 ExecutorFunction.Callback := ExecuteIntegerHigher; 552 end; 553 if ExecutorFunction.FunctionDef.Name = '_LesserOrEqual' then begin 554 ExecutorFunction.Callback := ExecuteIntegerLesserOrEqual; 555 end else 556 if ExecutorFunction.FunctionDef.Name = '_HigherOrEqual' then begin 557 ExecutorFunction.Callback := ExecuteIntegerHigherOrEqual; 558 end; 559 if ExecutorFunction.FunctionDef.Name = '_And' then begin 560 ExecutorFunction.Callback := ExecuteIntegerAnd; 561 end; 562 if ExecutorFunction.FunctionDef.Name = '_Or' then begin 563 ExecutorFunction.Callback := ExecuteIntegerOr; 564 end; 565 if ExecutorFunction.FunctionDef.Name = '_Xor' then begin 566 ExecutorFunction.Callback := ExecuteIntegerXor; 567 end; 568 if ExecutorFunction.FunctionDef.Name = '_Shr' then begin 569 ExecutorFunction.Callback := ExecuteIntegerShr; 570 end; 571 if ExecutorFunction.FunctionDef.Name = '_Shl' then begin 572 ExecutorFunction.Callback := ExecuteIntegerShl; 442 573 end; 443 574 end; … … 692 823 if Expression is TExpressionOperand then 693 824 Result := ExecuteExpressionOperand(Block, TExpressionOperand(Expression)) 694 else raise Exception.Create('Unknown expression class.'); 825 else 826 if Expression is TExpressionBrackets then 827 Result := ExecuteExpressionBrackets(Block, TExpressionBrackets(Expression)) 828 else 829 raise Exception.Create('Unknown expression class.'); 695 830 end; 696 831 … … 733 868 end; 734 869 870 function TExecutor.ExecuteExpressionBrackets(Block: TExecutorBlock; 871 Expression: TExpressionBrackets): TValue; 872 begin 873 Result := ExecuteExpression(Block, Expression.Expression); 874 end; 875 735 876 procedure TExecutor.Run; 736 877 begin -
branches/interpreter2/UGenerator.pas
r208 r222 6 6 7 7 uses 8 Classes, SysUtils, strutils ;8 Classes, SysUtils, strutils, USource; 9 9 10 10 type … … 17 17 procedure SetIndent(AValue: Integer); 18 18 public 19 Name: string; 20 FileExt: string; 19 21 Output: string; 22 Prog: TProgram; 20 23 procedure AddText(Text: string); 21 24 procedure AddTextLine(Text: string = ''); 22 25 procedure Generate; virtual; 26 constructor Create; virtual; 27 destructor Destroy; override; 23 28 property Indent: Integer read FIndent write SetIndent; 24 29 end; 30 31 TGeneratorClass = class of TGenerator; 25 32 26 33 … … 59 66 end; 60 67 68 constructor TGenerator.Create; 69 begin 70 end; 71 72 destructor TGenerator.Destroy; 73 begin 74 inherited; 75 end; 76 61 77 end. 62 78 -
branches/interpreter2/UParser.pas
r221 r222 6 6 7 7 uses 8 Classes, SysUtils, Contnrs,UTokenizer, USource;8 Classes, SysUtils, UTokenizer, USource; 9 9 10 10 type … … 59 59 ResultType := TypeBoolean; 60 60 end; 61 with Functions.AddNew('_NotEqual') do begin 62 Params.AddNew('A', TypeBoolean); 63 Params.AddNew('B', TypeBoolean); 64 ResultType := TypeBoolean; 65 end; 66 with Functions.AddNew('_Not') do begin 67 Params.AddNew('A', TypeBoolean); 68 ResultType := TypeBoolean; 69 end; 61 70 end; 62 71 TypeString := Block.Types.AddNew('string'); … … 100 109 ResultType := TypeInteger; 101 110 end; 111 with Functions.AddNew('_Mul') do begin 112 Params.AddNew('A', TypeInteger); 113 Params.AddNew('B', TypeInteger); 114 ResultType := TypeInteger; 115 end; 116 with Functions.AddNew('_IntDiv') do begin 117 Params.AddNew('A', TypeInteger); 118 Params.AddNew('B', TypeInteger); 119 ResultType := TypeInteger; 120 end; 121 with Functions.AddNew('_Mod') do begin 122 Params.AddNew('A', TypeInteger); 123 Params.AddNew('B', TypeInteger); 124 ResultType := TypeInteger; 125 end; 102 126 with Functions.AddNew('_Equal') do begin 103 127 Params.AddNew('A', TypeInteger); … … 109 133 Params.AddNew('B', TypeInteger); 110 134 ResultType := TypeBoolean; 135 end; 136 with Functions.AddNew('_Lesser') do begin 137 Params.AddNew('A', TypeInteger); 138 Params.AddNew('B', TypeInteger); 139 ResultType := TypeBoolean; 140 end; 141 with Functions.AddNew('_Higher') do begin 142 Params.AddNew('A', TypeInteger); 143 Params.AddNew('B', TypeInteger); 144 ResultType := TypeBoolean; 145 end; 146 with Functions.AddNew('_LesserOrEqual') do begin 147 Params.AddNew('A', TypeInteger); 148 Params.AddNew('B', TypeInteger); 149 ResultType := TypeBoolean; 150 end; 151 with Functions.AddNew('_HigherOrEqual') do begin 152 Params.AddNew('A', TypeInteger); 153 Params.AddNew('B', TypeInteger); 154 ResultType := TypeBoolean; 155 end; 156 with Functions.AddNew('_Shr') do begin 157 Params.AddNew('A', TypeInteger); 158 Params.AddNew('B', TypeInteger); 159 ResultType := TypeInteger; 160 end; 161 with Functions.AddNew('_Shl') do begin 162 Params.AddNew('A', TypeInteger); 163 Params.AddNew('B', TypeInteger); 164 ResultType := TypeInteger; 165 end; 166 with Functions.AddNew('_And') do begin 167 Params.AddNew('A', TypeInteger); 168 Params.AddNew('B', TypeInteger); 169 ResultType := TypeInteger; 170 end; 171 with Functions.AddNew('_Or') do begin 172 Params.AddNew('A', TypeInteger); 173 Params.AddNew('B', TypeInteger); 174 ResultType := TypeInteger; 175 end; 176 with Functions.AddNew('_Xor') do begin 177 Params.AddNew('A', TypeInteger); 178 Params.AddNew('B', TypeInteger); 179 ResultType := TypeInteger; 111 180 end; 112 181 end; … … 133 202 function TParser.ParseProgram(SystemBlock: TBlock; out Prog: TProgram): Boolean; 134 203 begin 204 Result := False; 135 205 end; 136 206 -
branches/interpreter2/USource.pas
r221 r222 242 242 end; 243 243 244 TExpressionOperator = (eoAdd, eoSub, eoMultiply, eoDivide, eoModulo, eoAnd, eoXor, 245 eoOr, eoShl, eoShr, eoEqual, eoNotEqual); 244 TExpressionOperator = (eoNone, eoAdd, eoSub, eoMultiply, eoDivide, eoIntDivide, 245 eoModulo, eoAnd, eoXor, eoOr, eoShl, eoShr, eoEqual, eoNotEqual, eoLesser, 246 eoHigher, eoLesserOrEqual, eoHigherOrEqual, eoNot); 246 247 247 248 { TExpression } … … 270 271 end; 271 272 272 TExpressionOperandType = (otVariableRef, otConstantRef, otConstantDirect, otFunctionCall); 273 TExpressionOperandType = (otVariableRef, otConstantRef, otConstantDirect, 274 otFunctionCall); 273 275 274 276 { TExpressionOperand } … … 288 290 function GetType: TType; override; 289 291 constructor Create; 292 destructor Destroy; override; 293 end; 294 295 { TExpressionBrackets } 296 297 TExpressionBrackets = class(TExpression) 298 Expression: TExpression; 299 procedure GetValue(Index: Integer; out Value); override; 300 function GetField(Index: Integer): TField; override; 301 procedure SetValue(Index: Integer; var Value); override; 302 function GetType: TType; override; 290 303 destructor Destroy; override; 291 304 end; … … 442 455 'Integer', 'Float', 'Color', 'Time', 'Date', 'DateTime', 'Enumeration', 443 456 'Reference'); 457 ExpressionOperatorText: array[TExpressionOperator] of string = ('', '+', 458 '-', '*', '/', 'div', 'mod', 'and', 'xor', 'or', 'shl', 459 'shr', '=', '<>', '<', '>', '<=','>=', 'not'); 460 ExpressionOperatorFuncText: array[TExpressionOperator] of string = ('', '_Add', 461 '_Sub', '_Mul', '_Div', '_IntDiv', '_Mod', '_And', '_Xor', '_Or', '_Shl', 462 '_Shr', '_Equal', '_NotEqual', '_Lesser', '_Higher', '_LesserOrEqual', 463 '_HigherOrEqual', '_Not'); 464 465 function GetOperatorByName(Name: string): TExpressionOperator; 444 466 445 467 … … 452 474 SYes = 'Yes'; 453 475 SNo = 'No'; 476 477 function GetOperatorByName(Name: string): TExpressionOperator; 478 var 479 I: TExpressionOperator; 480 begin 481 Result := eoNone; 482 for I := Succ(Low(TExpressionOperator)) to High(TExpressionOperator) do begin 483 if ExpressionOperatorText[I] = Name then begin 484 Result := I; 485 Break; 486 end; 487 end; 488 end; 489 490 { TExpressionBrackets } 491 492 procedure TExpressionBrackets.GetValue(Index: Integer; out Value); 493 begin 494 if Index = 0 then begin 495 TExpression(Value) := Expression; 496 end 497 else inherited; 498 end; 499 500 function TExpressionBrackets.GetField(Index: Integer): TField; 501 begin 502 if Index = 0 then Result := TField.Create(dtObject, 'Expression') 503 else inherited; 504 end; 505 506 procedure TExpressionBrackets.SetValue(Index: Integer; var Value); 507 begin 508 if Index = 0 then begin 509 Expression := TExpression(Value); 510 end 511 else inherited; 512 end; 513 514 function TExpressionBrackets.GetType: TType; 515 begin 516 Result := Expression.GetType; 517 end; 518 519 destructor TExpressionBrackets.Destroy; 520 begin 521 FreeAndNil(Expression); 522 inherited; 523 end; 454 524 455 525 { TReturn } … … 1017 1087 function TExpressionOperation.GetFunctionName: string; 1018 1088 begin 1019 if Operation = eoAdd then Result := '_Add' 1020 else if Operation = eoSub then Result := '_Sub' 1021 else if Operation = eoEqual then Result := '_Equal' 1022 else if Operation = eoNotEqual then Result := '_NotEqual' 1023 else raise Exception.Create('Unsupported operation type.'); 1089 Result := ExpressionOperatorFuncText[Operation]; 1024 1090 end; 1025 1091 -
branches/interpreter2/UTokenizer.pas
r212 r222 53 53 function GetNext: TToken; 54 54 function CheckNext(Text: string; Kind: TTokenKind): Boolean; 55 function CheckNextAndRead(Text: string; Kind: TTokenKind): Boolean; 55 56 function CheckNextKind(Kind: TTokenKind): Boolean; 57 function CheckNextKindAndRead(Kind: TTokenKind): Boolean; 56 58 procedure Expect(Text: string; Kind: TTokenKind); 57 59 procedure Error(Text: string); … … 111 113 Result := (C = ';') or (C = '.') or (C = '(') or (C = ')') or (C = '=') or 112 114 (C = ':') or (C = '+') or (C = '-') or (C = ',') or (C = '/') or 113 (C = '<') or (C = '>') ;115 (C = '<') or (C = '>') or (C = '*'); 114 116 end; 115 117 116 118 function TTokenizer.IsSpecialSymbol2(Text: string): Boolean; 117 119 begin 118 Result := (Text = ':=') or (Text = '//') or (Text = '<>'); 120 Result := (Text = ':=') or (Text = '//') or (Text = '<>') or (Text = '<=') or 121 (Text = '>='); 119 122 end; 120 123 … … 141 144 function TTokenizer.IsOperator(Text: string): Boolean; 142 145 begin 143 Result := (Text = '+') or (Text = '-') or (Text = '=') or (Text = '<>'); 146 Result := (Text = '+') or (Text = '-') or (Text = '=') or (Text = '<>') or 147 (Text = '*') or (Text = '/') or (Text = 'div') or (Text = '<=') or 148 (Text = '>=') or (Text = 'mod') or (Text = 'shl') or (Text = 'shr') or 149 (Text = 'and') or (Text = 'or') or (Text = 'xor') or (Text = 'not') or 150 (Text = '>') or (Text = '<'); 144 151 end; 145 152 … … 270 277 end; 271 278 279 function TTokenizer.CheckNextAndRead(Text: string; Kind: TTokenKind): Boolean; 280 var 281 LastPos: TTokenizerPos; 282 Token: TToken; 283 begin 284 LastPos := Pos; 285 Token := GetNext; 286 Result := (Token.Text = Text) and (Token.Kind = Kind); 287 if not Result then Pos := LastPos; 288 end; 289 272 290 function TTokenizer.CheckNextKind(Kind: TTokenKind): Boolean; 273 291 var … … 281 299 end; 282 300 301 function TTokenizer.CheckNextKindAndRead(Kind: TTokenKind): Boolean; 302 var 303 LastPos: TTokenizerPos; 304 Token: TToken; 305 begin 306 LastPos := Pos; 307 Token := GetNext; 308 Result := Token.Kind = Kind; 309 if not Result then Pos := LastPos; 310 end; 311 283 312 procedure TTokenizer.Expect(Text: string; Kind: TTokenKind); 284 313 var
Note:
See TracChangeset
for help on using the changeset viewer.