Changeset 235 for branches/xpascal


Ignore:
Timestamp:
Jun 27, 2023, 10:09:21 AM (17 months ago)
Author:
chronos
Message:
  • Modified: Improved function var parameter handling.
  • Modified: Code cleanup.
Location:
branches/xpascal
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • branches/xpascal/Executor.pas

    r233 r235  
    163163    procedure ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock; ExistingBlock: TExecutorBlock = nil);
    164164    function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue;
    165     function ExecuteProcedureCall(Block: TExecutorBlock; ProcedureCall: TProcedureCall): TValue;
     165    procedure ExecuteProcedureCall(Block: TExecutorBlock; ProcedureCall: TProcedureCall);
    166166    procedure ExecuteAssignment(Block: TExecutorBlock; Assignment: TAssignment);
    167167    function ExecuteExpression(Block: TExecutorBlock; Expression: TExpression): TValue;
    … …  
    195195begin
    196196  I := 0;
    197   while (I < Count) and (TExecutorProcedure(Items[I]).ProcedureDef <> ProcedureDef) do Inc(I);
    198   if I < Count then Result := TExecutorProcedure(Items[I])
     197  while (I < Count) and (Items[I].ProcedureDef <> ProcedureDef) do Inc(I);
     198  if I < Count then Result := Items[I]
    199199    else Result := nil;
    200200end;
    … …  
    275275begin
    276276  I := 0;
    277   while (I < Count) and (TExecutorType(Items[I]).TypeRef <> TypeRef) do Inc(I);
    278   if I < Count then Result := TExecutorType(Items[I])
     277  while (I < Count) and (Items[I].TypeRef <> TypeRef) do Inc(I);
     278  if I < Count then Result := Items[I]
    279279    else Result := nil;
    280280end;
    … …  
    295295begin
    296296  I := 0;
    297   while (I < Count) and (TExecutorFunction(Items[I]).FunctionDef <> FunctionDef) do Inc(I);
    298   if I < Count then Result := TExecutorFunction(Items[I])
     297  while (I < Count) and (Items[I].FunctionDef <> FunctionDef) do Inc(I);
     298  if I < Count then Result := Items[I]
    299299    else Result := nil;
    300300end;
    … …  
    314314begin
    315315  I := 0;
    316   while (I < Count) and (TExecutorVariable(Items[I]).Variable <> Variable) do Inc(I);
    317   if I < Count then Result := TExecutorVariable(Items[I])
     316  while (I < Count) and (Items[I].Variable <> Variable) do Inc(I);
     317  if I < Count then Result := Items[I]
    318318    else Result := nil;
    319319end;
    … …  
    634634  J: Integer;
    635635  ExecutorFunction: TExecutorFunction;
     636  ExecutorProcedure: TExecutorProcedure;
    636637  ExecutorType: TExecutorType;
    637638begin
    … …  
    723724    end;
    724725  end;
    725   for I := 0 to Block.Variables.Count - 1 do
     726
     727  for I := 0 to Block.Variables.Count - 1 do begin
    726728    ExecutorBlock.Variables.AddNew(TVariable(Block.Variables[I]));
     729  end;
     730
    727731  for I := 0 to Block.Functions.Count - 1 do begin
    728732    ExecutorFunction := ExecutorBlock.Functions.AddNew(TFunction(Block.Functions[I]));
    729     if ExecutorFunction.FunctionDef.Name = 'Write' then begin
    730       ExecutorFunction.Callback := ExecuteWrite;
    731     end else
    732     if ExecutorFunction.FunctionDef.Name = 'WriteLn' then begin
    733       ExecutorFunction.Callback := ExecuteWriteLn;
    734     end else
    735     if ExecutorFunction.FunctionDef.Name = 'Read' then begin
    736       ExecutorFunction.Callback := ExecuteRead;
    737     end else
    738     if ExecutorFunction.FunctionDef.Name = 'ReadLn' then begin
    739       ExecutorFunction.Callback := ExecuteReadLn;
    740     end else
    741733    if ExecutorFunction.FunctionDef.Name = 'IntToStr' then begin
    742734      ExecutorFunction.Callback := ExecuteIntToStr;
    … …  
    750742    if ExecutorFunction.FunctionDef.Name = 'StrToBool' then begin
    751743      ExecutorFunction.Callback := ExecuteStrToBool;
     744    end;
     745  end;
     746
     747  for I := 0 to Block.Procedures.Count - 1 do begin
     748    ExecutorProcedure := ExecutorBlock.Procedures.AddNew(TProcedure(Block.Procedures[I]));
     749    if ExecutorProcedure.ProcedureDef.Name = 'Write' then begin
     750      ExecutorProcedure.Callback := ExecuteWrite;
     751    end else
     752    if ExecutorProcedure.ProcedureDef.Name = 'WriteLn' then begin
     753      ExecutorProcedure.Callback := ExecuteWriteLn;
     754    end else
     755    if ExecutorProcedure.ProcedureDef.Name = 'Read' then begin
     756      ExecutorProcedure.Callback := ExecuteRead;
     757    end else
     758    if ExecutorProcedure.ProcedureDef.Name = 'ReadLn' then begin
     759      ExecutorProcedure.Callback := ExecuteReadLn;
    752760    end;
    753761  end;
    … …  
    946954      Result := ExecutorFunction.Callback(Params);
    947955      for I := 0 to FunctionCall.Params.Count - 1 do begin
    948         //if FunctionCall.Params[I].
    949956        Params[I].Free;
    950957      end;
    951958    end else begin
    952959      InitExecutorBlock(ExecutorFunction.Block, FunctionCall.FunctionDef.Block);
     960
     961      // Clean variables
    953962      for I := 0 to FunctionCall.Params.Count - 1 do begin
    954         Variable := FunctionCall.FunctionDef.Block.Variables.SearchByName(TFunctionParameter(FunctionCall.FunctionDef.Params[I]).Name);
    955         ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(Variable);
    956         ExecutorVariable.Value.Free;
    957         ExecutorVariable.Value := ExecuteExpression(Block, TExpression(FunctionCall.Params[I]));
     963        if FunctionCall.FunctionDef.Params[I].Kind = pkVar then begin
     964          Variable := TExpressionOperand(FunctionCall.Params[I]).VariableRef;
     965          ExecutorVariable := Block.Variables.SearchByVariable(Variable);
     966          ExecutorFunction.Block.Variables[I] := ExecutorVariable;
     967        end else begin
     968          Variable := FunctionCall.FunctionDef.Block.Variables.SearchByName(
     969            TFunctionParameter(FunctionCall.FunctionDef.Params[I]).Name);
     970          ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(Variable);
     971          ExecutorVariable.Value.Free;
     972          ExecutorVariable.Value := ExecuteExpression(Block, TExpression(FunctionCall.Params[I]));
     973        end;
    958974      end;
     975
    959976      ExecuteBlock(Block, FunctionCall.FunctionDef.Block, ExecutorFunction.Block);
    960977      ExecutorVariable := ExecutorFunction.Block.Variables.SearchByVariable(TVariable(FunctionCall.FunctionDef.Block.Variables.SearchByName('Result')));
    … …  
    964981end;
    965982
    966 function TExecutor.ExecuteProcedureCall(Block: TExecutorBlock;
    967   ProcedureCall: TProcedureCall): TValue;
     983procedure TExecutor.ExecuteProcedureCall(Block: TExecutorBlock;
     984  ProcedureCall: TProcedureCall);
    968985var
    969986  ExecutorProcedure: TExecutorProcedure;
    … …  
    973990  Variable: TVariable;
    974991begin
    975   Result := nil;
    976992  ExecutorProcedure := Block.GetProcedure(ProcedureCall.ProcedureDef);
    977993  if Assigned(ExecutorProcedure) then begin
    … …  
    9891005        else Params[I].Value := ExecuteExpression(Block, ProcedureCall.Params[I]);
    9901006      end;
    991       Result := ExecutorProcedure.Callback(Params);
     1007      ExecutorProcedure.Callback(Params);
    9921008      for I := 0 to ProcedureCall.Params.Count - 1 do begin
    993         //if FunctionCall.Params[I].
    9941009        Params[I].Free;
    9951010      end;
    9961011    end else begin
    9971012      InitExecutorBlock(ExecutorProcedure.Block, ProcedureCall.ProcedureDef.Block);
     1013
     1014      // Clean variables
    9981015      for I := 0 to ProcedureCall.Params.Count - 1 do begin
    999         Variable := ProcedureCall.ProcedureDef.Block.Variables.SearchByName(
    1000           TFunctionParameter(ProcedureCall.ProcedureDef.Params[I]).Name);
    1001         ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(Variable);
    1002         ExecutorVariable.Value.Free;
    1003         ExecutorVariable.Value := ExecuteExpression(Block, TExpression(ProcedureCall.Params[I]));
     1016        if ProcedureCall.ProcedureDef.Params[I].Kind = pkVar then begin
     1017          Variable := TExpressionOperand(ProcedureCall.Params[I]).VariableRef;
     1018          ExecutorVariable := Block.Variables.SearchByVariable(Variable);
     1019          ExecutorProcedure.Block.Variables[I].Variable := Variable;
     1020          ExecutorProcedure.Block.Variables[I].Value := ExecutorVariable.Value;
     1021        end else begin
     1022          Variable := ProcedureCall.ProcedureDef.Block.Variables.SearchByName(
     1023            TFunctionParameter(ProcedureCall.ProcedureDef.Params[I]).Name);
     1024          ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(Variable);
     1025          ExecutorVariable.Value.Free;
     1026          ExecutorVariable.Value := ExecuteExpression(Block, TExpression(ProcedureCall.Params[I]));
     1027        end;
    10041028      end;
     1029
    10051030      ExecuteBlock(Block, ProcedureCall.ProcedureDef.Block, ExecutorProcedure.Block);
    1006       ExecutorVariable := ExecutorProcedure.Block.Variables.SearchByVariable(
    1007         TVariable(ProcedureCall.ProcedureDef.Block.Variables.SearchByName('Result')));
    1008       Result := ExecutorVariable.Value.Clone;
    10091031    end;
    10101032  end else raise Exception.Create('No executor for ' + ProcedureCall.ProcedureDef.Name + ' function.');
    … …  
    10221044  Variable := Block.GetVariable(Assignment.Variable);
    10231045  ExecutorFunction := Block.GetTypeFunction(Assignment.Variable.TypeRef, '_Assign');
    1024   if Assignment.Variable.TypeRef = Assignment.Expression.GetType then begin;
     1046  if Assignment.Variable.TypeRef = Assignment.Expression.GetType then begin
    10251047    SetLength(Params, 1);
    10261048    Params[0] := TExecutorFunctionCallbackParam.Create;

  • branches/xpascal/Generators/GeneratorPascal.pas

    r234 r235  
    102102  Indent := Indent + 1;
    103103  for I := 0 to RepeatUntil.Commands.Count - 1 do begin
    104     GenerateCommand(Block, TCommand(RepeatUntil.Commands[I]));
     104    GenerateCommand(Block, RepeatUntil.Commands[I]);
    105105    AddTextLine(';');
    106106  end;
    … …  
    119119    AddText('(');
    120120    for I := 0 to FunctionCall.Params.Count - 1 do
    121       GenerateExpression(Block, TExpression(FunctionCall.Params[I]));
     121      GenerateExpression(Block, FunctionCall.Params[I]);
    122122    AddText(')');
    123123  end;
    … …  
    133133    AddText('(');
    134134    for I := 0 to ProcedureCall.Params.Count - 1 do
    135       GenerateExpression(Block, TExpression(ProcedureCall.Params[I]));
     135      GenerateExpression(Block, ProcedureCall.Params[I]);
    136136    AddText(')');
    137137  end;
    … …  
    169169      AddText(' ');
    170170    end;
    171     GenerateExpression(Block, TExpression(Expression.Items[I]));
     171    GenerateExpression(Block, Expression.Items[I]);
    172172  end;
    173173end;
    … …  
    217217  if Prog.Name <> '' then AddTextLine('program ' + Prog.Name + ';');
    218218  AddTextLine('{$mode delphi}');
     219  AddTextLine('');
    219220  AddTextLine('uses SysUtils;');
    220221  GenerateBlock(Block, Prog.Block);
    … …  
    231232    AddText('(');
    232233    for I := 0 to FunctionDef.Params.Count - 1 do begin
    233       AddText(TFunctionParameter(FunctionDef.Params[I]).Name);
     234      AddText(FunctionDef.Params[I].Name);
    234235      AddText(': ');
    235       AddText(TFunctionParameter(FunctionDef.Params[I]).TypeRef.Name);
     236      AddText(FunctionDef.Params[I].TypeRef.Name);
    236237      if I > 0 then AddText(', ');
    237238    end;
    … …  
    267268    AddText('(');
    268269    for I := 0 to ProcedureDef.Params.Count - 1 do begin
    269       AddText(TFunctionParameter(ProcedureDef.Params[I]).Name);
     270      AddText(ProcedureDef.Params[I].Name);
    270271      AddText(': ');
    271       AddText(TFunctionParameter(ProcedureDef.Params[I]).TypeRef.Name);
     272      AddText(ProcedureDef.Params[I].TypeRef.Name);
    272273      if I > 0 then AddText(', ');
    273274    end;
    … …  
    307308  VarCount := 0;
    308309  for I := 0 to Block.Variables.Count - 1 do
    309     if not TVariable(Block.Variables[I]).Internal then Inc(VarCount);
     310    if not Block.Variables[I].Internal then Inc(VarCount);
    310311
    311312  if VarCount > 0 then begin
    … …  
    313314    Indent := Indent + 1;
    314315    for I := 0 to Block.Variables.Count - 1 do
    315     if not TVariable(Block.Variables[I]).Internal then begin
    316       Variable := TVariable(Block.Variables[I]);
     316    if not Block.Variables[I].Internal then begin
     317      Variable := Block.Variables[I];
    317318      AddTextLine(Variable.Name + ': ' + Variable.TypeRef.Name + ';');
    318319    end;
    … …  
    331332    Indent := Indent + 1;
    332333    for I := 0 to Block.Constants.Count - 1 do begin
    333       Constant := TConstant(Block.Constants[I]);
     334      Constant := Block.Constants[I];
    334335      AddText(Constant.Name + ': ' + Constant.TypeRef.Name + ' = ');
    335336      GenerateValue(Constant.Value);
    … …  
    348349  Indent := Indent + 1;
    349350  for I := 0 to BeginEnd.Commands.Count - 1 do begin
    350     GenerateCommand(Block, TCommand(BeginEnd.Commands[I]));
     351    GenerateCommand(Block, BeginEnd.Commands[I]);
    351352    AddTextLine(';');
    352353  end;
    … …  
    361362begin
    362363  for I := 0 to Block.Functions.Count - 1 do begin
    363     GenerateFunction(ParentBlock, TFunction(Block.Functions[I]));
     364    GenerateFunction(ParentBlock, Block.Functions[I]);
    364365    AddTextLine;
    365366  end;
    … …  
    372373begin
    373374  for I := 0 to Block.Procedures.Count - 1 do begin
    374     GenerateProcedure(ParentBlock, TProcedure(Block.Procedures[I]));
     375    GenerateProcedure(ParentBlock, Block.Procedures[I]);
    375376    AddTextLine;
    376377  end;

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

    r234 r235  
    3737msgid "Cannot parse program."
    3838msgstr "Nelze analyzovat program."
     39
     40#: parserpascal.sexpectedfunctionparameter
     41msgid "Expected function parameter."
     42msgstr "Očekáván parametr funkce."
     43
     44#: parserpascal.sexpectedprocedureparameter
     45msgid "Expected procedure parameter."
     46msgstr "Očekávání parametr procedury."
     47
     48#: parserpascal.sfunctionparametermismatch
     49msgid "Function parameter mismatch."
     50msgstr "Neshoda parametru funkce."
     51
     52#: parserpascal.sunexpectedtoken
     53#, object-pascal-format
     54msgid "Unexpected token %s"
     55msgstr "Neočekávány token %s"
    3956
    4057#: source.sindexerror
    … …  
    174191msgid "Unsupported tokenizer state."
    175192msgstr "NepodporovanÜ stav tokenizeru."
    176 

  • branches/xpascal/Languages/xpascal.pot

    r233 r235  
    2626#: parser.scannotparseprogram
    2727msgid "Cannot parse program."
     28msgstr ""
     29
     30#: parserpascal.sexpectedfunctionparameter
     31msgid "Expected function parameter."
     32msgstr ""
     33
     34#: parserpascal.sexpectedprocedureparameter
     35msgid "Expected procedure parameter."
     36msgstr ""
     37
     38#: parserpascal.sfunctionparametermismatch
     39msgid "Function parameter mismatch."
     40msgstr ""
     41
     42#: parserpascal.sunexpectedtoken
     43#, object-pascal-format
     44msgid "Unexpected token %s"
    2845msgstr ""
    2946

  • branches/xpascal/Parsers/ParserPascal.pas

    r233 r235  
    4444implementation
    4545
     46resourcestring
     47  SExpectedFunctionParameter = 'Expected function parameter.';
     48  SExpectedProcedureParameter = 'Expected procedure parameter.';
     49  SFunctionParameterMismatch = 'Function parameter mismatch.';
     50  SUnexpectedToken = 'Unexpected token %s';
     51
    4652function TParserPascal.ParseBeginEnd(Block: TBlock; out BeginEnd: TBeginEnd): Boolean;
    4753var
    … …  
    5763        Tokenizer.Expect(';', tkSpecialSymbol);
    5864      end else begin
    59         Error('Unexpected token ' + Tokenizer.GetNext.Text);
     65        Error(Format(SUnexpectedToken, [Tokenizer.GetNext.Text]));
    6066        Result := False;
    6167        Break;
    … …  
    8894            if Expression.GetType = TFunctionParameter(FunctionDef.Params[I]).TypeRef then
    8995              FunctionCall.Params.Add(Expression)
    90               else Error('Function parameter mismatch.');
    91           end else Error('Expected function parameter.');
     96              else Error(SFunctionParameterMismatch);
     97          end else Error(SExpectedFunctionParameter);
    9298        end;
    9399        Tokenizer.Expect(')', tkSpecialSymbol);
    … …  
    126132            if Expression.GetType = TFunctionParameter(ProcedureDef.Params[I]).TypeRef then
    127133              ProcedureCall.Params.Add(Expression)
    128               else Error('Function parameter mismatch.');
    129           end else Error('Expected procedure parameter.');
     134              else Error(SFunctionParameterMismatch);
     135          end else Error(SExpectedProcedureParameter);
    130136        end;
    131137        Tokenizer.Expect(')', tkSpecialSymbol);
    … …  
    396402      if ParseFunctionParameter(Block, FunctionParameter) then begin
    397403        Params.Add(FunctionParameter);
    398       end else Error('Expected function parameter.');
     404      end else Error(SExpectedFunctionParameter);
    399405    end;
    400406    Tokenizer.Expect(')', tkSpecialSymbol);

  • branches/xpascal/Tests.pas

    r233 r235  
    155155    Source.Add('  WriteLn(BoolToStr(IsZero(0)));');
    156156    Source.Add('  WriteLn(BoolToStr(IsZero(1)));');
     157    Source.Add('end.');
     158    ExpectedOutput := '-1' + LineEnding + '0' + LineEnding;
     159  end;
     160  with TTestRun(Result.AddNew('function var parameter', TTestRun)) do begin
     161    Source.Add('function Test(var A: Integer): Boolean;');
     162    Source.Add('begin');
     163    Source.Add('  A := 10;');
     164    Source.Add('  Result := True;');
     165    Source.Add('end;');
     166    Source.Add('');
     167    Source.Add('var');
     168    Source.Add('  B: Integer;');
     169    Source.Add('begin');
     170    Source.Add('  B := 1;');
     171    Source.Add('  Test(B);');
     172    Source.Add('  WriteLn(IntToStr(B));');
    157173    Source.Add('end.');
    158174    ExpectedOutput := '-1' + LineEnding + '0' + LineEnding;
Note: See TracChangeset for help on using the changeset viewer.