Changeset 230 for branches/xpascal
- Timestamp:
- Jun 26, 2023, 12:08:45 PM (17 months ago)
- Location:
- branches/xpascal
- Files:
-
- 11 added
- 1 deleted
- 19 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/xpascal/Executor.pas
r229 r230 4 4 5 5 uses 6 Classes, SysUtils, Source, Contnrs;6 Classes, SysUtils, Source, Generics.Collections; 7 7 8 8 type … … 21 21 { TExecutorVariables } 22 22 23 TExecutorVariables = class(TObjectList )23 TExecutorVariables = class(TObjectList<TExecutorVariable>) 24 24 function SearchByVariable(Variable: TVariable): TExecutorVariable; 25 25 function AddNew(Variable: TVariable): TExecutorVariable; … … 37 37 { TExecutorTypes } 38 38 39 TExecutorTypes = class(TObjectList )39 TExecutorTypes = class(TObjectList<TExecutorType>) 40 40 function SearchByType(TypeRef: TType): TExecutorType; 41 41 function AddNew(TypeRef: TType): TExecutorType; 42 42 end; 43 43 44 TExecutorFunctionCallback = function(Params: array of TValue): TValue of object; 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): 54 TValue of object; 45 55 46 56 { TExecutorFunction } … … 56 66 { TExecutorFunctions } 57 67 58 TExecutorFunctions = class(TObjectList )68 TExecutorFunctions = class(TObjectList<TExecutorFunction>) 59 69 function SearchByFunction(FunctionDef: TFunction): TExecutorFunction; 60 70 function AddNew(FunctionDef: TFunction): TExecutorFunction; … … 78 88 79 89 TOutputEvent = procedure (Text: string) of object; 90 TInputEvent = function: string of object; 80 91 81 92 { TExecutor } … … 84 95 private 85 96 FOnOutput: TOutputEvent; 97 FOnInput: TInputEvent; 86 98 SystemBlock: TExecutorBlock; 87 function ExecuteWriteLn(Params: array of TValue): TValue; 88 function ExecuteWrite(Params: array of TValue): TValue; 89 function ExecuteIntToStr(Params: array of TValue): TValue; 90 function ExecuteStrToInt(Params: array of TValue): TValue; 91 function ExecuteBooleanAssign(Params: array of TValue): TValue; 92 function ExecuteBooleanNot(Params: array of TValue): TValue; 93 function ExecuteBooleanEqual(Params: array of TValue): TValue; 94 function ExecuteBooleanNotEqual(Params: array of TValue): TValue; 95 function ExecuteStringAssign(Params: array of TValue): TValue; 96 function ExecuteStringAdd(Params: array of TValue): TValue; 97 function ExecuteStringEqual(Params: array of TValue): TValue; 98 function ExecuteStringNotEqual(Params: array of TValue): TValue; 99 function ExecuteIntegerAssign(Params: array of TValue): TValue; 100 function ExecuteIntegerAdd(Params: array of TValue): TValue; 101 function ExecuteIntegerSub(Params: array of TValue): TValue; 102 function ExecuteIntegerMul(Params: array of TValue): TValue; 103 function ExecuteIntegerIntDiv(Params: array of TValue): TValue; 104 function ExecuteIntegerMod(Params: array of TValue): TValue; 105 function ExecuteIntegerEqual(Params: array of TValue): TValue; 106 function ExecuteIntegerNotEqual(Params: array of TValue): TValue; 107 function ExecuteIntegerLesser(Params: array of TValue): TValue; 108 function ExecuteIntegerHigher(Params: array of TValue): TValue; 109 function ExecuteIntegerLesserOrEqual(Params: array of TValue): TValue; 110 function ExecuteIntegerHigherOrEqual(Params: array of TValue): TValue; 111 function ExecuteIntegerAnd(Params: array of TValue): TValue; 112 function ExecuteIntegerOr(Params: array of TValue): TValue; 113 function ExecuteIntegerXor(Params: array of TValue): TValue; 114 function ExecuteIntegerShr(Params: array of TValue): TValue; 115 function ExecuteIntegerShl(Params: array of TValue): TValue; 99 function ExecuteWriteLn(Params: array of TExecutorFunctionCallbackParam): TValue; 100 function ExecuteWrite(Params: array of TExecutorFunctionCallbackParam): TValue; 101 function ExecuteReadLn(Params: array of TExecutorFunctionCallbackParam): TValue; 102 function ExecuteRead(Params: array of TExecutorFunctionCallbackParam): TValue; 103 function ExecuteIntToStr(Params: array of TExecutorFunctionCallbackParam): TValue; 104 function ExecuteStrToInt(Params: array of TExecutorFunctionCallbackParam): TValue; 105 function ExecuteBoolToStr(Params: array of TExecutorFunctionCallbackParam): TValue; 106 function ExecuteStrToBool(Params: array of TExecutorFunctionCallbackParam): TValue; 107 function ExecuteBooleanAssign(Params: array of TExecutorFunctionCallbackParam): TValue; 108 function ExecuteBooleanNot(Params: array of TExecutorFunctionCallbackParam): TValue; 109 function ExecuteBooleanEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 110 function ExecuteBooleanNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 111 function ExecuteStringAssign(Params: array of TExecutorFunctionCallbackParam): TValue; 112 function ExecuteStringAdd(Params: array of TExecutorFunctionCallbackParam): TValue; 113 function ExecuteStringEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 114 function ExecuteStringNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 115 function ExecuteIntegerAssign(Params: array of TExecutorFunctionCallbackParam): TValue; 116 function ExecuteIntegerAdd(Params: array of TExecutorFunctionCallbackParam): TValue; 117 function ExecuteIntegerSub(Params: array of TExecutorFunctionCallbackParam): TValue; 118 function ExecuteIntegerMul(Params: array of TExecutorFunctionCallbackParam): TValue; 119 function ExecuteIntegerIntDiv(Params: array of TExecutorFunctionCallbackParam): TValue; 120 function ExecuteIntegerMod(Params: array of TExecutorFunctionCallbackParam): TValue; 121 function ExecuteIntegerEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 122 function ExecuteIntegerNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 123 function ExecuteIntegerLesser(Params: array of TExecutorFunctionCallbackParam): TValue; 124 function ExecuteIntegerHigher(Params: array of TExecutorFunctionCallbackParam): TValue; 125 function ExecuteIntegerLesserOrEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 126 function ExecuteIntegerHigherOrEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 127 function ExecuteIntegerAnd(Params: array of TExecutorFunctionCallbackParam): TValue; 128 function ExecuteIntegerOr(Params: array of TExecutorFunctionCallbackParam): TValue; 129 function ExecuteIntegerXor(Params: array of TExecutorFunctionCallbackParam): TValue; 130 function ExecuteIntegerShr(Params: array of TExecutorFunctionCallbackParam): TValue; 131 function ExecuteIntegerShl(Params: array of TExecutorFunctionCallbackParam): TValue; 116 132 procedure InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock); 117 133 public … … 135 151 procedure Run; 136 152 procedure Output(Text: string); 153 function Input: string; 137 154 property OnOutput: TOutputEvent read FOnOutput write FOnOutput; 155 property OnInput: TInputEvent read FOnInput write FOnInput; 138 156 end; 139 157 140 158 141 159 implementation 160 161 resourcestring 162 SUnsupportedOperandType = 'Unsupported exception operand type.'; 163 SUnsupportedCommandType = 'Unsupported command type.'; 164 SExpectedBooleanValue = 'Expected boolean value.'; 165 166 { TExecutorFunctionCallbackParam } 167 168 destructor TExecutorFunctionCallbackParam.Destroy; 169 begin 170 FreeAndNil(Value); 171 inherited; 172 end; 142 173 143 174 { TExecutorFunction } … … 293 324 { TExecutor } 294 325 295 function TExecutor.ExecuteWriteLn(Params: array of T Value): TValue;326 function TExecutor.ExecuteWriteLn(Params: array of TExecutorFunctionCallbackParam): TValue; 296 327 var 297 328 I: Integer; … … 301 332 Text := ''; 302 333 for I := 0 to Length(Params) - 1 do 303 Text := Text + TValueString(Params[I] ).Value;334 Text := Text + TValueString(Params[I].Value).Value; 304 335 Output(Text + LineEnding); 305 336 end; 306 337 307 function TExecutor.ExecuteWrite(Params: array of T Value): TValue;338 function TExecutor.ExecuteWrite(Params: array of TExecutorFunctionCallbackParam): TValue; 308 339 var 309 340 I: Integer; … … 313 344 Text := ''; 314 345 for I := 0 to Length(Params) - 1 do 315 Text := Text + TValueString(Params[I] ).Value;346 Text := Text + TValueString(Params[I].Value).Value; 316 347 Output(Text); 317 348 end; 318 349 319 function TExecutor.ExecuteIntToStr(Params: array of TValue): TValue; 350 function TExecutor.ExecuteReadLn(Params: array of TExecutorFunctionCallbackParam): TValue; 351 var 352 I: Integer; 353 begin 354 Result := nil; 355 for I := 0 to Length(Params) - 1 do 356 TValueString(Params[I].Variable.Value).Value := Input; 357 Output(LineEnding); 358 end; 359 360 function TExecutor.ExecuteRead(Params: array of TExecutorFunctionCallbackParam): TValue; 361 var 362 I: Integer; 363 begin 364 Result := nil; 365 for I := 0 to Length(Params) - 1 do 366 TValueString(Params[I].Value).Value := Input; 367 end; 368 369 function TExecutor.ExecuteIntToStr(Params: array of TExecutorFunctionCallbackParam): TValue; 320 370 begin 321 371 Result := TValueString.Create; 322 TValueString(Result).Value := IntToStr(TValueInteger(Params[0]).Value); 323 end; 324 325 function TExecutor.ExecuteStrToInt(Params: array of TValue): TValue; 326 begin 327 Result := TValueInteger.Create; 328 TValueInteger(Result).Value := StrToInt(TValueString(Params[0]).Value); 329 end; 330 331 function TExecutor.ExecuteBooleanAssign(Params: array of TValue): TValue; 332 begin 333 Result := TValueBoolean.Create; 334 TValueBoolean(Result).Value := TValueBoolean(Params[0]).Value; 335 end; 336 337 function TExecutor.ExecuteBooleanNot(Params: array of TValue): TValue; 338 begin 339 Result := TValueBoolean.Create; 340 TValueBoolean(Result).Value := not TValueBoolean(Params[0]).Value; 341 end; 342 343 function TExecutor.ExecuteBooleanEqual(Params: array of TValue): TValue; 344 begin 345 Result := TValueBoolean.Create; 346 TValueBoolean(Result).Value := TValueBoolean(Params[0]).Value = TValueBoolean(Params[1]).Value; 347 end; 348 349 function TExecutor.ExecuteBooleanNotEqual(Params: array of TValue): TValue; 350 begin 351 Result := TValueBoolean.Create; 352 TValueBoolean(Result).Value := TValueBoolean(Params[0]).Value <> TValueBoolean(Params[1]).Value; 353 end; 354 355 function TExecutor.ExecuteStringAssign(Params: array of TValue): TValue; 372 TValueString(Result).Value := IntToStr(TValueInteger(Params[0].Value).Value); 373 end; 374 375 function TExecutor.ExecuteStrToInt(Params: array of TExecutorFunctionCallbackParam): TValue; 376 begin 377 Result := TValueInteger.Create; 378 TValueInteger(Result).Value := StrToInt(TValueString(Params[0].Value).Value); 379 end; 380 381 function TExecutor.ExecuteBoolToStr(Params: array of TExecutorFunctionCallbackParam): TValue; 356 382 begin 357 383 Result := TValueString.Create; 358 TValueString(Result).Value := TValueString(Params[0]).Value; 359 end; 360 361 function TExecutor.ExecuteStringAdd(Params: array of TValue): TValue; 384 TValueString(Result).Value := BoolToStr(TValueBoolean(Params[0].Value).Value); 385 end; 386 387 function TExecutor.ExecuteStrToBool(Params: array of TExecutorFunctionCallbackParam): TValue; 388 begin 389 Result := TValueBoolean.Create; 390 TValueBoolean(Result).Value := StrToBool(TValueString(Params[0].Value).Value); 391 end; 392 393 function TExecutor.ExecuteBooleanAssign(Params: array of TExecutorFunctionCallbackParam): TValue; 394 begin 395 Result := TValueBoolean.Create; 396 TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value; 397 end; 398 399 function TExecutor.ExecuteBooleanNot(Params: array of TExecutorFunctionCallbackParam): TValue; 400 begin 401 Result := TValueBoolean.Create; 402 TValueBoolean(Result).Value := not TValueBoolean(Params[0].Value).Value; 403 end; 404 405 function TExecutor.ExecuteBooleanEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 406 begin 407 Result := TValueBoolean.Create; 408 TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value = 409 TValueBoolean(Params[1].Value).Value; 410 end; 411 412 function TExecutor.ExecuteBooleanNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 413 begin 414 Result := TValueBoolean.Create; 415 TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value <> 416 TValueBoolean(Params[1].Value).Value; 417 end; 418 419 function TExecutor.ExecuteStringAssign(Params: array of TExecutorFunctionCallbackParam): TValue; 362 420 begin 363 421 Result := TValueString.Create; 364 TValueString(Result).Value := TValueString(Params[0]).Value + TValueString(Params[1]).Value; 365 end; 366 367 function TExecutor.ExecuteStringEqual(Params: array of TValue): TValue; 368 begin 369 Result := TValueBoolean.Create; 370 TValueBoolean(Result).Value := TValueString(Params[0]).Value = TValueString(Params[1]).Value; 371 end; 372 373 function TExecutor.ExecuteStringNotEqual(Params: array of TValue): TValue; 374 begin 375 Result := TValueBoolean.Create; 376 TValueBoolean(Result).Value := TValueString(Params[0]).Value <> TValueString(Params[1]).Value; 377 end; 378 379 function TExecutor.ExecuteIntegerAssign(Params: array of TValue): TValue; 380 begin 381 Result := TValueInteger.Create; 382 TValueInteger(Result).Value := TValueInteger(Params[0]).Value; 383 end; 384 385 function TExecutor.ExecuteIntegerAdd(Params: array of TValue): TValue; 386 begin 387 Result := TValueInteger.Create; 388 TValueInteger(Result).Value := TValueInteger(Params[0]).Value + TValueInteger(Params[1]).Value; 389 end; 390 391 function TExecutor.ExecuteIntegerSub(Params: array of TValue): TValue; 392 begin 393 Result := TValueInteger.Create; 394 TValueInteger(Result).Value := TValueInteger(Params[0]).Value - TValueInteger(Params[1]).Value; 395 end; 396 397 function TExecutor.ExecuteIntegerMul(Params: array of TValue): TValue; 398 begin 399 Result := TValueInteger.Create; 400 TValueInteger(Result).Value := TValueInteger(Params[0]).Value * TValueInteger(Params[1]).Value; 401 end; 402 403 function TExecutor.ExecuteIntegerIntDiv(Params: array of TValue): TValue; 404 begin 405 Result := TValueInteger.Create; 406 TValueInteger(Result).Value := TValueInteger(Params[0]).Value div TValueInteger(Params[1]).Value; 407 end; 408 409 function TExecutor.ExecuteIntegerMod(Params: array of TValue): TValue; 410 begin 411 Result := TValueInteger.Create; 412 TValueInteger(Result).Value := TValueInteger(Params[0]).Value mod TValueInteger(Params[1]).Value; 413 end; 414 415 function TExecutor.ExecuteIntegerEqual(Params: array of TValue): TValue; 416 begin 417 Result := TValueBoolean.Create; 418 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value = TValueInteger(Params[1]).Value; 419 end; 420 421 function TExecutor.ExecuteIntegerNotEqual(Params: array of TValue): TValue; 422 begin 423 Result := TValueBoolean.Create; 424 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value <> TValueInteger(Params[1]).Value; 425 end; 426 427 function TExecutor.ExecuteIntegerLesser(Params: array of TValue): TValue; 428 begin 429 Result := TValueBoolean.Create; 430 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value < TValueInteger(Params[1]).Value; 431 end; 432 433 function TExecutor.ExecuteIntegerHigher(Params: array of TValue): TValue; 434 begin 435 Result := TValueBoolean.Create; 436 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value > TValueInteger(Params[1]).Value; 437 end; 438 439 function TExecutor.ExecuteIntegerLesserOrEqual(Params: array of TValue): TValue; 440 begin 441 Result := TValueBoolean.Create; 442 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value <= TValueInteger(Params[1]).Value; 443 end; 444 445 function TExecutor.ExecuteIntegerHigherOrEqual(Params: array of TValue): TValue; 446 begin 447 Result := TValueBoolean.Create; 448 TValueBoolean(Result).Value := TValueInteger(Params[0]).Value >= TValueInteger(Params[1]).Value; 449 end; 450 451 function TExecutor.ExecuteIntegerAnd(Params: array of TValue): TValue; 452 begin 453 Result := TValueInteger.Create; 454 TValueInteger(Result).Value := TValueInteger(Params[0]).Value and TValueInteger(Params[1]).Value; 455 end; 456 457 function TExecutor.ExecuteIntegerOr(Params: array of TValue): TValue; 458 begin 459 Result := TValueInteger.Create; 460 TValueInteger(Result).Value := TValueInteger(Params[0]).Value or TValueInteger(Params[1]).Value; 461 end; 462 463 function TExecutor.ExecuteIntegerXor(Params: array of TValue): TValue; 464 begin 465 Result := TValueInteger.Create; 466 TValueInteger(Result).Value := TValueInteger(Params[0]).Value xor TValueInteger(Params[1]).Value; 467 end; 468 469 function TExecutor.ExecuteIntegerShr(Params: array of TValue): TValue; 470 begin 471 Result := TValueInteger.Create; 472 TValueInteger(Result).Value := TValueInteger(Params[0]).Value shr TValueInteger(Params[1]).Value; 473 end; 474 475 function TExecutor.ExecuteIntegerShl(Params: array of TValue): TValue; 476 begin 477 Result := TValueInteger.Create; 478 TValueInteger(Result).Value := TValueInteger(Params[0]).Value shl TValueInteger(Params[1]).Value; 422 TValueString(Result).Value := TValueString(Params[0].Value).Value; 423 end; 424 425 function TExecutor.ExecuteStringAdd(Params: array of TExecutorFunctionCallbackParam): TValue; 426 begin 427 Result := TValueString.Create; 428 TValueString(Result).Value := TValueString(Params[0].Value).Value + 429 TValueString(Params[1].Value).Value; 430 end; 431 432 function TExecutor.ExecuteStringEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 433 begin 434 Result := TValueBoolean.Create; 435 TValueBoolean(Result).Value := TValueString(Params[0].Value).Value = 436 TValueString(Params[1].Value).Value; 437 end; 438 439 function TExecutor.ExecuteStringNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 440 begin 441 Result := TValueBoolean.Create; 442 TValueBoolean(Result).Value := TValueString(Params[0].Value).Value <> 443 TValueString(Params[1].Value).Value; 444 end; 445 446 function TExecutor.ExecuteIntegerAssign(Params: array of TExecutorFunctionCallbackParam): TValue; 447 begin 448 Result := TValueInteger.Create; 449 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value; 450 end; 451 452 function TExecutor.ExecuteIntegerAdd(Params: array of TExecutorFunctionCallbackParam): TValue; 453 begin 454 Result := TValueInteger.Create; 455 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value + 456 TValueInteger(Params[1].Value).Value; 457 end; 458 459 function TExecutor.ExecuteIntegerSub(Params: array of TExecutorFunctionCallbackParam): TValue; 460 begin 461 Result := TValueInteger.Create; 462 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value - 463 TValueInteger(Params[1].Value).Value; 464 end; 465 466 function TExecutor.ExecuteIntegerMul(Params: array of TExecutorFunctionCallbackParam): TValue; 467 begin 468 Result := TValueInteger.Create; 469 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value * 470 TValueInteger(Params[1].Value).Value; 471 end; 472 473 function TExecutor.ExecuteIntegerIntDiv(Params: array of TExecutorFunctionCallbackParam): TValue; 474 begin 475 Result := TValueInteger.Create; 476 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value div 477 TValueInteger(Params[1].Value).Value; 478 end; 479 480 function TExecutor.ExecuteIntegerMod(Params: array of TExecutorFunctionCallbackParam): TValue; 481 begin 482 Result := TValueInteger.Create; 483 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value mod 484 TValueInteger(Params[1].Value).Value; 485 end; 486 487 function TExecutor.ExecuteIntegerEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 488 begin 489 Result := TValueBoolean.Create; 490 TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value = 491 TValueInteger(Params[1].Value).Value; 492 end; 493 494 function TExecutor.ExecuteIntegerNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 495 begin 496 Result := TValueBoolean.Create; 497 TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value <> 498 TValueInteger(Params[1].Value).Value; 499 end; 500 501 function TExecutor.ExecuteIntegerLesser(Params: array of TExecutorFunctionCallbackParam): TValue; 502 begin 503 Result := TValueBoolean.Create; 504 TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value < 505 TValueInteger(Params[1].Value).Value; 506 end; 507 508 function TExecutor.ExecuteIntegerHigher(Params: array of TExecutorFunctionCallbackParam): TValue; 509 begin 510 Result := TValueBoolean.Create; 511 TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value > 512 TValueInteger(Params[1].Value).Value; 513 end; 514 515 function TExecutor.ExecuteIntegerLesserOrEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 516 begin 517 Result := TValueBoolean.Create; 518 TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value <= 519 TValueInteger(Params[1].Value).Value; 520 end; 521 522 function TExecutor.ExecuteIntegerHigherOrEqual(Params: array of TExecutorFunctionCallbackParam): TValue; 523 begin 524 Result := TValueBoolean.Create; 525 TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value >= 526 TValueInteger(Params[1].Value).Value; 527 end; 528 529 function TExecutor.ExecuteIntegerAnd(Params: array of TExecutorFunctionCallbackParam): TValue; 530 begin 531 Result := TValueInteger.Create; 532 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value and 533 TValueInteger(Params[1].Value).Value; 534 end; 535 536 function TExecutor.ExecuteIntegerOr(Params: array of TExecutorFunctionCallbackParam): TValue; 537 begin 538 Result := TValueInteger.Create; 539 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value or 540 TValueInteger(Params[1].Value).Value; 541 end; 542 543 function TExecutor.ExecuteIntegerXor(Params: array of TExecutorFunctionCallbackParam): TValue; 544 begin 545 Result := TValueInteger.Create; 546 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value xor 547 TValueInteger(Params[1].Value).Value; 548 end; 549 550 function TExecutor.ExecuteIntegerShr(Params: array of TExecutorFunctionCallbackParam): TValue; 551 begin 552 Result := TValueInteger.Create; 553 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value shr 554 TValueInteger(Params[1].Value).Value; 555 end; 556 557 function TExecutor.ExecuteIntegerShl(Params: array of TExecutorFunctionCallbackParam): TValue; 558 begin 559 Result := TValueInteger.Create; 560 TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value shl 561 TValueInteger(Params[1].Value).Value; 479 562 end; 480 563 … … 582 665 if ExecutorFunction.FunctionDef.Name = 'WriteLn' then begin 583 666 ExecutorFunction.Callback := ExecuteWriteLn; 584 end; 667 end else 668 if ExecutorFunction.FunctionDef.Name = 'Read' then begin 669 ExecutorFunction.Callback := ExecuteRead; 670 end else 671 if ExecutorFunction.FunctionDef.Name = 'ReadLn' then begin 672 ExecutorFunction.Callback := ExecuteReadLn; 673 end else 585 674 if ExecutorFunction.FunctionDef.Name = 'IntToStr' then begin 586 675 ExecutorFunction.Callback := ExecuteIntToStr; … … 588 677 if ExecutorFunction.FunctionDef.Name = 'StrToInt' then begin 589 678 ExecutorFunction.Callback := ExecuteStrToInt; 679 end else 680 if ExecutorFunction.FunctionDef.Name = 'BoolToStr' then begin 681 ExecutorFunction.Callback := ExecuteBoolToStr; 682 end else 683 if ExecutorFunction.FunctionDef.Name = 'StrToBool' then begin 684 ExecutorFunction.Callback := ExecuteStrToBool; 590 685 end; 591 686 end; … … 620 715 else if Command is TContinue then ExecuteContinue(Block, TContinue(Command)) 621 716 else if Command is TEmptyCommand then 622 else raise Exception.Create( 'Unsupported command type');717 else raise Exception.Create(SUnsupportedCommandType); 623 718 end; 624 719 … … 635 730 ExecuteCommand(Block, IfThenElse.CommandElse); 636 731 end; 637 end else raise Exception.Create( 'Expected boolean value.');732 end else raise Exception.Create(SExpectedBooleanValue); 638 733 Value.Free; 639 734 end; … … 659 754 Break; 660 755 end; 661 end else raise Exception.Create( 'Expected boolean value.');756 end else raise Exception.Create(SExpectedBooleanValue); 662 757 end; 663 758 end; … … 687 782 Value.Free; 688 783 if BoolValue then Break; 689 end else raise Exception.Create( 'Expected boolean value.');784 end else raise Exception.Create(SExpectedBooleanValue); 690 785 end; 691 786 end; … … 760 855 var 761 856 ExecutorFunction: TExecutorFunction; 762 Params: array of T Value;857 Params: array of TExecutorFunctionCallbackParam; 763 858 I: Integer; 764 859 ExecutorVariable: TExecutorVariable; … … 771 866 SetLength(Params, FunctionCall.Params.Count); 772 867 for I := 0 to FunctionCall.Params.Count - 1 do begin 773 Params[I] := ExecuteExpression(Block, TExpression(FunctionCall.Params[0])); 868 Params[I] := TExecutorFunctionCallbackParam.Create; 869 Params[I].Kind := FunctionCall.FunctionDef.Params[I].Kind; 870 if FunctionCall.FunctionDef.Params[I].Kind = pkVar then begin 871 Variable := TExpressionOperand(FunctionCall.Params[I]).VariableRef; 872 //InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block); 873 ExecutorVariable := Block.GetVariable(Variable); 874 Params[I].Variable := ExecutorVariable; 875 end 876 else Params[I].Value := ExecuteExpression(Block, FunctionCall.Params[I]); 774 877 end; 775 878 Result := ExecutorFunction.Callback(Params); 776 879 for I := 0 to FunctionCall.Params.Count - 1 do begin 880 //if FunctionCall.Params[I]. 777 881 Params[I].Free; 778 882 end; … … 798 902 Variable: TExecutorVariable; 799 903 ExecutorFunction: TExecutorFunction; 800 Params: array of T Value;904 Params: array of TExecutorFunctionCallbackParam; 801 905 begin 802 906 Value := ExecuteExpression(Block, Assignment.Expression); … … 805 909 if Assignment.Variable.TypeRef = Assignment.Expression.GetType then begin; 806 910 SetLength(Params, 1); 807 Params[0] := Value; 911 Params[0] := TExecutorFunctionCallbackParam.Create; 912 Params[0].Value := Value; 808 913 Variable.Value.Free; 809 914 Variable.Value := ExecutorFunction.Callback(Params); … … 834 939 Value: TValue; 835 940 ExecutorFunction: TExecutorFunction; 836 Params: array of T Value;941 Params: array of TExecutorFunctionCallbackParam; 837 942 FuncName: string; 838 943 begin … … 846 951 for I := 0 to Expression.Items.Count - 1 do begin 847 952 Value := ExecuteExpression(Block, TExpression(Expression.Items[I])); 848 Params[I] := Value; 953 Params[I] := TExecutorFunctionCallbackParam.Create; 954 Params[I].Value := Value; 849 955 end; 850 956 Result := ExecutorFunction.Callback(Params); … … 862 968 otConstantRef: Result := Expression.ConstantRef.Value.Clone; 863 969 otVariableRef: Result := Block.Variables.SearchByVariable(Expression.VariableRef).Value.Clone; 864 else raise Exception.Create( 'Unsupported exception operand type.');970 else raise Exception.Create(SUnsupportedOperandType); 865 971 end; 866 972 end; … … 883 989 end; 884 990 991 function TExecutor.Input: string; 992 begin 993 if Assigned(FOnInput) then 994 Result := FOnInput; 995 end; 996 885 997 end. 886 998 -
branches/xpascal/Forms/FormMain.lfm
r229 r230 1 1 object FormMain: TFormMain 2 Left = 4822 Left = 534 3 3 Height = 993 4 Top = 2 054 Top = 223 5 5 Width = 1491 6 6 Caption = 'Interpreter' … … 125 125 ShortCut = 122 126 126 end 127 object AConsole: TAction 128 Caption = 'Console' 129 OnExecute = AConsoleExecute 130 end 127 131 end 128 132 end -
branches/xpascal/Forms/FormMain.lrj
r227 r230 12 12 {"hash":315140,"name":"tformmain.aexit.caption","sourcebytes":[69,120,105,116],"value":"Exit"}, 13 13 {"hash":209392028,"name":"tformmain.ageneratexml.caption","sourcebytes":[71,101,110,101,114,97,116,101,32,88,77,76],"value":"Generate XML"}, 14 {"hash":371876,"name":"tformmain.atest.caption","sourcebytes":[84,101,115,116],"value":"Test"} 14 {"hash":371876,"name":"tformmain.atest.caption","sourcebytes":[84,101,115,116],"value":"Test"}, 15 {"hash":174433893,"name":"tformmain.aconsole.caption","sourcebytes":[67,111,110,115,111,108,101],"value":"Console"} 15 16 ]} -
branches/xpascal/Forms/FormMain.pas
r229 r230 6 6 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, 7 7 ActnList, ExtCtrls, SynHighlighterPas, SynEdit, Source, Optimizer, 8 Generator, FormSource, FormMessages, FormOutput, Form Ex;8 Generator, FormSource, FormMessages, FormOutput, FormConsole, FormEx; 9 9 10 10 type … … 14 14 TFormMain = class(TFormEx) 15 15 ACompile: TAction; 16 AConsole: TAction; 16 17 ATest: TAction; 17 18 AGenerateXml: TAction; … … 40 41 Splitter1: TSplitter; 41 42 procedure ACompileExecute(Sender: TObject); 43 procedure AConsoleExecute(Sender: TObject); 42 44 procedure AExitExecute(Sender: TObject); 43 45 procedure AGenerateCSharpExecute(Sender: TObject); … … 58 60 FormMessages: TFormMessages; 59 61 FormOutput: TFormOutput; 62 FormConsole: TFormConsole; 60 63 procedure Generate(GeneratorClass: TGeneratorClass); 61 64 procedure ExecutorOutput(Text: string); 65 function ExecutorInput: string; 62 66 procedure InterpreterError(Pos: TPoint; Text: string); 63 67 procedure UpdateInterface; … … 83 87 if not Initialized then begin 84 88 Initialized := True; 85 FormSource.SynEditSource.Lines.LoadFromFile('Test.pas'); 89 FormSource.SynEditSource.Lines.LoadFromFile('Examples' + DirectorySeparator + 90 'Example.pas'); 86 91 ARun.Execute; 87 92 end; … … 94 99 if Assigned(FormMessages) then FreeAndNil(FormMessages); 95 100 if Assigned(FormOutput) then FreeAndNil(FormOutput); 101 if Assigned(FormConsole) then FreeAndNil(FormConsole); 96 102 end; 97 103 … … 107 113 FormOutput.Show; 108 114 DockForm(FormOutput, PanelOutput); 115 FormConsole := TFormConsole.Create(nil); 116 FormConsole.Show; 117 DockForm(FormConsole, PanelOutput); 109 118 UpdateInterface; 110 119 end; … … 121 130 FormOutput.SetText(Generator.Output); 122 131 TargetFileName := 'Generated' + DirectorySeparator + 123 Generator.Name + DirectorySeparator + ' Test' + Generator.FileExt;132 Generator.Name + DirectorySeparator + 'Example' + Generator.FileExt; 124 133 ForceDirectories(ExtractFileDir(TargetFileName)); 125 134 FormOutput.SynEditOutput.Lines.SaveToFile(TargetFileName); … … 152 161 end; 153 162 163 procedure TFormMain.AConsoleExecute(Sender: TObject); 164 begin 165 166 end; 167 154 168 procedure TFormMain.AGenerateCSharpExecute(Sender: TObject); 155 169 begin … … 161 175 Generate(TGeneratorCSharp); 162 176 end; 177 DockForm(FormOutput, PanelOutput); 163 178 end; 164 179 … … 171 186 Generate(TGeneratorPascal); 172 187 end; 188 DockForm(FormOutput, PanelOutput); 173 189 end; 174 190 … … 182 198 Generate(TGeneratorPhp); 183 199 end; 200 DockForm(FormOutput, PanelOutput); 184 201 end; 185 202 … … 192 209 Generate(TGeneratorXml); 193 210 end; 211 DockForm(FormOutput, PanelOutput); 194 212 end; 195 213 … … 236 254 Executor.Prog := Prog; 237 255 Executor.OnOutput := ExecutorOutput; 256 Executor.OnInput := ExecutorInput; 238 257 Executor.Run; 239 258 Executor.Free; 240 259 end; 260 DockForm(FormConsole, PanelOutput); 261 FormConsole.Memo1.SetFocus; 241 262 end; 242 263 … … 259 280 procedure TFormMain.ExecutorOutput(Text: string); 260 281 begin 261 FormOutput.SynEditOutput.Text := FormOutput.SynEditOutput.Text + Text; 282 FormConsole.Memo1.Text := FormConsole.Memo1.Text + Text; 283 end; 284 285 function TFormMain.ExecutorInput: string; 286 begin 287 Result := FormConsole.GetInputString; 262 288 end; 263 289 -
branches/xpascal/Forms/FormOutput.lfm
r227 r230 1 1 object FormOutput: TFormOutput 2 Left = 6072 Left = 563 3 3 Height = 544 4 Top = 2524 Top = 339 5 5 Width = 932 6 6 Caption = 'Output' -
branches/xpascal/Generators/GeneratorCSharp.pas
r224 r230 129 129 if FunctionCall.Params.Count > 0 then begin 130 130 AddText('('); 131 for I := 0 to FunctionCall.Params.Count - 1 do 131 for I := 0 to FunctionCall.Params.Count - 1 do begin 132 if FunctionCall.FunctionDef.Params[I].Kind = pkVar then 133 AddText('ref '); 132 134 GenerateExpression(Block, TExpression(FunctionCall.Params[I])); 135 end; 133 136 AddText(')'); 134 137 end; … … 297 300 var 298 301 I: Integer; 302 Param: TFunctionParameter; 299 303 begin 300 304 GenerateTypeRef(FunctionDef.ResultType); 301 305 AddText(' ' + FunctionDef.Name + '('); 302 306 for I := 0 to FunctionDef.Params.Count - 1 do begin 303 GenerateTypeRef(TFunctionParameter(FunctionDef.Params[I]).TypeRef); 307 Param := TFunctionParameter(FunctionDef.Params[I]); 308 if Param.Kind = pkVar then AddText('ref '); 309 GenerateTypeRef(Param.TypeRef); 304 310 AddText(' '); 305 AddText( TFunctionParameter(FunctionDef.Params[I]).Name);311 AddText(Param.Name); 306 312 if I > 0 then AddText(', '); 307 313 end; … … 312 318 if FunctionDef.InternalName = 'WriteLn' then AddTextLine('Console.Write(Text + "\n");') 313 319 else if FunctionDef.InternalName = 'Write' then AddTextLine('Console.Write(Text);') 320 else if FunctionDef.InternalName = 'ReadLn' then AddTextLine('Text = Console.ReadLine();') 321 else if FunctionDef.InternalName = 'Read' then AddTextLine('Text = Console.ReadLine();') 314 322 else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return Value.ToString();') 315 323 else if FunctionDef.InternalName = 'StrToInt' then begin … … 319 327 AddTextLine(' return x;'); 320 328 AddTextLine('} else return 0;'); 329 end 330 else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return Value.ToString();') 331 else if FunctionDef.InternalName = 'StrToBool' then begin 332 AddTextLine('bool x = false;'); 333 AddTextLine('if (bool.TryParse(Value, out x))'); 334 AddTextLine('{'); 335 AddTextLine(' return x;'); 336 AddTextLine('} else return false;'); 321 337 end; 322 338 -
branches/xpascal/Generators/GeneratorPascal.pas
r224 r230 231 231 else if FunctionDef.InternalName = 'Write' then AddTextLine('System.Write(Text);') 232 232 else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return SysUtils.IntToStr(Value);') 233 else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return SysUtils.StrToInt(Value);'); 233 else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return SysUtils.StrToInt(Value);') 234 else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return SysUtils.BoolToStr(Value);') 235 else if FunctionDef.InternalName = 'StrToBool' then AddTextLine('return SysUtils.StrToBool(Value);'); 234 236 Indent := Indent - 1; 235 237 AddTextLine('end;'); -
branches/xpascal/Generators/GeneratorPhp.pas
r224 r230 241 241 else if FunctionDef.InternalName = 'Write' then AddTextLine('echo($Text);') 242 242 else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return $Value;') 243 else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return $Value;'); 243 else if FunctionDef.InternalName = 'StrToInt' then AddTextLine('return $Value;') 244 else if FunctionDef.InternalName = 'BoolToStr' then AddTextLine('return $Value;') 245 else if FunctionDef.InternalName = 'StrToBool' then AddTextLine('return $Value;'); 244 246 Indent := Indent - 1; 245 247 AddTextLine('}'); -
branches/xpascal/Generators/GeneratorXml.pas
r224 r230 11 11 TGeneratorXml = class(TGenerator) 12 12 private 13 procedure GenerateNodes(SourceNodes: TSourceNode s);13 procedure GenerateNodes(SourceNodes: TSourceNodeList<TSourceNode>); 14 14 procedure GenerateNode(SourceNode: TSourceNode); 15 15 public … … 21 21 implementation 22 22 23 resourcestring 24 SUnsupportedNodeType = 'Unsupported node type'; 25 23 26 { TGeneratorXml } 24 27 25 procedure TGeneratorXml.GenerateNodes(SourceNodes: TSourceNode s);28 procedure TGeneratorXml.GenerateNodes(SourceNodes: TSourceNodeList<TSourceNode>); 26 29 var 27 30 I: Integer; … … 30 33 if SourceNodes[I] is TSourceNode then begin 31 34 GenerateNode(TSourceNode(SourceNodes[I])); 32 end else raise Exception.Create( 'Unsupported node type');35 end else raise Exception.Create(SUnsupportedNodeType); 33 36 end; 34 37 end; … … 42 45 if SourceNode = nil then begin 43 46 end else 44 if SourceNode is TSourceNode sthen begin45 GenerateNodes(TSourceNode s(SourceNode))47 if SourceNode is TSourceNodeList<TSourceNode> then begin 48 GenerateNodes(TSourceNodeList<TSourceNode>(SourceNode)) 46 49 end else 47 50 if SourceNode is TSourceNode then begin … … 63 66 AddTextLine('</' + SourceNode.ClassName + '>'); 64 67 end else 65 raise Exception.Create( 'Unsupported node type');68 raise Exception.Create(SUnsupportedNodeType); 66 69 end; 67 70 -
branches/xpascal/Languages
-
Property svn:ignore
set to
*.mo
-
Property svn:ignore
set to
-
branches/xpascal/Languages/xpascal.cs.po
r228 r230 11 11 "Content-Transfer-Encoding: 8bit\n" 12 12 "X-Generator: Poedit 3.0.1\n" 13 14 #: executor.sexpectedbooleanvalue 15 msgid "Expected boolean value." 16 msgstr "OÄekávána Boolean hodnota." 17 18 #: executor.sunsupportedcommandtype 19 msgid "Unsupported command type." 20 msgstr "NepodporovanÃœ typ pÅÃkazu." 21 22 #: executor.sunsupportedoperandtype 23 msgid "Unsupported exception operand type." 24 msgstr "NepodporovanÃœ typ vÃœjimky operandu." 25 26 #: generatorxml.sunsupportednodetype 27 #, fuzzy 28 msgctxt "generatorxml.sunsupportednodetype" 29 msgid "Unsupported node type" 30 msgstr "NepodporovanÃœ typ uzlu" 31 32 #: optimizer.sunsupportednodetype 33 msgctxt "optimizer.sunsupportednodetype" 34 msgid "Unsupported node type" 35 msgstr "NepodporovanÃœ typ uzlu" 36 37 #: parser.scannotparseprogram 38 msgid "Cannot parse program." 39 msgstr "Nelze analyzovat program." 13 40 14 41 #: source.sindexerror … … 34 61 msgstr "Ano" 35 62 63 #: tformconsole.caption 64 msgctxt "tformconsole.caption" 65 msgid "Console" 66 msgstr "Konzola" 67 36 68 #: tformmain.acompile.caption 37 69 msgid "Compile" 38 70 msgstr "PÅeloÅŸit" 71 72 #: tformmain.aconsole.caption 73 msgctxt "tformmain.aconsole.caption" 74 msgid "Console" 75 msgstr "Konzola" 39 76 40 77 #: tformmain.aexit.caption -
branches/xpascal/Languages/xpascal.pot
r228 r230 1 1 msgid "" 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 4 #: executor.sexpectedbooleanvalue 5 msgid "Expected boolean value." 6 msgstr "" 7 8 #: executor.sunsupportedcommandtype 9 msgid "Unsupported command type." 10 msgstr "" 11 12 #: executor.sunsupportedoperandtype 13 msgid "Unsupported exception operand type." 14 msgstr "" 15 16 #: generatorxml.sunsupportednodetype 17 msgctxt "generatorxml.sunsupportednodetype" 18 msgid "Unsupported node type" 19 msgstr "" 20 21 #: optimizer.sunsupportednodetype 22 msgctxt "optimizer.sunsupportednodetype" 23 msgid "Unsupported node type" 24 msgstr "" 25 26 #: parser.scannotparseprogram 27 msgid "Cannot parse program." 28 msgstr "" 3 29 4 30 #: source.sindexerror … … 24 50 msgstr "" 25 51 52 #: tformconsole.caption 53 msgctxt "tformconsole.caption" 54 msgid "Console" 55 msgstr "" 56 26 57 #: tformmain.acompile.caption 27 58 msgid "Compile" 59 msgstr "" 60 61 #: tformmain.aconsole.caption 62 msgctxt "tformmain.aconsole.caption" 63 msgid "Console" 28 64 msgstr "" 29 65 -
branches/xpascal/Optimizer.pas
r224 r230 14 14 TOptimizer = class 15 15 private 16 procedure OptimizeNodes(SourceNodes: TSourceNode s; out NewNode: TSourceNode);16 procedure OptimizeNodes(SourceNodes: TSourceNodeList<TSourceNode>; out NewNode: TSourceNode); 17 17 procedure OptimizeNode(SourceNode: TSourceNode; out NewNode: TSourceNode); 18 18 public … … 24 24 implementation 25 25 26 resourcestring 27 SUnsupportedNodeType = 'Unsupported node type'; 28 26 29 { TOptimizer } 27 30 28 procedure TOptimizer.OptimizeNodes(SourceNodes: TSourceNode s; out31 procedure TOptimizer.OptimizeNodes(SourceNodes: TSourceNodeList<TSourceNode>; out 29 32 NewNode: TSourceNode); 30 33 var … … 38 41 SourceNodes[I] := TempNewNode; 39 42 end; 40 end else raise Exception.Create( 'Unsupported node type');43 end else raise Exception.Create(SUnsupportedNodeType); 41 44 end; 42 45 end; … … 56 59 if SourceNode = nil then begin 57 60 end else 58 if SourceNode is TSourceNode sthen begin59 OptimizeNodes(TSourceNode s(SourceNode), NewNode)61 if SourceNode is TSourceNodeList<TSourceNode> then begin 62 OptimizeNodes(TSourceNodeList<TSourceNode>(SourceNode), NewNode) 60 63 end else 61 64 if (ofReplaceRepeatUntilByWhileDo in Features) and (SourceNode is TRepeatUntil) then begin … … 109 112 end; 110 113 end else 111 raise Exception.Create( 'Unsupported node type');114 raise Exception.Create(SUnsupportedNodeType); 112 115 end; 113 116 -
branches/xpascal/Packages/Common/Languages
-
Property svn:ignore
set to
*.mo
-
Property svn:ignore
set to
-
branches/xpascal/Parser.pas
r225 r230 31 31 implementation 32 32 33 resourcestring 34 SCannotParseProgram = 'Cannot parse program.'; 35 33 36 { TParser } 34 37 … … 188 191 ResultType := TypeInteger; 189 192 end; 193 with Block.Functions.AddNew('BoolToStr') do begin 194 InternalName := 'BoolToStr'; 195 Params.AddNew('Value', TypeBoolean); 196 ResultType := TypeString; 197 end; 198 with Block.Functions.AddNew('StrToBool') do begin 199 InternalName := 'StrToBool'; 200 Params.AddNew('Value', TypeString); 201 ResultType := TypeBoolean; 202 end; 190 203 with Block.Functions.AddNew('WriteLn') do begin 191 204 InternalName := 'WriteLn'; … … 195 208 InternalName := 'Write'; 196 209 Params.AddNew('Text', TypeString); 210 end; 211 with Block.Functions.AddNew('ReadLn') do begin 212 InternalName := 'ReadLn'; 213 with Params.AddNew('Text', TypeString) do 214 Kind := pkVar; 215 end; 216 with Block.Functions.AddNew('Read') do begin 217 InternalName := 'Read'; 218 with Params.AddNew('Text', TypeString) do 219 Kind := pkVar; 197 220 end; 198 221 end; … … 214 237 if ParseProgram(SystemBlock, NewProg) then begin 215 238 Prog := NewProg; 216 end else Tokenizer.Error( 'Cannot parse program.');239 end else Tokenizer.Error(SCannotParseProgram); 217 240 end; 218 241 -
branches/xpascal/Parsers/ParserPascal.pas
r224 r230 347 347 Token: TToken; 348 348 TypeRef: TType; 349 ParamKind: TFunctionParamKind; 349 350 begin 350 351 Result := True; 352 if Tokenizer.CheckNext('var', tkKeyword) then begin 353 Tokenizer.GetNext; 354 ParamKind := pkVar; 355 end; 351 356 Token := Tokenizer.GetNext; 352 357 if Token.Kind = tkIdentifier then begin 353 358 Parameter := TFunctionParameter.Create; 359 Parameter.Kind := ParamKind; 354 360 Parameter.Name := Token.Text; 355 361 Tokenizer.Expect(':', tkSpecialSymbol); -
branches/xpascal/Source.pas
r224 r230 4 4 5 5 uses 6 Classes, SysUtils, Contnrs;6 Classes, SysUtils, Generics.Collections; 7 7 8 8 type … … 24 24 end; 25 25 26 TFields = class(TObjectList )26 TFields = class(TObjectList<TField>) 27 27 end; 28 28 … … 50 50 end; 51 51 52 { TSourceNode s}53 54 TSourceNode s= class(TSourceNode)52 { TSourceNodeList } 53 54 TSourceNodeList<T> = class(TSourceNode) 55 55 private 56 56 Parent: TSourceNode; 57 57 function GetCount: Integer; 58 function GetItem(Index: Integer): T Object;59 procedure SetItem(Index: Integer; AValue: T Object);60 public 61 List: TObjectList ;58 function GetItem(Index: Integer): T; 59 procedure SetItem(Index: Integer; AValue: T); 60 public 61 List: TObjectList<TSourceNode>; 62 62 procedure Clear; 63 function Add(AObject: T Object): Integer;63 function Add(AObject: T): Integer; 64 64 constructor Create; 65 65 destructor Destroy; override; 66 property Items[Index: Integer]: T Objectread GetItem write SetItem; default;66 property Items[Index: Integer]: T read GetItem write SetItem; default; 67 67 property Count: Integer read GetCount; 68 68 end; … … 115 115 { TTypes } 116 116 117 TTypes = class(TSourceNode s)117 TTypes = class(TSourceNodeList<TType>) 118 118 function SearchByName(Name: string): TType; 119 119 function AddNew(Name: string): TType; … … 136 136 { TVariables } 137 137 138 TVariables = class(TSourceNode s)138 TVariables = class(TSourceNodeList<TVariable>) 139 139 function SearchByName(Name: string): TVariable; 140 140 end; … … 157 157 { TConstants } 158 158 159 TConstants = class(TSourceNode s)159 TConstants = class(TSourceNodeList<TConstant>) 160 160 function SearchByName(Name: string): TConstant; 161 161 function AddNew(Name: string): TConstant; 162 162 end; 163 164 TFunctionParamKind = (pkNormal, pkVar, pkConst); 163 165 164 166 TFunctionParameter = class(TSourceNode) 165 167 Name: string; 166 168 TypeRef: TType; 169 Kind: TFunctionParamKind; 167 170 end; 168 171 169 172 { TFunctionParameters } 170 173 171 TFunctionParameters = class(TSourceNode s)174 TFunctionParameters = class(TSourceNodeList<TFunctionParameter>) 172 175 function SearchByName(Name: string): TFunctionParameter; 173 176 function AddNew(Name: string; TypeRef: TType): TFunctionParameter; … … 195 198 { TFunctions } 196 199 197 TFunctions = class(TSourceNode s)200 TFunctions = class(TSourceNodeList<TFunction>) 198 201 ParentType: TType; 199 202 function SearchByName(Name: string): TFunction; … … 204 207 end; 205 208 206 TCommands = class(TSourceNode s)209 TCommands = class(TSourceNodeList<TCommand>) 207 210 end; 208 211 … … 302 305 end; 303 306 304 TExpressions = class(TSourceNode s)307 TExpressions = class(TSourceNodeList<TExpression>) 305 308 end; 306 309 … … 565 568 end; 566 569 567 { TSourceNode s}568 569 function TSourceNode s.GetCount: Integer;570 { TSourceNodeList } 571 572 function TSourceNodeList<T>.GetCount: Integer; 570 573 begin 571 574 Result := List.Count; 572 575 end; 573 576 574 function TSourceNode s.GetItem(Index: Integer): TObject;575 begin 576 Result := List[Index];577 end; 578 579 procedure TSourceNode s.SetItem(Index: Integer; AValue: TObject);577 function TSourceNodeList<T>.GetItem(Index: Integer): T; 578 begin 579 Result := T(List[Index]); 580 end; 581 582 procedure TSourceNodeList<T>.SetItem(Index: Integer; AValue: T); 580 583 begin 581 584 List[Index] := AValue; 582 585 end; 583 586 584 procedure TSourceNode s.Clear;587 procedure TSourceNodeList<T>.Clear; 585 588 begin 586 589 List.Clear; 587 590 end; 588 591 589 function TSourceNode s.Add(AObject: TObject): Integer;592 function TSourceNodeList<T>.Add(AObject: T): Integer; 590 593 begin 591 594 Result := List.Add(AObject); 592 595 end; 593 596 594 constructor TSourceNode s.Create;595 begin 596 List := TObjectList .Create;597 end; 598 599 destructor TSourceNode s.Destroy;597 constructor TSourceNodeList<T>.Create; 598 begin 599 List := TObjectList<TSourceNode>.Create; 600 end; 601 602 destructor TSourceNodeList<T>.Destroy; 600 603 begin 601 604 FreeAndNil(List); … … 1095 1098 procedure TExpressionOperation.SetValue(Index: Integer; var Value); 1096 1099 begin 1097 Items[Index] := T Object(Value);1100 Items[Index] := TExpression(Value); 1098 1101 end; 1099 1102 -
branches/xpascal/xpascal.lpi
r229 r230 85 85 </Item3> 86 86 </RequiredPackages> 87 <Units Count="1 8">87 <Units Count="19"> 88 88 <Unit0> 89 89 <Filename Value="xpascal.lpr"/> … … 170 170 <IsPartOfProject Value="True"/> 171 171 </Unit17> 172 <Unit18> 173 <Filename Value="Forms/FormConsole.pas"/> 174 <IsPartOfProject Value="True"/> 175 <ComponentName Value="FormConsole"/> 176 <HasResources Value="True"/> 177 <ResourceBaseClass Value="Form"/> 178 </Unit18> 172 179 </Units> 173 180 </ProjectOptions> -
branches/xpascal/xpascal.lpr
r229 r230 10 10 Forms, Parser, Tokenizer, Source, Executor, Interpreter, Generator, 11 11 FormMessages, FormSource, Optimizer, FormOutput, FormMain, 12 ParserPascal, Tests ;12 ParserPascal, Tests, FormConsole; 13 13 14 14 {$R *.res}
Note:
See TracChangeset
for help on using the changeset viewer.