Changeset 236
- Timestamp:
- Jun 29, 2023, 1:47:58 AM (17 months ago)
- Location:
- branches/xpascal
- Files:
-
- 7 edited
-
Examples/Example.pas (modified) (2 diffs)
-
Executor.pas (modified) (49 diffs)
-
Generators/GeneratorPascal.pas (modified) (4 diffs)
-
Parser.pas (modified) (2 diffs)
-
Parsers/ParserPascal.pas (modified) (3 diffs)
-
Source.pas (modified) (4 diffs)
-
Tests.pas (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/xpascal/Examples/Example.pas
r233 r236 17 17 begin 18 18 WriteLn(Text); 19 end; 20 21 procedure SetText(var Text: string, NewText: string); 22 begin 23 Text := NewText; 19 24 end; 20 25 … … 72 77 WriteLn(A); 73 78 79 SetText(A, 'New text'); 80 WriteLn('New text: ' + A); 81 74 82 WriteLn('What is your name?'); 75 83 ReadLn(A); -
branches/xpascal/Executor.pas
r235 r236 10 10 TExecutorBlock = class; 11 11 12 TExecutorVariableKind = (vkNormal, vkReference); 13 12 14 { TExecutorVariable } 13 15 14 16 TExecutorVariable = class 17 private 18 FValue: TValue; 19 function GetValue: TValue; 20 procedure SetValue(AValue: TValue); 21 public 15 22 Variable: TVariable; 16 Value: TValue; 23 Kind: TExecutorVariableKind; 24 RefVariable: TExecutorVariable; 17 25 constructor Create; 18 26 destructor Destroy; override; 27 property Value: TValue read GetValue write SetValue; 19 28 end; 20 29 … … 42 51 end; 43 52 44 { TExecutorFunctionCallbackParam } 45 46 TExecutorFunctionCallbackParam = class 47 Kind: TFunctionParamKind; 48 Variable: TExecutorVariable; 49 Value: TValue; 50 destructor Destroy; override; 51 end; 52 53 TExecutorFunctionCallback = function(Params: array of TExecutorFunctionCallbackParam): 53 TExecutorFunctionCallback = function(Params: array of TExecutorVariable): 54 54 TValue of object; 55 55 … … 116 116 FOnInput: TInputEvent; 117 117 SystemBlock: TExecutorBlock; 118 function ExecuteWriteLn(Params: array of TExecutor FunctionCallbackParam): TValue;119 function ExecuteWrite(Params: array of TExecutor FunctionCallbackParam): TValue;120 function ExecuteReadLn(Params: array of TExecutor FunctionCallbackParam): TValue;121 function ExecuteRead(Params: array of TExecutor FunctionCallbackParam): TValue;122 function ExecuteIntToStr(Params: array of TExecutor FunctionCallbackParam): TValue;123 function ExecuteStrToInt(Params: array of TExecutor FunctionCallbackParam): TValue;124 function ExecuteBoolToStr(Params: array of TExecutor FunctionCallbackParam): TValue;125 function ExecuteStrToBool(Params: array of TExecutor FunctionCallbackParam): TValue;126 function ExecuteBooleanAssign(Params: array of TExecutor FunctionCallbackParam): TValue;127 function ExecuteBooleanNot(Params: array of TExecutor FunctionCallbackParam): TValue;128 function ExecuteBooleanEqual(Params: array of TExecutor FunctionCallbackParam): TValue;129 function ExecuteBooleanNotEqual(Params: array of TExecutor FunctionCallbackParam): TValue;130 function ExecuteStringAssign(Params: array of TExecutor FunctionCallbackParam): TValue;131 function ExecuteStringAdd(Params: array of TExecutor FunctionCallbackParam): TValue;132 function ExecuteStringEqual(Params: array of TExecutor FunctionCallbackParam): TValue;133 function ExecuteStringNotEqual(Params: array of TExecutor FunctionCallbackParam): TValue;134 function ExecuteIntegerAssign(Params: array of TExecutor FunctionCallbackParam): TValue;135 function ExecuteIntegerAdd(Params: array of TExecutor FunctionCallbackParam): TValue;136 function ExecuteIntegerSub(Params: array of TExecutor FunctionCallbackParam): TValue;137 function ExecuteIntegerMul(Params: array of TExecutor FunctionCallbackParam): TValue;138 function ExecuteIntegerIntDiv(Params: array of TExecutor FunctionCallbackParam): TValue;139 function ExecuteIntegerMod(Params: array of TExecutor FunctionCallbackParam): TValue;140 function ExecuteIntegerEqual(Params: array of TExecutor FunctionCallbackParam): TValue;141 function ExecuteIntegerNotEqual(Params: array of TExecutor FunctionCallbackParam): TValue;142 function ExecuteIntegerLesser(Params: array of TExecutor FunctionCallbackParam): TValue;143 function ExecuteIntegerHigher(Params: array of TExecutor FunctionCallbackParam): TValue;144 function ExecuteIntegerLesserOrEqual(Params: array of TExecutor FunctionCallbackParam): TValue;145 function ExecuteIntegerHigherOrEqual(Params: array of TExecutor FunctionCallbackParam): TValue;146 function ExecuteIntegerAnd(Params: array of TExecutor FunctionCallbackParam): TValue;147 function ExecuteIntegerOr(Params: array of TExecutor FunctionCallbackParam): TValue;148 function ExecuteIntegerXor(Params: array of TExecutor FunctionCallbackParam): TValue;149 function ExecuteIntegerShr(Params: array of TExecutor FunctionCallbackParam): TValue;150 function ExecuteIntegerShl(Params: array of TExecutor FunctionCallbackParam): TValue;118 function ExecuteWriteLn(Params: array of TExecutorVariable): TValue; 119 function ExecuteWrite(Params: array of TExecutorVariable): TValue; 120 function ExecuteReadLn(Params: array of TExecutorVariable): TValue; 121 function ExecuteRead(Params: array of TExecutorVariable): TValue; 122 function ExecuteIntToStr(Params: array of TExecutorVariable): TValue; 123 function ExecuteStrToInt(Params: array of TExecutorVariable): TValue; 124 function ExecuteBoolToStr(Params: array of TExecutorVariable): TValue; 125 function ExecuteStrToBool(Params: array of TExecutorVariable): TValue; 126 function ExecuteBooleanAssign(Params: array of TExecutorVariable): TValue; 127 function ExecuteBooleanNot(Params: array of TExecutorVariable): TValue; 128 function ExecuteBooleanEqual(Params: array of TExecutorVariable): TValue; 129 function ExecuteBooleanNotEqual(Params: array of TExecutorVariable): TValue; 130 function ExecuteStringAssign(Params: array of TExecutorVariable): TValue; 131 function ExecuteStringAdd(Params: array of TExecutorVariable): TValue; 132 function ExecuteStringEqual(Params: array of TExecutorVariable): TValue; 133 function ExecuteStringNotEqual(Params: array of TExecutorVariable): TValue; 134 function ExecuteIntegerAssign(Params: array of TExecutorVariable): TValue; 135 function ExecuteIntegerAdd(Params: array of TExecutorVariable): TValue; 136 function ExecuteIntegerSub(Params: array of TExecutorVariable): TValue; 137 function ExecuteIntegerMul(Params: array of TExecutorVariable): TValue; 138 function ExecuteIntegerIntDiv(Params: array of TExecutorVariable): TValue; 139 function ExecuteIntegerMod(Params: array of TExecutorVariable): TValue; 140 function ExecuteIntegerEqual(Params: array of TExecutorVariable): TValue; 141 function ExecuteIntegerNotEqual(Params: array of TExecutorVariable): TValue; 142 function ExecuteIntegerLesser(Params: array of TExecutorVariable): TValue; 143 function ExecuteIntegerHigher(Params: array of TExecutorVariable): TValue; 144 function ExecuteIntegerLesserOrEqual(Params: array of TExecutorVariable): TValue; 145 function ExecuteIntegerHigherOrEqual(Params: array of TExecutorVariable): TValue; 146 function ExecuteIntegerAnd(Params: array of TExecutorVariable): TValue; 147 function ExecuteIntegerOr(Params: array of TExecutorVariable): TValue; 148 function ExecuteIntegerXor(Params: array of TExecutorVariable): TValue; 149 function ExecuteIntegerShr(Params: array of TExecutorVariable): TValue; 150 function ExecuteIntegerShl(Params: array of TExecutorVariable): TValue; 151 151 procedure InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock); 152 152 public … … 221 221 end; 222 222 223 { TExecutorFunctionCallbackParam }224 225 destructor TExecutorFunctionCallbackParam.Destroy;226 begin227 FreeAndNil(Value);228 inherited;229 end;230 231 223 { TExecutorFunction } 232 224 … … 244 236 { TExecutorVariable } 245 237 238 procedure TExecutorVariable.SetValue(AValue: TValue); 239 begin 240 if FValue = AValue then Exit; 241 if Kind = vkNormal then begin 242 FreeAndNil(FValue); 243 FValue := AValue; 244 end else 245 if Kind = vkReference then begin 246 RefVariable.Value := AValue; 247 end; 248 end; 249 250 function TExecutorVariable.GetValue: TValue; 251 begin 252 if Kind = vkNormal then begin 253 Result := FValue; 254 end else 255 if Kind = vkReference then begin 256 Result := RefVariable.Value; 257 end; 258 end; 259 246 260 constructor TExecutorVariable.Create; 247 261 begin … … 251 265 destructor TExecutorVariable.Destroy; 252 266 begin 253 FreeAndNil( Value);267 FreeAndNil(FValue); 254 268 inherited; 255 269 end; … … 391 405 { TExecutor } 392 406 393 function TExecutor.ExecuteWriteLn(Params: array of TExecutor FunctionCallbackParam): TValue;407 function TExecutor.ExecuteWriteLn(Params: array of TExecutorVariable): TValue; 394 408 var 395 409 I: Integer; … … 403 417 end; 404 418 405 function TExecutor.ExecuteWrite(Params: array of TExecutor FunctionCallbackParam): TValue;419 function TExecutor.ExecuteWrite(Params: array of TExecutorVariable): TValue; 406 420 var 407 421 I: Integer; … … 415 429 end; 416 430 417 function TExecutor.ExecuteReadLn(Params: array of TExecutor FunctionCallbackParam): TValue;431 function TExecutor.ExecuteReadLn(Params: array of TExecutorVariable): TValue; 418 432 var 419 433 I: Integer; 420 434 begin 421 435 Result := nil; 422 for I := 0 to Length(Params) - 1 do 423 TValueString(Params[I].Variable.Value).Value := Input; 436 for I := 0 to Length(Params) - 1 do begin 437 TValueString(Params[I].Value).Value := Input; 438 end; 424 439 Output(LineEnding); 425 440 end; 426 441 427 function TExecutor.ExecuteRead(Params: array of TExecutor FunctionCallbackParam): TValue;442 function TExecutor.ExecuteRead(Params: array of TExecutorVariable): TValue; 428 443 var 429 444 I: Integer; … … 434 449 end; 435 450 436 function TExecutor.ExecuteIntToStr(Params: array of TExecutor FunctionCallbackParam): TValue;451 function TExecutor.ExecuteIntToStr(Params: array of TExecutorVariable): TValue; 437 452 begin 438 453 Result := TValueString.Create; … … 440 455 end; 441 456 442 function TExecutor.ExecuteStrToInt(Params: array of TExecutor FunctionCallbackParam): TValue;457 function TExecutor.ExecuteStrToInt(Params: array of TExecutorVariable): TValue; 443 458 begin 444 459 Result := TValueInteger.Create; … … 446 461 end; 447 462 448 function TExecutor.ExecuteBoolToStr(Params: array of TExecutor FunctionCallbackParam): TValue;463 function TExecutor.ExecuteBoolToStr(Params: array of TExecutorVariable): TValue; 449 464 begin 450 465 Result := TValueString.Create; … … 452 467 end; 453 468 454 function TExecutor.ExecuteStrToBool(Params: array of TExecutor FunctionCallbackParam): TValue;469 function TExecutor.ExecuteStrToBool(Params: array of TExecutorVariable): TValue; 455 470 begin 456 471 Result := TValueBoolean.Create; … … 458 473 end; 459 474 460 function TExecutor.ExecuteBooleanAssign(Params: array of TExecutor FunctionCallbackParam): TValue;475 function TExecutor.ExecuteBooleanAssign(Params: array of TExecutorVariable): TValue; 461 476 begin 462 477 Result := TValueBoolean.Create; … … 464 479 end; 465 480 466 function TExecutor.ExecuteBooleanNot(Params: array of TExecutor FunctionCallbackParam): TValue;481 function TExecutor.ExecuteBooleanNot(Params: array of TExecutorVariable): TValue; 467 482 begin 468 483 Result := TValueBoolean.Create; … … 470 485 end; 471 486 472 function TExecutor.ExecuteBooleanEqual(Params: array of TExecutor FunctionCallbackParam): TValue;487 function TExecutor.ExecuteBooleanEqual(Params: array of TExecutorVariable): TValue; 473 488 begin 474 489 Result := TValueBoolean.Create; … … 477 492 end; 478 493 479 function TExecutor.ExecuteBooleanNotEqual(Params: array of TExecutor FunctionCallbackParam): TValue;494 function TExecutor.ExecuteBooleanNotEqual(Params: array of TExecutorVariable): TValue; 480 495 begin 481 496 Result := TValueBoolean.Create; … … 484 499 end; 485 500 486 function TExecutor.ExecuteStringAssign(Params: array of TExecutor FunctionCallbackParam): TValue;501 function TExecutor.ExecuteStringAssign(Params: array of TExecutorVariable): TValue; 487 502 begin 488 503 Result := TValueString.Create; … … 490 505 end; 491 506 492 function TExecutor.ExecuteStringAdd(Params: array of TExecutor FunctionCallbackParam): TValue;507 function TExecutor.ExecuteStringAdd(Params: array of TExecutorVariable): TValue; 493 508 begin 494 509 Result := TValueString.Create; … … 497 512 end; 498 513 499 function TExecutor.ExecuteStringEqual(Params: array of TExecutor FunctionCallbackParam): TValue;514 function TExecutor.ExecuteStringEqual(Params: array of TExecutorVariable): TValue; 500 515 begin 501 516 Result := TValueBoolean.Create; … … 504 519 end; 505 520 506 function TExecutor.ExecuteStringNotEqual(Params: array of TExecutor FunctionCallbackParam): TValue;521 function TExecutor.ExecuteStringNotEqual(Params: array of TExecutorVariable): TValue; 507 522 begin 508 523 Result := TValueBoolean.Create; … … 511 526 end; 512 527 513 function TExecutor.ExecuteIntegerAssign(Params: array of TExecutor FunctionCallbackParam): TValue;528 function TExecutor.ExecuteIntegerAssign(Params: array of TExecutorVariable): TValue; 514 529 begin 515 530 Result := TValueInteger.Create; … … 517 532 end; 518 533 519 function TExecutor.ExecuteIntegerAdd(Params: array of TExecutor FunctionCallbackParam): TValue;534 function TExecutor.ExecuteIntegerAdd(Params: array of TExecutorVariable): TValue; 520 535 begin 521 536 Result := TValueInteger.Create; … … 524 539 end; 525 540 526 function TExecutor.ExecuteIntegerSub(Params: array of TExecutor FunctionCallbackParam): TValue;541 function TExecutor.ExecuteIntegerSub(Params: array of TExecutorVariable): TValue; 527 542 begin 528 543 Result := TValueInteger.Create; … … 531 546 end; 532 547 533 function TExecutor.ExecuteIntegerMul(Params: array of TExecutor FunctionCallbackParam): TValue;548 function TExecutor.ExecuteIntegerMul(Params: array of TExecutorVariable): TValue; 534 549 begin 535 550 Result := TValueInteger.Create; … … 538 553 end; 539 554 540 function TExecutor.ExecuteIntegerIntDiv(Params: array of TExecutor FunctionCallbackParam): TValue;555 function TExecutor.ExecuteIntegerIntDiv(Params: array of TExecutorVariable): TValue; 541 556 begin 542 557 Result := TValueInteger.Create; … … 545 560 end; 546 561 547 function TExecutor.ExecuteIntegerMod(Params: array of TExecutor FunctionCallbackParam): TValue;562 function TExecutor.ExecuteIntegerMod(Params: array of TExecutorVariable): TValue; 548 563 begin 549 564 Result := TValueInteger.Create; … … 552 567 end; 553 568 554 function TExecutor.ExecuteIntegerEqual(Params: array of TExecutor FunctionCallbackParam): TValue;569 function TExecutor.ExecuteIntegerEqual(Params: array of TExecutorVariable): TValue; 555 570 begin 556 571 Result := TValueBoolean.Create; … … 559 574 end; 560 575 561 function TExecutor.ExecuteIntegerNotEqual(Params: array of TExecutor FunctionCallbackParam): TValue;576 function TExecutor.ExecuteIntegerNotEqual(Params: array of TExecutorVariable): TValue; 562 577 begin 563 578 Result := TValueBoolean.Create; … … 566 581 end; 567 582 568 function TExecutor.ExecuteIntegerLesser(Params: array of TExecutor FunctionCallbackParam): TValue;583 function TExecutor.ExecuteIntegerLesser(Params: array of TExecutorVariable): TValue; 569 584 begin 570 585 Result := TValueBoolean.Create; … … 573 588 end; 574 589 575 function TExecutor.ExecuteIntegerHigher(Params: array of TExecutor FunctionCallbackParam): TValue;590 function TExecutor.ExecuteIntegerHigher(Params: array of TExecutorVariable): TValue; 576 591 begin 577 592 Result := TValueBoolean.Create; … … 580 595 end; 581 596 582 function TExecutor.ExecuteIntegerLesserOrEqual(Params: array of TExecutor FunctionCallbackParam): TValue;597 function TExecutor.ExecuteIntegerLesserOrEqual(Params: array of TExecutorVariable): TValue; 583 598 begin 584 599 Result := TValueBoolean.Create; … … 587 602 end; 588 603 589 function TExecutor.ExecuteIntegerHigherOrEqual(Params: array of TExecutor FunctionCallbackParam): TValue;604 function TExecutor.ExecuteIntegerHigherOrEqual(Params: array of TExecutorVariable): TValue; 590 605 begin 591 606 Result := TValueBoolean.Create; … … 594 609 end; 595 610 596 function TExecutor.ExecuteIntegerAnd(Params: array of TExecutor FunctionCallbackParam): TValue;611 function TExecutor.ExecuteIntegerAnd(Params: array of TExecutorVariable): TValue; 597 612 begin 598 613 Result := TValueInteger.Create; … … 601 616 end; 602 617 603 function TExecutor.ExecuteIntegerOr(Params: array of TExecutor FunctionCallbackParam): TValue;618 function TExecutor.ExecuteIntegerOr(Params: array of TExecutorVariable): TValue; 604 619 begin 605 620 Result := TValueInteger.Create; … … 608 623 end; 609 624 610 function TExecutor.ExecuteIntegerXor(Params: array of TExecutor FunctionCallbackParam): TValue;625 function TExecutor.ExecuteIntegerXor(Params: array of TExecutorVariable): TValue; 611 626 begin 612 627 Result := TValueInteger.Create; … … 615 630 end; 616 631 617 function TExecutor.ExecuteIntegerShr(Params: array of TExecutor FunctionCallbackParam): TValue;632 function TExecutor.ExecuteIntegerShr(Params: array of TExecutorVariable): TValue; 618 633 begin 619 634 Result := TValueInteger.Create; … … 622 637 end; 623 638 624 function TExecutor.ExecuteIntegerShl(Params: array of TExecutor FunctionCallbackParam): TValue;639 function TExecutor.ExecuteIntegerShl(Params: array of TExecutorVariable): TValue; 625 640 begin 626 641 Result := TValueInteger.Create; … … 807 822 end; 808 823 end else raise Exception.Create(SExpectedBooleanValue); 809 Value.Free;824 FreeAndNil(Value); 810 825 end; 811 826 … … 819 834 if Value is TValueBoolean then begin 820 835 BoolValue := TValueBoolean(Value).Value; 821 Value.Free;836 FreeAndNil(Value); 822 837 if not BoolValue then Break; 823 838 ExecuteCommand(Block, WhileDo.Command); … … 856 871 if Value is TValueBoolean then begin 857 872 BoolValue := TValueBoolean(Value).Value; 858 Value.Free;873 FreeAndNil(Value); 859 874 if BoolValue then Break; 860 875 end else raise Exception.Create(SExpectedBooleanValue); … … 868 883 begin 869 884 Variable := Block.GetVariable(ForToDo.VariableRef); 870 Variable.Value.Free;871 885 Variable.Value := ExecuteExpression(Block, ForToDo.ExpressionFrom); 872 886 Limit := ExecuteExpression(Block, ForToDo.ExpressionTo); … … 931 945 var 932 946 ExecutorFunction: TExecutorFunction; 933 Params: array of TExecutor FunctionCallbackParam;947 Params: array of TExecutorVariable; 934 948 I: Integer; 935 949 ExecutorVariable: TExecutorVariable; … … 939 953 ExecutorFunction := Block.GetFunction(FunctionCall.FunctionDef); 940 954 if Assigned(ExecutorFunction) then begin 955 InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block); 956 957 // Setup variables 958 for I := 0 to FunctionCall.Params.Count - 1 do begin 959 Variable := FunctionCall.FunctionDef.Block.Variables.SearchByName( 960 TFunctionParameter(FunctionCall.FunctionDef.Params[I]).Name); 961 ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(Variable); 962 if FunctionCall.FunctionDef.Params[I].Kind = pkVar then begin 963 ExecutorVariable.Kind := vkReference; 964 Variable := TExpressionOperand(FunctionCall.Params[I]).VariableRef; 965 ExecutorVariable.RefVariable := Block.Variables.SearchByVariable(Variable); 966 end else begin 967 ExecutorVariable.Kind := vkNormal; 968 ExecutorVariable.Value := ExecuteExpression(Block, TExpression(FunctionCall.Params[I])); 969 end; 970 end; 971 941 972 if FunctionCall.FunctionDef.InternalName <> '' then begin 942 973 SetLength(Params, FunctionCall.Params.Count); 943 974 for I := 0 to FunctionCall.Params.Count - 1 do begin 944 Params[I] := TExecutorFunctionCallbackParam.Create; 945 Params[I].Kind := FunctionCall.FunctionDef.Params[I].Kind; 946 if FunctionCall.FunctionDef.Params[I].Kind = pkVar then begin 947 Variable := TExpressionOperand(FunctionCall.Params[I]).VariableRef; 948 //InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block); 949 ExecutorVariable := Block.GetVariable(Variable); 950 Params[I].Variable := ExecutorVariable; 951 end 952 else Params[I].Value := ExecuteExpression(Block, FunctionCall.Params[I]); 975 Variable := FunctionCall.FunctionDef.Block.Variables.SearchByName( 976 TFunctionParameter(FunctionCall.FunctionDef.Params[I]).Name); 977 Params[I] := ExecutorFunction.Block.Variables.SearchByVariable(Variable); 953 978 end; 954 979 Result := ExecutorFunction.Callback(Params); 955 for I := 0 to FunctionCall.Params.Count - 1 do begin956 Params[I].Free;957 end;958 980 end else begin 959 InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block);960 961 // Clean variables962 for I := 0 to FunctionCall.Params.Count - 1 do begin963 if FunctionCall.FunctionDef.Params[I].Kind = pkVar then begin964 Variable := TExpressionOperand(FunctionCall.Params[I]).VariableRef;965 ExecutorVariable := Block.Variables.SearchByVariable(Variable);966 ExecutorFunction.Block.Variables[I] := ExecutorVariable;967 end else begin968 Variable := FunctionCall.FunctionDef.Block.Variables.SearchByName(969 TFunctionParameter(FunctionCall.FunctionDef.Params[I]).Name);970 ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(Variable);971 ExecutorVariable.Value.Free;972 ExecutorVariable.Value := ExecuteExpression(Block, TExpression(FunctionCall.Params[I]));973 end;974 end;975 976 981 ExecuteBlock(Block, FunctionCall.FunctionDef.Block, ExecutorFunction.Block); 977 ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(TVariable(FunctionCall.FunctionDef.Block.Variables.SearchByName('Result'))); 982 ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable( 983 TVariable(FunctionCall.FunctionDef.Block.Variables.SearchByName('Result'))); 978 984 Result := ExecutorVariable.Value.Clone; 979 985 end; … … 985 991 var 986 992 ExecutorProcedure: TExecutorProcedure; 987 Params: array of TExecutor FunctionCallbackParam;993 Params: array of TExecutorVariable; 988 994 I: Integer; 989 995 ExecutorVariable: TExecutorVariable; 990 996 Variable: TVariable; 997 ProcedureDef: TProcedure; 991 998 begin 992 999 ExecutorProcedure := Block.GetProcedure(ProcedureCall.ProcedureDef); 993 1000 if Assigned(ExecutorProcedure) then begin 1001 ProcedureDef := ProcedureCall.ProcedureDef; 1002 InitExecutorBlock(ExecutorProcedure.Block, ProcedureDef.Block); 1003 1004 for I := 0 to ProcedureCall.Params.Count - 1 do begin 1005 Variable := ProcedureCall.ProcedureDef.Block.Variables.SearchByName( 1006 TFunctionParameter(ProcedureCall.ProcedureDef.Params[I]).Name); 1007 ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(Variable); 1008 if ProcedureCall.ProcedureDef.Params[I].Kind = pkVar then begin 1009 ExecutorVariable.Kind := vkReference; 1010 Variable := TExpressionOperand(ProcedureCall.Params[I]).VariableRef; 1011 ExecutorVariable.RefVariable := Block.GetVariable(Variable); 1012 end else begin 1013 ExecutorVariable.Kind := vkNormal; 1014 ExecutorVariable.Value := ExecuteExpression(Block, TExpression(ProcedureCall.Params[I])); 1015 end; 1016 end; 1017 994 1018 if ProcedureCall.ProcedureDef.InternalName <> '' then begin 995 1019 SetLength(Params, ProcedureCall.Params.Count); 996 1020 for I := 0 to ProcedureCall.Params.Count - 1 do begin 997 Params[I] := TExecutorFunctionCallbackParam.Create; 998 Params[I].Kind := ProcedureCall.ProcedureDef.Params[I].Kind; 999 if ProcedureCall.ProcedureDef.Params[I].Kind = pkVar then begin 1000 Variable := TExpressionOperand(ProcedureCall.Params[I]).VariableRef; 1001 //InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block); 1002 ExecutorVariable := Block.GetVariable(Variable); 1003 Params[I].Variable := ExecutorVariable; 1004 end 1005 else Params[I].Value := ExecuteExpression(Block, ProcedureCall.Params[I]); 1021 Variable := ProcedureCall.ProcedureDef.Block.Variables.SearchByName( 1022 TFunctionParameter(ProcedureCall.ProcedureDef.Params[I]).Name); 1023 ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(Variable); 1024 Params[I] := ExecutorVariable; 1006 1025 end; 1026 1007 1027 ExecutorProcedure.Callback(Params); 1008 for I := 0 to ProcedureCall.Params.Count - 1 do begin1009 Params[I].Free;1010 end;1011 1028 end else begin 1012 InitExecutorBlock(ExecutorProcedure.Block, ProcedureCall.ProcedureDef.Block);1013 1014 // Clean variables1015 for I := 0 to ProcedureCall.Params.Count - 1 do begin1016 if ProcedureCall.ProcedureDef.Params[I].Kind = pkVar then begin1017 Variable := TExpressionOperand(ProcedureCall.Params[I]).VariableRef;1018 ExecutorVariable := Block.Variables.SearchByVariable(Variable);1019 ExecutorProcedure.Block.Variables[I].Variable := Variable;1020 ExecutorProcedure.Block.Variables[I].Value := ExecutorVariable.Value;1021 end else begin1022 Variable := ProcedureCall.ProcedureDef.Block.Variables.SearchByName(1023 TFunctionParameter(ProcedureCall.ProcedureDef.Params[I]).Name);1024 ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(Variable);1025 ExecutorVariable.Value.Free;1026 ExecutorVariable.Value := ExecuteExpression(Block, TExpression(ProcedureCall.Params[I]));1027 end;1028 end;1029 1030 1029 ExecuteBlock(Block, ProcedureCall.ProcedureDef.Block, ExecutorProcedure.Block); 1031 1030 end; … … 1039 1038 Variable: TExecutorVariable; 1040 1039 ExecutorFunction: TExecutorFunction; 1041 Params: array of TExecutor FunctionCallbackParam;1040 Params: array of TExecutorVariable; 1042 1041 begin 1043 1042 Value := ExecuteExpression(Block, Assignment.Expression); … … 1046 1045 if Assignment.Variable.TypeRef = Assignment.Expression.GetType then begin 1047 1046 SetLength(Params, 1); 1048 Params[0] := TExecutor FunctionCallbackParam.Create;1047 Params[0] := TExecutorVariable.Create; 1049 1048 Params[0].Value := Value; 1050 Variable.Value.Free;1051 1049 Variable.Value := ExecutorFunction.Callback(Params); 1052 1050 end else raise Exception('Assignment result type is ' + Variable.Variable.TypeRef.Name + 1053 1051 ' but value is ' + Assignment.Expression.GetType.Name + '.'); 1054 Value.Free;1052 FreeAndNil(Value); 1055 1053 end; 1056 1054 … … 1076 1074 Value: TValue; 1077 1075 ExecutorFunction: TExecutorFunction; 1078 Params: array of TExecutor FunctionCallbackParam;1076 Params: array of TExecutorVariable; 1079 1077 FuncName: string; 1080 1078 begin … … 1088 1086 for I := 0 to Expression.Items.Count - 1 do begin 1089 1087 Value := ExecuteExpression(Block, TExpression(Expression.Items[I])); 1090 Params[I] := TExecutor FunctionCallbackParam.Create;1088 Params[I] := TExecutorVariable.Create; 1091 1089 Params[I].Value := Value; 1092 1090 end; -
branches/xpascal/Generators/GeneratorPascal.pas
r235 r236 14 14 procedure GenerateProgram(Block: TBlock; Prog:TProgram); 15 15 procedure GenerateFunction(ParentBlock: TBlock; FunctionDef: TFunction); 16 procedure GenerateFunctionParams(ParentBlock: TBlock; Params: TFunctionParameters); 16 17 procedure GenerateProcedure(ParentBlock: TBlock; ProcedureDef: TProcedure); 17 18 procedure GenerateBlock(ParentBlock: TBlock; Block: TBlock); … … 218 219 AddTextLine('{$mode delphi}'); 219 220 AddTextLine(''); 220 AddTextLine('uses SysUtils;'); 221 AddTextLine('uses'); 222 AddTextLine(' SysUtils;'); 223 AddTextLine(''); 221 224 GenerateBlock(Block, Prog.Block); 222 225 AddTextLine('.'); … … 225 228 procedure TGeneratorPascal.GenerateFunction(ParentBlock: TBlock; 226 229 FunctionDef: TFunction); 227 var228 I: Integer;229 230 begin 230 231 AddText('function ' + FunctionDef.Name); 231 if FunctionDef.Params.Count > 0 then begin 232 AddText('('); 233 for I := 0 to FunctionDef.Params.Count - 1 do begin 234 AddText(FunctionDef.Params[I].Name); 235 AddText(': '); 236 AddText(FunctionDef.Params[I].TypeRef.Name); 237 if I > 0 then AddText(', '); 238 end; 239 AddText(')'); 240 end; 232 GenerateFunctionParams(ParentBlock, FunctionDef.Params); 241 233 if Assigned(FunctionDef.ResultType) then begin 242 234 AddText(': '); … … 259 251 end; 260 252 261 procedure TGeneratorPascal.GenerateProcedure(ParentBlock: TBlock; 262 ProcedureDef: TProcedure); 263 var 264 I: Integer; 265 begin 266 AddText('procedure ' + ProcedureDef.Name); 267 if ProcedureDef.Params.Count > 0 then begin 253 procedure TGeneratorPascal.GenerateFunctionParams(ParentBlock: TBlock; 254 Params: TFunctionParameters); 255 var 256 I: Integer; 257 begin 258 if Params.Count > 0 then begin 268 259 AddText('('); 269 for I := 0 to ProcedureDef.Params.Count - 1 do begin 270 AddText(ProcedureDef.Params[I].Name); 260 for I := 0 to Params.Count - 1 do begin 261 if Params[I].Kind = pkVar then AddText('var '); 262 if Params[I].Kind = pkConst then AddText('const '); 263 AddText(Params[I].Name); 271 264 AddText(': '); 272 AddText(P rocedureDef.Params[I].TypeRef.Name);265 AddText(Params[I].TypeRef.Name); 273 266 if I > 0 then AddText(', '); 274 267 end; 275 268 AddText(')'); 276 269 end; 270 end; 271 272 procedure TGeneratorPascal.GenerateProcedure(ParentBlock: TBlock; 273 ProcedureDef: TProcedure); 274 begin 275 AddText('procedure ' + ProcedureDef.Name); 276 GenerateFunctionParams(ParentBlock, ProcedureDef.Params); 277 277 AddTextLine(';'); 278 278 if ProcedureDef.InternalName <> '' then begin -
branches/xpascal/Parser.pas
r234 r236 44 44 procedure TParser.InitSystemBlock(Block: TBlock); 45 45 var 46 I: Integer; 46 47 TypeBoolean: TType; 47 48 TypeString: TType; … … 219 220 Kind := pkVar; 220 221 end; 222 223 for I := 0 to Block.Functions.Count - 1 do 224 Block.Functions[I].InitVariables; 225 for I := 0 to Block.Procedures.Count - 1 do 226 Block.Procedures[I].InitVariables; 221 227 end; 222 228 -
branches/xpascal/Parsers/ParserPascal.pas
r235 r236 372 372 if Assigned(TypeRef) then begin 373 373 Func.ResultType := TypeRef; 374 Variable := TVariable.Create;375 Variable.Name := 'Result';376 Variable.TypeRef := TypeRef;377 Variable.Internal := True;378 Func.Block.Variables.Add(Variable);379 374 end else Error('Type ' + Token.Text + ' not found'); 380 375 end; 381 376 end; 382 377 Tokenizer.Expect(';', tkSpecialSymbol); 378 Func.InitVariables; 383 379 if ParseBlock(Block, NewBlock, Func.Block) then begin 384 380 Tokenizer.Expect(';', tkSpecialSymbol); … … 405 401 end; 406 402 Tokenizer.Expect(')', tkSpecialSymbol); 407 for I := 0 to Params.Count - 1 do begin408 Variable := TVariable.Create;409 Variable.Name := Params[I].Name;410 Variable.TypeRef := Params[I].TypeRef;411 Variable.Internal := True;412 Block.Variables.Add(Variable);413 end;414 403 Result := True; 415 404 end; … … 463 452 Proc.Params := FunctionParameters; 464 453 end; 465 466 454 Tokenizer.Expect(';', tkSpecialSymbol); 455 Proc.InitVariables; 467 456 if ParseBlock(Block, NewBlock, Proc.Block) then begin 468 457 Tokenizer.Expect(';', tkSpecialSymbol); -
branches/xpascal/Source.pas
r233 r236 133 133 Block: TBlock; 134 134 ParentType: TType; 135 procedure InitVariables; 135 136 procedure GetValue(Index: Integer; out Value); override; 136 137 function GetField(Index: Integer): TField; override; … … 159 160 Block: TBlock; 160 161 ParentType: TType; 162 procedure InitVariables; 161 163 procedure GetValue(Index: Integer; out Value); override; 162 164 function GetField(Index: Integer): TField; override; … … 533 535 end; 534 536 537 procedure TProcedure.InitVariables; 538 var 539 I: Integer; 540 Variable: TVariable; 541 begin 542 for I := 0 to Params.Count - 1 do begin 543 Variable := TVariable.Create; 544 Variable.Name := Params[I].Name; 545 Variable.TypeRef := Params[I].TypeRef; 546 Variable.Internal := True; 547 Block.Variables.Add(Variable); 548 end; 549 end; 550 535 551 procedure TProcedure.GetValue(Index: Integer; out Value); 536 552 begin … … 932 948 begin 933 949 Result := 4; 950 end; 951 952 procedure TFunction.InitVariables; 953 var 954 I: Integer; 955 Variable: TVariable; 956 begin 957 for I := 0 to Params.Count - 1 do begin 958 Variable := TVariable.Create; 959 Variable.Name := Params[I].Name; 960 Variable.TypeRef := Params[I].TypeRef; 961 Variable.Internal := True; 962 Block.Variables.Add(Variable); 963 end; 964 965 Variable := TVariable.Create; 966 Variable.Name := 'Result'; 967 Variable.TypeRef := ResultType; 968 Variable.Internal := True; 969 Block.Variables.Add(Variable); 934 970 end; 935 971 -
branches/xpascal/Tests.pas
r235 r236 158 158 ExpectedOutput := '-1' + LineEnding + '0' + LineEnding; 159 159 end; 160 with TTestRun(Result.AddNew('function without result usage', TTestRun)) do begin 161 Source.Add('function IsZero(A: Integer): Boolean;'); 162 Source.Add('begin'); 163 Source.Add(' Result := A = 0;'); 164 Source.Add('end;'); 165 Source.Add(''); 166 Source.Add('begin'); 167 Source.Add(' IsZero(0);'); 168 Source.Add('end.'); 169 ExpectedOutput := ''; 170 end; 160 171 with TTestRun(Result.AddNew('function var parameter', TTestRun)) do begin 161 172 Source.Add('function Test(var A: Integer): Boolean;'); 162 173 Source.Add('begin'); 163 174 Source.Add(' A := 10;'); 164 Source.Add(' Result := True;');175 Source.Add(' Result := 1 = 1;'); 165 176 Source.Add('end;'); 166 177 Source.Add(''); 167 178 Source.Add('var'); 168 179 Source.Add(' B: Integer;'); 180 Source.Add(' C: Boolean;'); 169 181 Source.Add('begin'); 170 182 Source.Add(' B := 1;'); 171 Source.Add(' Test(B);');183 Source.Add(' C := Test(B);'); 172 184 Source.Add(' WriteLn(IntToStr(B));'); 173 185 Source.Add('end.'); 174 ExpectedOutput := ' -1' + LineEnding + '0' + LineEnding;186 ExpectedOutput := '10' + LineEnding; 175 187 end; 176 188 with TTestRun(Result.AddNew('procedure', TTestRun)) do begin
Note:
See TracChangeset
for help on using the changeset viewer.
