Changeset 230


Ignore:
Timestamp:
Jun 26, 2023, 12:08:45 PM (10 months ago)
Author:
chronos
Message:
  • Added: Var function parameters support.
  • Added: Read and ReadLn procedures support.
  • Added: Interpreter now prints into console form.
Location:
branches/xpascal
Files:
11 added
1 deleted
19 edited

Legend:

Unmodified
Added
Removed

  • branches/xpascal/Executor.pas

    r229 r230  
    44
    55uses
    6   Classes, SysUtils, Source, Contnrs;
     6  Classes, SysUtils, Source, Generics.Collections;
    77
    88type
    … …  
    2121  { TExecutorVariables }
    2222
    23   TExecutorVariables = class(TObjectList)
     23  TExecutorVariables = class(TObjectList<TExecutorVariable>)
    2424    function SearchByVariable(Variable: TVariable): TExecutorVariable;
    2525    function AddNew(Variable: TVariable): TExecutorVariable;
    … …  
    3737  { TExecutorTypes }
    3838
    39   TExecutorTypes = class(TObjectList)
     39  TExecutorTypes = class(TObjectList<TExecutorType>)
    4040    function SearchByType(TypeRef: TType): TExecutorType;
    4141    function AddNew(TypeRef: TType): TExecutorType;
    4242  end;
    4343
    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;
    4555
    4656  { TExecutorFunction }
    … …  
    5666  { TExecutorFunctions }
    5767
    58   TExecutorFunctions = class(TObjectList)
     68  TExecutorFunctions = class(TObjectList<TExecutorFunction>)
    5969    function SearchByFunction(FunctionDef: TFunction): TExecutorFunction;
    6070    function AddNew(FunctionDef: TFunction): TExecutorFunction;
    … …  
    7888
    7989  TOutputEvent = procedure (Text: string) of object;
     90  TInputEvent = function: string of object;
    8091
    8192  { TExecutor }
    … …  
    8495  private
    8596    FOnOutput: TOutputEvent;
     97    FOnInput: TInputEvent;
    8698    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;
    116132    procedure InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock);
    117133  public
    … …  
    135151    procedure Run;
    136152    procedure Output(Text: string);
     153    function Input: string;
    137154    property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
     155    property OnInput: TInputEvent read FOnInput write FOnInput;
    138156  end;
    139157
    140158
    141159implementation
     160
     161resourcestring
     162  SUnsupportedOperandType = 'Unsupported exception operand type.';
     163  SUnsupportedCommandType = 'Unsupported command type.';
     164  SExpectedBooleanValue = 'Expected boolean value.';
     165
     166{ TExecutorFunctionCallbackParam }
     167
     168destructor TExecutorFunctionCallbackParam.Destroy;
     169begin
     170  FreeAndNil(Value);
     171  inherited;
     172end;
    142173
    143174{ TExecutorFunction }
    … …  
    293324{ TExecutor }
    294325
    295 function TExecutor.ExecuteWriteLn(Params: array of TValue): TValue;
     326function TExecutor.ExecuteWriteLn(Params: array of TExecutorFunctionCallbackParam): TValue;
    296327var
    297328  I: Integer;
    … …  
    301332  Text := '';
    302333  for I := 0 to Length(Params) - 1 do
    303     Text := Text + TValueString(Params[I]).Value;
     334    Text := Text + TValueString(Params[I].Value).Value;
    304335  Output(Text + LineEnding);
    305336end;
    306337
    307 function TExecutor.ExecuteWrite(Params: array of TValue): TValue;
     338function TExecutor.ExecuteWrite(Params: array of TExecutorFunctionCallbackParam): TValue;
    308339var
    309340  I: Integer;
    … …  
    313344  Text := '';
    314345  for I := 0 to Length(Params) - 1 do
    315     Text := Text + TValueString(Params[I]).Value;
     346    Text := Text + TValueString(Params[I].Value).Value;
    316347  Output(Text);
    317348end;
    318349
    319 function TExecutor.ExecuteIntToStr(Params: array of TValue): TValue;
     350function TExecutor.ExecuteReadLn(Params: array of TExecutorFunctionCallbackParam): TValue;
     351var
     352  I: Integer;
     353begin
     354  Result := nil;
     355  for I := 0 to Length(Params) - 1 do
     356    TValueString(Params[I].Variable.Value).Value := Input;
     357  Output(LineEnding);
     358end;
     359
     360function TExecutor.ExecuteRead(Params: array of TExecutorFunctionCallbackParam): TValue;
     361var
     362  I: Integer;
     363begin
     364  Result := nil;
     365  for I := 0 to Length(Params) - 1 do
     366    TValueString(Params[I].Value).Value := Input;
     367end;
     368
     369function TExecutor.ExecuteIntToStr(Params: array of TExecutorFunctionCallbackParam): TValue;
    320370begin
    321371  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);
     373end;
     374
     375function TExecutor.ExecuteStrToInt(Params: array of TExecutorFunctionCallbackParam): TValue;
     376begin
     377  Result := TValueInteger.Create;
     378  TValueInteger(Result).Value := StrToInt(TValueString(Params[0].Value).Value);
     379end;
     380
     381function TExecutor.ExecuteBoolToStr(Params: array of TExecutorFunctionCallbackParam): TValue;
    356382begin
    357383  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);
     385end;
     386
     387function TExecutor.ExecuteStrToBool(Params: array of TExecutorFunctionCallbackParam): TValue;
     388begin
     389  Result := TValueBoolean.Create;
     390  TValueBoolean(Result).Value := StrToBool(TValueString(Params[0].Value).Value);
     391end;
     392
     393function TExecutor.ExecuteBooleanAssign(Params: array of TExecutorFunctionCallbackParam): TValue;
     394begin
     395  Result := TValueBoolean.Create;
     396  TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value;
     397end;
     398
     399function TExecutor.ExecuteBooleanNot(Params: array of TExecutorFunctionCallbackParam): TValue;
     400begin
     401  Result := TValueBoolean.Create;
     402  TValueBoolean(Result).Value := not TValueBoolean(Params[0].Value).Value;
     403end;
     404
     405function TExecutor.ExecuteBooleanEqual(Params: array of TExecutorFunctionCallbackParam): TValue;
     406begin
     407  Result := TValueBoolean.Create;
     408  TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value =
     409    TValueBoolean(Params[1].Value).Value;
     410end;
     411
     412function TExecutor.ExecuteBooleanNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue;
     413begin
     414  Result := TValueBoolean.Create;
     415  TValueBoolean(Result).Value := TValueBoolean(Params[0].Value).Value <>
     416    TValueBoolean(Params[1].Value).Value;
     417end;
     418
     419function TExecutor.ExecuteStringAssign(Params: array of TExecutorFunctionCallbackParam): TValue;
    362420begin
    363421  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;
     423end;
     424
     425function TExecutor.ExecuteStringAdd(Params: array of TExecutorFunctionCallbackParam): TValue;
     426begin
     427  Result := TValueString.Create;
     428  TValueString(Result).Value := TValueString(Params[0].Value).Value +
     429    TValueString(Params[1].Value).Value;
     430end;
     431
     432function TExecutor.ExecuteStringEqual(Params: array of TExecutorFunctionCallbackParam): TValue;
     433begin
     434  Result := TValueBoolean.Create;
     435  TValueBoolean(Result).Value := TValueString(Params[0].Value).Value =
     436    TValueString(Params[1].Value).Value;
     437end;
     438
     439function TExecutor.ExecuteStringNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue;
     440begin
     441  Result := TValueBoolean.Create;
     442  TValueBoolean(Result).Value := TValueString(Params[0].Value).Value <>
     443    TValueString(Params[1].Value).Value;
     444end;
     445
     446function TExecutor.ExecuteIntegerAssign(Params: array of TExecutorFunctionCallbackParam): TValue;
     447begin
     448  Result := TValueInteger.Create;
     449  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value;
     450end;
     451
     452function TExecutor.ExecuteIntegerAdd(Params: array of TExecutorFunctionCallbackParam): TValue;
     453begin
     454  Result := TValueInteger.Create;
     455  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value +
     456    TValueInteger(Params[1].Value).Value;
     457end;
     458
     459function TExecutor.ExecuteIntegerSub(Params: array of TExecutorFunctionCallbackParam): TValue;
     460begin
     461  Result := TValueInteger.Create;
     462  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value -
     463    TValueInteger(Params[1].Value).Value;
     464end;
     465
     466function TExecutor.ExecuteIntegerMul(Params: array of TExecutorFunctionCallbackParam): TValue;
     467begin
     468  Result := TValueInteger.Create;
     469  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value *
     470    TValueInteger(Params[1].Value).Value;
     471end;
     472
     473function TExecutor.ExecuteIntegerIntDiv(Params: array of TExecutorFunctionCallbackParam): TValue;
     474begin
     475  Result := TValueInteger.Create;
     476  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value div
     477    TValueInteger(Params[1].Value).Value;
     478end;
     479
     480function TExecutor.ExecuteIntegerMod(Params: array of TExecutorFunctionCallbackParam): TValue;
     481begin
     482  Result := TValueInteger.Create;
     483  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value mod
     484    TValueInteger(Params[1].Value).Value;
     485end;
     486
     487function TExecutor.ExecuteIntegerEqual(Params: array of TExecutorFunctionCallbackParam): TValue;
     488begin
     489  Result := TValueBoolean.Create;
     490  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value =
     491    TValueInteger(Params[1].Value).Value;
     492end;
     493
     494function TExecutor.ExecuteIntegerNotEqual(Params: array of TExecutorFunctionCallbackParam): TValue;
     495begin
     496  Result := TValueBoolean.Create;
     497  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value <>
     498    TValueInteger(Params[1].Value).Value;
     499end;
     500
     501function TExecutor.ExecuteIntegerLesser(Params: array of TExecutorFunctionCallbackParam): TValue;
     502begin
     503  Result := TValueBoolean.Create;
     504  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value <
     505    TValueInteger(Params[1].Value).Value;
     506end;
     507
     508function TExecutor.ExecuteIntegerHigher(Params: array of TExecutorFunctionCallbackParam): TValue;
     509begin
     510  Result := TValueBoolean.Create;
     511  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value >
     512    TValueInteger(Params[1].Value).Value;
     513end;
     514
     515function TExecutor.ExecuteIntegerLesserOrEqual(Params: array of TExecutorFunctionCallbackParam): TValue;
     516begin
     517  Result := TValueBoolean.Create;
     518  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value <=
     519    TValueInteger(Params[1].Value).Value;
     520end;
     521
     522function TExecutor.ExecuteIntegerHigherOrEqual(Params: array of TExecutorFunctionCallbackParam): TValue;
     523begin
     524  Result := TValueBoolean.Create;
     525  TValueBoolean(Result).Value := TValueInteger(Params[0].Value).Value >=
     526    TValueInteger(Params[1].Value).Value;
     527end;
     528
     529function TExecutor.ExecuteIntegerAnd(Params: array of TExecutorFunctionCallbackParam): TValue;
     530begin
     531  Result := TValueInteger.Create;
     532  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value and
     533    TValueInteger(Params[1].Value).Value;
     534end;
     535
     536function TExecutor.ExecuteIntegerOr(Params: array of TExecutorFunctionCallbackParam): TValue;
     537begin
     538  Result := TValueInteger.Create;
     539  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value or
     540    TValueInteger(Params[1].Value).Value;
     541end;
     542
     543function TExecutor.ExecuteIntegerXor(Params: array of TExecutorFunctionCallbackParam): TValue;
     544begin
     545  Result := TValueInteger.Create;
     546  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value xor
     547    TValueInteger(Params[1].Value).Value;
     548end;
     549
     550function TExecutor.ExecuteIntegerShr(Params: array of TExecutorFunctionCallbackParam): TValue;
     551begin
     552  Result := TValueInteger.Create;
     553  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value shr
     554    TValueInteger(Params[1].Value).Value;
     555end;
     556
     557function TExecutor.ExecuteIntegerShl(Params: array of TExecutorFunctionCallbackParam): TValue;
     558begin
     559  Result := TValueInteger.Create;
     560  TValueInteger(Result).Value := TValueInteger(Params[0].Value).Value shl
     561    TValueInteger(Params[1].Value).Value;
    479562end;
    480563
    … …  
    582665    if ExecutorFunction.FunctionDef.Name = 'WriteLn' then begin
    583666      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
    585674    if ExecutorFunction.FunctionDef.Name = 'IntToStr' then begin
    586675      ExecutorFunction.Callback := ExecuteIntToStr;
    … …  
    588677    if ExecutorFunction.FunctionDef.Name = 'StrToInt' then begin
    589678      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;
    590685    end;
    591686  end;
    … …  
    620715  else if Command is TContinue then ExecuteContinue(Block, TContinue(Command))
    621716  else if Command is TEmptyCommand then
    622   else raise Exception.Create('Unsupported command type');
     717  else raise Exception.Create(SUnsupportedCommandType);
    623718end;
    624719
    … …  
    635730          ExecuteCommand(Block, IfThenElse.CommandElse);
    636731      end;
    637   end else raise Exception.Create('Expected boolean value.');
     732  end else raise Exception.Create(SExpectedBooleanValue);
    638733  Value.Free;
    639734end;
    … …  
    659754        Break;
    660755      end;
    661     end else raise Exception.Create('Expected boolean value.');
     756    end else raise Exception.Create(SExpectedBooleanValue);
    662757  end;
    663758end;
    … …  
    687782      Value.Free;
    688783      if BoolValue then Break;
    689     end else raise Exception.Create('Expected boolean value.');
     784    end else raise Exception.Create(SExpectedBooleanValue);
    690785  end;
    691786end;
    … …  
    760855var
    761856  ExecutorFunction: TExecutorFunction;
    762   Params: array of TValue;
     857  Params: array of TExecutorFunctionCallbackParam;
    763858  I: Integer;
    764859  ExecutorVariable: TExecutorVariable;
    … …  
    771866      SetLength(Params, FunctionCall.Params.Count);
    772867      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]);
    774877      end;
    775878      Result := ExecutorFunction.Callback(Params);
    776879      for I := 0 to FunctionCall.Params.Count - 1 do begin
     880        //if FunctionCall.Params[I].
    777881        Params[I].Free;
    778882      end;
    … …  
    798902  Variable: TExecutorVariable;
    799903  ExecutorFunction: TExecutorFunction;
    800   Params: array of TValue;
     904  Params: array of TExecutorFunctionCallbackParam;
    801905begin
    802906  Value := ExecuteExpression(Block, Assignment.Expression);
    … …  
    805909  if Assignment.Variable.TypeRef = Assignment.Expression.GetType then begin;
    806910    SetLength(Params, 1);
    807     Params[0] := Value;
     911    Params[0] := TExecutorFunctionCallbackParam.Create;
     912    Params[0].Value := Value;
    808913    Variable.Value.Free;
    809914    Variable.Value := ExecutorFunction.Callback(Params);
    … …  
    834939  Value: TValue;
    835940  ExecutorFunction: TExecutorFunction;
    836   Params: array of TValue;
     941  Params: array of TExecutorFunctionCallbackParam;
    837942  FuncName: string;
    838943begin
    … …  
    846951  for I := 0 to Expression.Items.Count - 1 do begin
    847952    Value := ExecuteExpression(Block, TExpression(Expression.Items[I]));
    848     Params[I] := Value;
     953    Params[I] := TExecutorFunctionCallbackParam.Create;
     954    Params[I].Value := Value;
    849955  end;
    850956  Result := ExecutorFunction.Callback(Params);
    … …  
    862968    otConstantRef: Result := Expression.ConstantRef.Value.Clone;
    863969    otVariableRef: Result := Block.Variables.SearchByVariable(Expression.VariableRef).Value.Clone;
    864     else raise Exception.Create('Unsupported exception operand type.');
     970    else raise Exception.Create(SUnsupportedOperandType);
    865971  end;
    866972end;
    … …  
    883989end;
    884990
     991function TExecutor.Input: string;
     992begin
     993  if Assigned(FOnInput) then
     994    Result := FOnInput;
     995end;
     996
    885997end.
    886998

  • branches/xpascal/Forms/FormMain.lfm

    r229 r230  
    11object FormMain: TFormMain
    2   Left = 482
     2  Left = 534
    33  Height = 993
    4   Top = 205
     4  Top = 223
    55  Width = 1491
    66  Caption = 'Interpreter'
    … …  
    125125      ShortCut = 122
    126126    end
     127    object AConsole: TAction
     128      Caption = 'Console'
     129      OnExecute = AConsoleExecute
     130    end
    127131  end
    128132end

  • branches/xpascal/Forms/FormMain.lrj

    r227 r230  
    1212{"hash":315140,"name":"tformmain.aexit.caption","sourcebytes":[69,120,105,116],"value":"Exit"},
    1313{"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"}
    1516]}

  • branches/xpascal/Forms/FormMain.pas

    r229 r230  
    66  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus,
    77  ActnList, ExtCtrls, SynHighlighterPas, SynEdit, Source, Optimizer,
    8   Generator, FormSource, FormMessages, FormOutput, FormEx;
     8  Generator, FormSource, FormMessages, FormOutput, FormConsole, FormEx;
    99
    1010type
    … …  
    1414  TFormMain = class(TFormEx)
    1515    ACompile: TAction;
     16    AConsole: TAction;
    1617    ATest: TAction;
    1718    AGenerateXml: TAction;
    … …  
    4041    Splitter1: TSplitter;
    4142    procedure ACompileExecute(Sender: TObject);
     43    procedure AConsoleExecute(Sender: TObject);
    4244    procedure AExitExecute(Sender: TObject);
    4345    procedure AGenerateCSharpExecute(Sender: TObject);
    … …  
    5860    FormMessages: TFormMessages;
    5961    FormOutput: TFormOutput;
     62    FormConsole: TFormConsole;
    6063    procedure Generate(GeneratorClass: TGeneratorClass);
    6164    procedure ExecutorOutput(Text: string);
     65    function ExecutorInput: string;
    6266    procedure InterpreterError(Pos: TPoint; Text: string);
    6367    procedure UpdateInterface;
    … …  
    8387  if not Initialized then begin
    8488    Initialized := True;
    85     FormSource.SynEditSource.Lines.LoadFromFile('Test.pas');
     89    FormSource.SynEditSource.Lines.LoadFromFile('Examples' + DirectorySeparator +
     90      'Example.pas');
    8691    ARun.Execute;
    8792  end;
    … …  
    9499  if Assigned(FormMessages) then FreeAndNil(FormMessages);
    95100  if Assigned(FormOutput) then FreeAndNil(FormOutput);
     101  if Assigned(FormConsole) then FreeAndNil(FormConsole);
    96102end;
    97103
    … …  
    107113  FormOutput.Show;
    108114  DockForm(FormOutput, PanelOutput);
     115  FormConsole := TFormConsole.Create(nil);
     116  FormConsole.Show;
     117  DockForm(FormConsole, PanelOutput);
    109118  UpdateInterface;
    110119end;
    … …  
    121130    FormOutput.SetText(Generator.Output);
    122131    TargetFileName := 'Generated' + DirectorySeparator +
    123       Generator.Name + DirectorySeparator + 'Test' + Generator.FileExt;
     132      Generator.Name + DirectorySeparator + 'Example' + Generator.FileExt;
    124133    ForceDirectories(ExtractFileDir(TargetFileName));
    125134    FormOutput.SynEditOutput.Lines.SaveToFile(TargetFileName);
    … …  
    152161end;
    153162
     163procedure TFormMain.AConsoleExecute(Sender: TObject);
     164begin
     165
     166end;
     167
    154168procedure TFormMain.AGenerateCSharpExecute(Sender: TObject);
    155169begin
    … …  
    161175    Generate(TGeneratorCSharp);
    162176  end;
     177  DockForm(FormOutput, PanelOutput);
    163178end;
    164179
    … …  
    171186    Generate(TGeneratorPascal);
    172187  end;
     188  DockForm(FormOutput, PanelOutput);
    173189end;
    174190
    … …  
    182198    Generate(TGeneratorPhp);
    183199  end;
     200  DockForm(FormOutput, PanelOutput);
    184201end;
    185202
    … …  
    192209    Generate(TGeneratorXml);
    193210  end;
     211  DockForm(FormOutput, PanelOutput);
    194212end;
    195213
    … …  
    236254    Executor.Prog := Prog;
    237255    Executor.OnOutput := ExecutorOutput;
     256    Executor.OnInput := ExecutorInput;
    238257    Executor.Run;
    239258    Executor.Free;
    240259  end;
     260  DockForm(FormConsole, PanelOutput);
     261  FormConsole.Memo1.SetFocus;
    241262end;
    242263
    … …  
    259280procedure TFormMain.ExecutorOutput(Text: string);
    260281begin
    261   FormOutput.SynEditOutput.Text := FormOutput.SynEditOutput.Text + Text;
     282  FormConsole.Memo1.Text := FormConsole.Memo1.Text + Text;
     283end;
     284
     285function TFormMain.ExecutorInput: string;
     286begin
     287  Result := FormConsole.GetInputString;
    262288end;
    263289

  • branches/xpascal/Forms/FormOutput.lfm

    r227 r230  
    11object FormOutput: TFormOutput
    2   Left = 607
     2  Left = 563
    33  Height = 544
    4   Top = 252
     4  Top = 339
    55  Width = 932
    66  Caption = 'Output'

  • branches/xpascal/Generators/GeneratorCSharp.pas

    r224 r230  
    129129  if FunctionCall.Params.Count > 0 then begin
    130130    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 ');
    132134      GenerateExpression(Block, TExpression(FunctionCall.Params[I]));
     135    end;
    133136    AddText(')');
    134137  end;
    … …  
    297300var
    298301  I: Integer;
     302  Param: TFunctionParameter;
    299303begin
    300304  GenerateTypeRef(FunctionDef.ResultType);
    301305  AddText(' ' + FunctionDef.Name + '(');
    302306  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);
    304310    AddText(' ');
    305     AddText(TFunctionParameter(FunctionDef.Params[I]).Name);
     311    AddText(Param.Name);
    306312    if I > 0 then AddText(', ');
    307313  end;
    … …  
    312318    if FunctionDef.InternalName = 'WriteLn' then AddTextLine('Console.Write(Text + "\n");')
    313319    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();')
    314322    else if FunctionDef.InternalName = 'IntToStr' then AddTextLine('return Value.ToString();')
    315323    else if FunctionDef.InternalName = 'StrToInt' then begin
    … …  
    319327      AddTextLine('  return x;');
    320328      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;');
    321337    end;
    322338

  • branches/xpascal/Generators/GeneratorPascal.pas

    r224 r230  
    231231    else if FunctionDef.InternalName = 'Write' then AddTextLine('System.Write(Text);')
    232232    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);');
    234236    Indent := Indent - 1;
    235237    AddTextLine('end;');

  • branches/xpascal/Generators/GeneratorPhp.pas

    r224 r230  
    241241    else if FunctionDef.InternalName = 'Write' then AddTextLine('echo($Text);')
    242242    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;');
    244246    Indent := Indent - 1;
    245247    AddTextLine('}');

  • branches/xpascal/Generators/GeneratorXml.pas

    r224 r230  
    1111  TGeneratorXml = class(TGenerator)
    1212  private
    13     procedure GenerateNodes(SourceNodes: TSourceNodes);
     13    procedure GenerateNodes(SourceNodes: TSourceNodeList<TSourceNode>);
    1414    procedure GenerateNode(SourceNode: TSourceNode);
    1515  public
    … …  
    2121implementation
    2222
     23resourcestring
     24  SUnsupportedNodeType = 'Unsupported node type';
     25
    2326{ TGeneratorXml }
    2427
    25 procedure TGeneratorXml.GenerateNodes(SourceNodes: TSourceNodes);
     28procedure TGeneratorXml.GenerateNodes(SourceNodes: TSourceNodeList<TSourceNode>);
    2629var
    2730  I: Integer;
    … …  
    3033    if SourceNodes[I] is TSourceNode then begin
    3134      GenerateNode(TSourceNode(SourceNodes[I]));
    32     end else raise Exception.Create('Unsupported node type');
     35    end else raise Exception.Create(SUnsupportedNodeType);
    3336  end;
    3437end;
    … …  
    4245  if SourceNode = nil then begin
    4346  end else
    44   if SourceNode is TSourceNodes then begin
    45     GenerateNodes(TSourceNodes(SourceNode))
     47  if SourceNode is TSourceNodeList<TSourceNode> then begin
     48    GenerateNodes(TSourceNodeList<TSourceNode>(SourceNode))
    4649  end else
    4750  if SourceNode is TSourceNode then begin
    … …  
    6366    AddTextLine('</' + SourceNode.ClassName + '>');
    6467  end else
    65     raise Exception.Create('Unsupported node type');
     68    raise Exception.Create(SUnsupportedNodeType);
    6669end;
    6770

  • branches/xpascal/Languages

    • Property svn:ignore set to
      *.mo

  • branches/xpascal/Languages/xpascal.cs.po

    r228 r230  
    1111"Content-Transfer-Encoding: 8bit\n"
    1212"X-Generator: Poedit 3.0.1\n"
     13
     14#: executor.sexpectedbooleanvalue
     15msgid "Expected boolean value."
     16msgstr "Očekávána Boolean hodnota."
     17
     18#: executor.sunsupportedcommandtype
     19msgid "Unsupported command type."
     20msgstr "NepodporovanÃœ typ příkazu."
     21
     22#: executor.sunsupportedoperandtype
     23msgid "Unsupported exception operand type."
     24msgstr "NepodporovanÃœ typ vÃœjimky operandu."
     25
     26#: generatorxml.sunsupportednodetype
     27#, fuzzy
     28msgctxt "generatorxml.sunsupportednodetype"
     29msgid "Unsupported node type"
     30msgstr "NepodporovanÃœ typ uzlu"
     31
     32#: optimizer.sunsupportednodetype
     33msgctxt "optimizer.sunsupportednodetype"
     34msgid "Unsupported node type"
     35msgstr "NepodporovanÃœ typ uzlu"
     36
     37#: parser.scannotparseprogram
     38msgid "Cannot parse program."
     39msgstr "Nelze analyzovat program."
    1340
    1441#: source.sindexerror
    … …  
    3461msgstr "Ano"
    3562
     63#: tformconsole.caption
     64msgctxt "tformconsole.caption"
     65msgid "Console"
     66msgstr "Konzola"
     67
    3668#: tformmain.acompile.caption
    3769msgid "Compile"
    3870msgstr "PřeloÅŸit"
     71
     72#: tformmain.aconsole.caption
     73msgctxt "tformmain.aconsole.caption"
     74msgid "Console"
     75msgstr "Konzola"
    3976
    4077#: tformmain.aexit.caption

  • branches/xpascal/Languages/xpascal.pot

    r228 r230  
    11msgid ""
    22msgstr "Content-Type: text/plain; charset=UTF-8"
     3
     4#: executor.sexpectedbooleanvalue
     5msgid "Expected boolean value."
     6msgstr ""
     7
     8#: executor.sunsupportedcommandtype
     9msgid "Unsupported command type."
     10msgstr ""
     11
     12#: executor.sunsupportedoperandtype
     13msgid "Unsupported exception operand type."
     14msgstr ""
     15
     16#: generatorxml.sunsupportednodetype
     17msgctxt "generatorxml.sunsupportednodetype"
     18msgid "Unsupported node type"
     19msgstr ""
     20
     21#: optimizer.sunsupportednodetype
     22msgctxt "optimizer.sunsupportednodetype"
     23msgid "Unsupported node type"
     24msgstr ""
     25
     26#: parser.scannotparseprogram
     27msgid "Cannot parse program."
     28msgstr ""
    329
    430#: source.sindexerror
    … …  
    2450msgstr ""
    2551
     52#: tformconsole.caption
     53msgctxt "tformconsole.caption"
     54msgid "Console"
     55msgstr ""
     56
    2657#: tformmain.acompile.caption
    2758msgid "Compile"
     59msgstr ""
     60
     61#: tformmain.aconsole.caption
     62msgctxt "tformmain.aconsole.caption"
     63msgid "Console"
    2864msgstr ""
    2965

  • branches/xpascal/Optimizer.pas

    r224 r230  
    1414  TOptimizer = class
    1515  private
    16     procedure OptimizeNodes(SourceNodes: TSourceNodes; out NewNode: TSourceNode);
     16    procedure OptimizeNodes(SourceNodes: TSourceNodeList<TSourceNode>; out NewNode: TSourceNode);
    1717    procedure OptimizeNode(SourceNode: TSourceNode; out NewNode: TSourceNode);
    1818  public
    … …  
    2424implementation
    2525
     26resourcestring
     27  SUnsupportedNodeType = 'Unsupported node type';
     28
    2629{ TOptimizer }
    2730
    28 procedure TOptimizer.OptimizeNodes(SourceNodes: TSourceNodes; out
     31procedure TOptimizer.OptimizeNodes(SourceNodes: TSourceNodeList<TSourceNode>; out
    2932  NewNode: TSourceNode);
    3033var
    … …  
    3841        SourceNodes[I] := TempNewNode;
    3942      end;
    40     end else raise Exception.Create('Unsupported node type');
     43    end else raise Exception.Create(SUnsupportedNodeType);
    4144  end;
    4245end;
    … …  
    5659  if SourceNode = nil then begin
    5760  end else
    58   if SourceNode is TSourceNodes then begin
    59     OptimizeNodes(TSourceNodes(SourceNode), NewNode)
     61  if SourceNode is TSourceNodeList<TSourceNode> then begin
     62    OptimizeNodes(TSourceNodeList<TSourceNode>(SourceNode), NewNode)
    6063  end else
    6164  if (ofReplaceRepeatUntilByWhileDo in Features) and (SourceNode is TRepeatUntil) then begin
    … …  
    109112    end;
    110113  end else
    111     raise Exception.Create('Unsupported node type');
     114    raise Exception.Create(SUnsupportedNodeType);
    112115end;
    113116

  • branches/xpascal/Packages/Common/Languages

    • Property svn:ignore set to
      *.mo

  • branches/xpascal/Parser.pas

    r225 r230  
    3131implementation
    3232
     33resourcestring
     34  SCannotParseProgram = 'Cannot parse program.';
     35
    3336{ TParser }
    3437
    … …  
    188191    ResultType := TypeInteger;
    189192  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;
    190203  with Block.Functions.AddNew('WriteLn') do begin
    191204    InternalName := 'WriteLn';
    … …  
    195208    InternalName := 'Write';
    196209    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;
    197220  end;
    198221end;
    … …  
    214237  if ParseProgram(SystemBlock, NewProg) then begin
    215238    Prog := NewProg;
    216   end else Tokenizer.Error('Cannot parse program.');
     239  end else Tokenizer.Error(SCannotParseProgram);
    217240end;
    218241

  • branches/xpascal/Parsers/ParserPascal.pas

    r224 r230  
    347347  Token: TToken;
    348348  TypeRef: TType;
     349  ParamKind: TFunctionParamKind;
    349350begin
    350351  Result := True;
     352  if Tokenizer.CheckNext('var', tkKeyword) then begin
     353    Tokenizer.GetNext;
     354    ParamKind := pkVar;
     355  end;
    351356  Token := Tokenizer.GetNext;
    352357  if Token.Kind = tkIdentifier then begin
    353358    Parameter := TFunctionParameter.Create;
     359    Parameter.Kind := ParamKind;
    354360    Parameter.Name := Token.Text;
    355361    Tokenizer.Expect(':', tkSpecialSymbol);

  • branches/xpascal/Source.pas

    r224 r230  
    44
    55uses
    6   Classes, SysUtils, Contnrs;
     6  Classes, SysUtils, Generics.Collections;
    77
    88type
    … …  
    2424  end;
    2525
    26   TFields = class(TObjectList)
     26  TFields = class(TObjectList<TField>)
    2727  end;
    2828
    … …  
    5050  end;
    5151
    52   { TSourceNodes }
    53 
    54   TSourceNodes = class(TSourceNode)
     52  { TSourceNodeList }
     53
     54  TSourceNodeList<T> = class(TSourceNode)
    5555  private
    5656    Parent: TSourceNode;
    5757    function GetCount: Integer;
    58     function GetItem(Index: Integer): TObject;
    59     procedure SetItem(Index: Integer; AValue: TObject);
    60   public
    61     List: TObjectList;
     58    function GetItem(Index: Integer): T;
     59    procedure SetItem(Index: Integer; AValue: T);
     60  public
     61    List: TObjectList<TSourceNode>;
    6262    procedure Clear;
    63     function Add(AObject: TObject): Integer;
     63    function Add(AObject: T): Integer;
    6464    constructor Create;
    6565    destructor Destroy; override;
    66     property Items[Index: Integer]: TObject read GetItem write SetItem; default;
     66    property Items[Index: Integer]: T read GetItem write SetItem; default;
    6767    property Count: Integer read GetCount;
    6868  end;
    … …  
    115115  { TTypes }
    116116
    117   TTypes = class(TSourceNodes)
     117  TTypes = class(TSourceNodeList<TType>)
    118118    function SearchByName(Name: string): TType;
    119119    function AddNew(Name: string): TType;
    … …  
    136136  { TVariables }
    137137
    138   TVariables = class(TSourceNodes)
     138  TVariables = class(TSourceNodeList<TVariable>)
    139139    function SearchByName(Name: string): TVariable;
    140140  end;
    … …  
    157157  { TConstants }
    158158
    159   TConstants = class(TSourceNodes)
     159  TConstants = class(TSourceNodeList<TConstant>)
    160160    function SearchByName(Name: string): TConstant;
    161161    function AddNew(Name: string): TConstant;
    162162  end;
     163
     164  TFunctionParamKind = (pkNormal, pkVar, pkConst);
    163165
    164166  TFunctionParameter = class(TSourceNode)
    165167    Name: string;
    166168    TypeRef: TType;
     169    Kind: TFunctionParamKind;
    167170  end;
    168171
    169172  { TFunctionParameters }
    170173
    171   TFunctionParameters = class(TSourceNodes)
     174  TFunctionParameters = class(TSourceNodeList<TFunctionParameter>)
    172175    function SearchByName(Name: string): TFunctionParameter;
    173176    function AddNew(Name: string; TypeRef: TType): TFunctionParameter;
    … …  
    195198  { TFunctions }
    196199
    197   TFunctions = class(TSourceNodes)
     200  TFunctions = class(TSourceNodeList<TFunction>)
    198201    ParentType: TType;
    199202    function SearchByName(Name: string): TFunction;
    … …  
    204207  end;
    205208
    206   TCommands = class(TSourceNodes)
     209  TCommands = class(TSourceNodeList<TCommand>)
    207210  end;
    208211
    … …  
    302305  end;
    303306
    304   TExpressions = class(TSourceNodes)
     307  TExpressions = class(TSourceNodeList<TExpression>)
    305308  end;
    306309
    … …  
    565568end;
    566569
    567 { TSourceNodes }
    568 
    569 function TSourceNodes.GetCount: Integer;
     570{ TSourceNodeList }
     571
     572function TSourceNodeList<T>.GetCount: Integer;
    570573begin
    571574  Result := List.Count;
    572575end;
    573576
    574 function TSourceNodes.GetItem(Index: Integer): TObject;
    575 begin
    576   Result := List[Index];
    577 end;
    578 
    579 procedure TSourceNodes.SetItem(Index: Integer; AValue: TObject);
     577function TSourceNodeList<T>.GetItem(Index: Integer): T;
     578begin
     579  Result := T(List[Index]);
     580end;
     581
     582procedure TSourceNodeList<T>.SetItem(Index: Integer; AValue: T);
    580583begin
    581584  List[Index] := AValue;
    582585end;
    583586
    584 procedure TSourceNodes.Clear;
     587procedure TSourceNodeList<T>.Clear;
    585588begin
    586589  List.Clear;
    587590end;
    588591
    589 function TSourceNodes.Add(AObject: TObject): Integer;
     592function TSourceNodeList<T>.Add(AObject: T): Integer;
    590593begin
    591594  Result := List.Add(AObject);
    592595end;
    593596
    594 constructor TSourceNodes.Create;
    595 begin
    596   List := TObjectList.Create;
    597 end;
    598 
    599 destructor TSourceNodes.Destroy;
     597constructor TSourceNodeList<T>.Create;
     598begin
     599  List := TObjectList<TSourceNode>.Create;
     600end;
     601
     602destructor TSourceNodeList<T>.Destroy;
    600603begin
    601604  FreeAndNil(List);
    … …  
    10951098procedure TExpressionOperation.SetValue(Index: Integer; var Value);
    10961099begin
    1097   Items[Index] := TObject(Value);
     1100  Items[Index] := TExpression(Value);
    10981101end;
    10991102

  • branches/xpascal/xpascal.lpi

    r229 r230  
    8585      </Item3>
    8686    </RequiredPackages>
    87     <Units Count="18">
     87    <Units Count="19">
    8888      <Unit0>
    8989        <Filename Value="xpascal.lpr"/>
    … …  
    170170        <IsPartOfProject Value="True"/>
    171171      </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>
    172179    </Units>
    173180  </ProjectOptions>

  • branches/xpascal/xpascal.lpr

    r229 r230  
    1010  Forms, Parser, Tokenizer, Source, Executor, Interpreter, Generator,
    1111  FormMessages, FormSource, Optimizer, FormOutput, FormMain,
    12   ParserPascal, Tests;
     12  ParserPascal, Tests, FormConsole;
    1313
    1414{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.