Ignore:
Timestamp:
Aug 4, 2010, 3:29:23 PM (14 years ago)
Author:
george
Message:
  • Upraveno: Další úpravy parseru.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/DelphiToC/Analyze/UPascalParser.pas

    r34 r35  
    1212  TOnErrorMessage = procedure (Text: string) of object;
    1313
    14   TParserCommand = class(TCommand)
    15     procedure Parse(Parser: TPascalParser);
     14  TParserCommand = class(TCommonBlock)
     15    function Parse(Parser: TPascalParser): TCommand;
    1616  end;
    1717
    … …  
    2121
    2222  TParserExpression = class(TExpression)
    23     procedure Parse(Parser: TPascalParser);
     23    function Parse(Parser: TPascalParser): TExpression;
    2424  end;
    2525
    … …  
    3939
    4040  TParserBeginEnd = class(TBeginEnd)
    41     procedure Parse(Parser: TPascalParser; Command: TBeginEnd);
    42   end;
    43 
    44   TParserParseFunction = class(TFunction)
    45     procedure Parse(Parser: TPascalParser; Command: TBeginEnd);
     41    procedure Parse(Parser: TPascalParser);
     42  end;
     43
     44  TParserFunctionList = class(TFunctionList)
     45    procedure Parse(Parser: TPascalParser);
     46  end;
     47
     48  TParserIfThenElse = class(TIfThenElse)
     49    procedure Parse(Parser: TPascalParser);
     50  end;
     51
     52  TParserVariableList = class(TVariableList)
     53    procedure Parse(Parser: TPascalParser);
     54  end;
     55
     56  TParserVariable = class(TVariable)
     57    procedure Parse(Parser: TPascalParser);
     58  end;
     59
     60  TParserConstantList = class(TConstantList)
     61    procedure Parse(Parser: TPascalParser);
     62  end;
     63
     64  TParserTypeList = class(TTypeList)
     65    procedure Parse(Parser: TPascalParser);
     66  end;
     67
     68  TParserType = class(TType)
     69    procedure Parse(Parser: TPascalParser);
    4670  end;
    4771
    … …  
    6387    function IsKeyword(Text: string): Boolean;
    6488    function IsOperator(Text: string): Boolean;
    65     procedure ParseFunction(FunctionList: TFunctionList);
    66     procedure ParseFunctionParameterList(ParameterList: TParameterList);
    67     procedure ParseVariableList(VariableList: TVariableList);
    68     procedure ParseVariable(Variable: TVariable);
    69     procedure ParseConstantList(ConstantList: TConstantList);
    70     procedure ParseConstant(Constant: TConstant);
    71     procedure ParseTypeList(TypeList: TTypeList);
    72     procedure ParseType(AType: TType);
    73     //function ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
    74     function ParseCommand(CommonBlock: TCommonBlock): TCommand;
    75     procedure ParseBeginEnd(CommonBlock: TCommonBlock; Command: TBeginEnd);
    76     procedure ParseIfThenElse(CommonBlock: TCommonBlock; Command: TIfThenElse);
    77     procedure ParseWhileDo(CommonBlock: TCommonBlock; Command: TWhileDo);
    7889    procedure Log(Text: string);
    7990    property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
    … …  
    152163  LogFileName = 'ParseLog.txt';
    153164var
    154   LogFile: TextFile;
    155 begin
    156   AssignFile(LogFile, LogFileName);
    157   if FileExists(LogFileName) then Append(LogFile)
    158     else Rewrite(LogFile);
    159   WriteLn(LogFile, Text);
    160   CloseFile(LogFile);
     165  LogFile: TFileStream;
     166begin
     167  try
     168    if FileExists(LogFileName) then
     169      LogFile := TFileStream.Create(LogFileName, fmOpenWrite)
     170      else LogFile := TFileStream.Create(LogFileName, fmCreate);
     171    if Length(Text) > 0 then begin
     172      LogFile.Write(Text[1], Length(Text));
     173      LogFile.Write(#13#10, 2);
     174    end;
     175  finally
     176    LogFile.Free;
     177  end;
    161178end;
    162179
    … …  
    225242end;
    226243
    227 procedure TPascalParser.ParseFunction(FunctionList: TFunctionList);
    228 var
    229   Identifiers: TStringList;
    230   NewValueType: TType;
    231   TypeName: string;
    232   VariableName: string;
    233   Variable: TParameter;
    234   I: Integer;
    235 begin
    236   Identifiers := TStringList.Create;
    237   with FunctionList do begin
    238     with TFunction(Items[Add(TFunction.Create)]) do begin
    239       Parent := FunctionList.Parent;
    240       Expect('procedure');
    241       Name := ReadCode;
    242       if NextCode = '(' then begin
    243         Expect('(');
    244         while NextCode <> ')' do begin
    245 //    while IsIdentificator(NextCode) do begin
    246           with TParameterList(Parameters) do begin
    247             VariableName := ReadCode;
    248             Variable := Search(VariableName);
    249             if not Assigned(Variable) then begin
    250               Identifiers.Add(VariableName);
    251               while NextCode = ',' do begin
    252                 Expect(',');
    253                 Identifiers.Add(ReadCode);
    254               end;
    255             end else ErrorMessage('Pøedefinování existující promìnné.');
    256             Expect(':');
    257             TypeName := ReadCode;
    258             NewValueType := Parent.Types.Search(TypeName);
    259             if not Assigned(NewValueType) then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
    260               else for I := 0 to Identifiers.Count - 1 do
    261                 with TParameter(Items[Add(TParameter.Create)]) do begin
    262                   Name := Identifiers[I];
    263                   ValueType := NewValueType;
    264                 end;
    265           end;
    266         end;
    267         Expect(')');
    268       end;
    269     end;
    270     Expect(';');
    271     TParserCommonBlock(TFunction(Items[Count - 1])).Parse(Parser);
    272   end;
    273   Identifiers.Destroy;
    274 end;
    275 
    276 procedure TPascalParser.ParseFunctionParameterList(
    277   ParameterList: TParameterList);
    278 begin
    279 
    280 end;
    281 
    282 procedure TPascalParser.ParseIfThenElse(CommonBlock: TCommonBlock; Command: TIfThenElse);
    283 begin
    284   Expect('if');
    285   Expect('than');
    286   if NextCode = 'else' then begin
    287     Expect('else');
    288   end;
    289 end;
    290 
    291 procedure TPascalParser.ParseConstant(Constant: TConstant);
    292 begin
    293 
    294 end;
    295 
    296 procedure TPascalParser.ParseConstantList(ConstantList: TConstantList);
    297 var
    298   Identifiers: TStringList;
    299   NewValueType: TType;
    300   TypeName: string;
    301   ConstantName: string;
    302   Constant: TConstant;
    303   I: Integer;
    304   ConstantValue: string;
    305 begin
    306   Identifiers := TStringList.Create;
    307   with ConstantList do begin
    308     Expect('const');
    309     while IsIdentificator(NextCode) do begin
    310       ConstantName := ReadCode;
    311       Constant := Search(ConstantName);
    312       if not Assigned(Constant) then begin
    313         Identifiers.Add(ConstantName);
    314         while NextCode = ',' do begin
    315           Expect(',');
    316           Identifiers.Add(ReadCode);
    317         end;
    318       end else ErrorMessage('Pøedefinování existující konstanty.');
    319       Expect(':');
    320       TypeName := ReadCode;
    321       NewValueType := Parent.Types.Search(TypeName);
    322       Expect('=');
    323       ConstantValue := ReadCode;
    324       Expect(';');
    325 
    326       if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
    327         else for I := 0 to Identifiers.Count - 1 do
    328           with TConstant(Items[Add(TConstant.Create)]) do begin
    329             Name := Identifiers[I];
    330             ValueType := NewValueType;
    331             Value := ConstantValue;
    332           end;
    333     end;
    334   end;
    335   Identifiers.Destroy;
    336 end;
    337 
    338 function TPascalParser.ParseCommand(CommonBlock: TCommonBlock): TCommand;
    339 var
    340   Identifier: string;
    341   Variable: TVariable;
    342   Method: TFunction;
    343   First: TOperation;
    344   Second: TOperation;
    345   StartIndex: Integer;
    346   LoopVariable: TVariable;
    347   IdentName: string;
    348 begin
    349  (* if NextCode = 'begin' then begin
    350     Result := TBeginEnd.Create;
    351     ParseBeginEnd(CommonBlock, TBeginEnd(Result));
    352   end else
    353   if NextCode = 'if' then begin
    354     Result :=  TIfThenElse.Create;
    355     ParseIfThenElse(CommonBlock, TIfThenElse(Result));
    356   end else
    357   if NextCode = 'while' then begin
    358     Result := TWhileDo.Create;
    359     ParseWhileDo(CommonBlock, TWhileDo(Result));
    360   end else
    361   if IsIdentificator(NextCode) then begin
    362     if Assigned(CommonBlock.Variables.Search(NextCode)) then begin
    363       Result := TAssignment.Create;
    364       IdentName := ReadCode;
    365       TAssignment(Result).Target := CommonBlock.Variables.Search(IdentName);
    366       Expect(':=');
    367       TAssignment(Result).Source := ParseCommonBlockExpression(CommonBlock);
    368     end else
    369     if Assigned(CommonBlock.Methods.Search(NextCode)) then begin
    370       Result := TMethodCall.Create;
    371 //      ParseMetVariable(TMethodCall(Result).Target);
    372     end;
    373   end;
    374 
    375 (*    begin
    376       Expect('if');
    377       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    378         Instruction := inConditionalJump;
    379         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    380         Negative := True;
    381       end;
    382       First := Operations[Operations.Count - 1];
    383       Expect('then');
    384       ParseCommonBlockOperation(CommonBlock);
    385       if NextCode = 'else' then begin
    386         with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    387           Instruction := inJump;
    388         end;
    389         Second := Operations[Operations.Count - 1];
    390         First.GotoAddress := Operations.Count;
    391         Expect('else');
    392         ParseCommonBlockOperation(CommonBlock);
    393         Second.GotoAddress := Operations.Count;
    394       end else First.GotoAddress := Operations.Count;
    395     end
    396     else if NextCode = 'repeat' then begin
    397       Expect('repeat');
    398       StartIndex := Operations.Count;
    399       ParseCommonBlockOperation(CommonBlock);
    400       Expect('until');
    401       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    402         Instruction := inConditionalJump;
    403         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    404         GotoAddress := StartIndex;
    405       end;
    406     end
    407     else if NextCode = 'while' then begin
    408       Expect('while');
    409       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    410         Instruction := inConditionalJump;
    411         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    412       end;
    413       First := Operations[Operations.Count - 1];
    414       StartIndex := Operations.Count - 1;
    415       Expect('do');
    416       ParseCommonBlockOperation(CommonBlock);
    417       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    418         Instruction := inJump;
    419         GotoAddress := StartIndex;
    420       end;
    421       First.GotoAddress := Operations.Count;
    422     end
    423     else if NextCode = 'for' then begin
    424       Expect('for');
    425       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    426         Instruction := inExpressionEvaluation;
    427         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    428         if (ExpressionTree.NodeType <> ntOperator) and
    429           (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
    430         if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
    431           ErrorMessage('Index in FOR loop have to be variable');
    432         LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
    433       end;
    434       Expect('to');
    435       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    436         Instruction := inExpressionEvaluation;
    437         ExpressionTree := TExpression.Create;
    438         with ExpressionTree do begin
    439           NodeType := ntOperator;
    440           OperatorName := '=';
    441           SubItems[0] := TExpression.Create;
    442           with TExpression(SubItems[0]) do begin
    443             NodeType := ntVariable;
    444             Variable := LoopVaraible;
    445           end;
    446           SubItems[1] := ParseCommonBlockExpression(CommonBlock);
    447         end;
    448         Negative := True;
    449       end;
    450       First := Operations[Operations.Count - 1];
    451       StartIndex := Operations.Count - 1;
    452       Expect('do');
    453       ParseCommonBlockOperation(CommonBlock);
    454       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    455         Instruction := inExpressionEvaluation;
    456         ExpressionTree := TExpression.Create;
    457         with ExpressionTree do begin
    458           NodeType := ntOperator;
    459           OperatorName := ':=';
    460           SubItems[0] := TExpression.Create;
    461           with TExpression(SubItems[0]) do begin
    462             NodeType := ntVariable;
    463             Variable := LoopVaraible;
    464           end;
    465           SubItems[1] := TExpression.Create;
    466           with TExpression(SubItems[1]) do begin
    467             NodeType := ntOperator;
    468             OperatorName := '+';
    469             SubItems[0] := TExpression.Create;
    470             with TExpression(SubItems[0]) do begin
    471               NodeType := ntVariable;
    472               Variable := LoopVaraible;
    473             end;
    474             SubItems[1] := TExpression.Create;
    475             with TExpression(SubItems[1]) do begin
    476               NodeType := ntConstant;
    477               //SetLength(Value, 1);
    478               //Value[0] := 1;
    479               Value := 1;
    480             end;
    481           end;
    482         end;
    483       end;
    484       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    485         Instruction := inJump;
    486         GotoAddress := StartIndex;
    487       end;
    488       First.GotoAddress := Operations.Count;
    489     end
    490     else begin
    491       with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
    492         Instruction := inExpressionEvaluation;
    493         ExpressionTree := ParseCommonBlockExpression(CommonBlock);
    494       end;
    495     end;
    496   *)
    497 end;
    498 
    499 procedure TPascalParser.ParseTypeList(TypeList: TTypeList);
    500 begin
    501   with TypeList do begin
    502     Expect('type');
    503     while IsIdentificator(NextCode) do
    504       with TType(Items[Add(TType.Create)]) do begin
    505         Parent := TypeList;
    506         ParseType(TType(Items[Count - 1]));
    507       end;
    508   end;
    509 end;
    510 
    511 procedure TPascalParser.ParseVariableList(VariableList: TVariableList);
    512 var
    513   Identifiers: TStringList;
    514   NewValueType: TType;
    515   TypeName: string;
    516   VariableName: string;
    517   Variable: TVariable;
    518   I: Integer;
    519 begin
    520   Identifiers := TStringList.Create;
    521   with VariableList do begin
    522     Expect('var');
    523     while IsIdentificator(NextCode) do begin
    524       VariableName := ReadCode;
    525       Variable := Search(VariableName);
    526       if not Assigned(Variable) then begin
    527         Identifiers.Add(VariableName);
    528         while NextCode = ',' do begin
    529           Expect(',');
    530           Identifiers.Add(ReadCode);
    531         end;
    532       end else ErrorMessage('Pøedefinování existující promìnné.');
    533       Expect(':');
    534       TypeName := ReadCode;
    535       NewValueType := Parent.Types.Search(TypeName);
    536       if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
    537         else for I := 0 to Identifiers.Count - 1 do
    538           with TVariable(Items[Add(TVariable.Create)]) do begin
    539             Name := Identifiers[I];
    540             ValueType := NewValueType;
    541           end;
    542       Expect(';');
    543     end;
    544   end;
    545   Identifiers.Destroy;
    546 end;
    547 
    548 procedure TPascalParser.ParseWhileDo(CommonBlock: TCommonBlock; Command: TWhileDo);
    549 begin
    550 end;
    551 
    552 procedure TPascalParser.ParseVariable(Variable: TVariable);
    553 begin
    554   with Variable do begin
    555     Name := NextCode;
    556     Expect(':=');
    557 
    558   end;
    559 end;
    560 
    561 procedure TPascalParser.ParseType(AType: TType);
    562 begin
    563   with AType do begin
    564     Name := NextCode;
    565     Expect('=');
    566     UsedType := Parent.Search(NextCode);
    567   end;
    568 end;
    569 
    570244{ TParserWhileDo }
    571245
    … …  
    582256{ TExpression }
    583257
    584 procedure TParserExpression.Parse(Parser: TPascalParser);
     258function TParserExpression.Parse(Parser: TPascalParser): TExpression;
    585259var
    586260  Identifier: string;
    … …  
    593267  II: Integer;
    594268begin
    595 (*  Expressions := TExpressionList.Create;
     269  (*Expressions := TExpressionList.Create;
    596270  Expressions.Add(TExpression.Create);
    597271  with Parser do begin
    … …  
    601275        if Identifier = '(' then begin
    602276          with TExpression(Expressions[Expressions.Count - 1]) do begin
    603             SubItems[1] := ParseCommonBlockExpression(CommonBlock);
     277            //SubItems[1] := TParserExpression(Self).Parse(Parser);
    604278          end;
    605279          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    … …  
    705379{ TParserCommand }
    706380
    707 procedure TParserCommand.Parse(Parser: TPascalParser);
    708 begin
    709 
     381function TParserCommand.Parse(Parser: TPascalParser): TCommand;
     382var
     383  Identifier: string;
     384  Variable: TVariable;
     385  Method: TFunction;
     386  First: TOperation;
     387  Second: TOperation;
     388  StartIndex: Integer;
     389  LoopVariable: TVariable;
     390  IdentName: string;
     391begin
     392  with Parser do begin
     393    if NextCode = 'begin' then begin
     394      Result := TBeginEnd.Create;
     395      TParserBeginEnd(Result).Parse(Parser);
     396    end else
     397    if NextCode = 'if' then begin
     398      Result :=  TIfThenElse.Create;
     399      TParserIfThenElse(Result).Parse(Parser);
     400    end else
     401    if NextCode = 'while' then begin
     402      Result := TWhileDo.Create;
     403      TParserWhileDo(Result).Parse(Parser);
     404    end else
     405    if IsIdentificator(NextCode) then begin
     406      if Assigned(Variables.Search(NextCode)) then begin
     407        Result := TAssignment.Create;
     408        IdentName := ReadCode;
     409        TAssignment(Result).Target := Variables.Search(IdentName);
     410        Expect(':=');
     411        TAssignment(Result).Source := TParserExpression(Result).Parse(Parser);
     412      end else
     413      if Assigned(Methods.Search(NextCode)) then begin
     414        Result := TMethodCall.Create;
     415  //      ParseMetVariable(TMethodCall(Result).Target);
     416      end;
     417    end;
     418  end;
     419
     420(*    begin
     421      Expect('if');
     422      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     423        Instruction := inConditionalJump;
     424        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     425        Negative := True;
     426      end;
     427      First := Operations[Operations.Count - 1];
     428      Expect('then');
     429      ParseCommonBlockOperation(CommonBlock);
     430      if NextCode = 'else' then begin
     431        with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     432          Instruction := inJump;
     433        end;
     434        Second := Operations[Operations.Count - 1];
     435        First.GotoAddress := Operations.Count;
     436        Expect('else');
     437        ParseCommonBlockOperation(CommonBlock);
     438        Second.GotoAddress := Operations.Count;
     439      end else First.GotoAddress := Operations.Count;
     440    end
     441    else if NextCode = 'repeat' then begin
     442      Expect('repeat');
     443      StartIndex := Operations.Count;
     444      ParseCommonBlockOperation(CommonBlock);
     445      Expect('until');
     446      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     447        Instruction := inConditionalJump;
     448        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     449        GotoAddress := StartIndex;
     450      end;
     451    end
     452    else if NextCode = 'while' then begin
     453      Expect('while');
     454      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     455        Instruction := inConditionalJump;
     456        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     457      end;
     458      First := Operations[Operations.Count - 1];
     459      StartIndex := Operations.Count - 1;
     460      Expect('do');
     461      ParseCommonBlockOperation(CommonBlock);
     462      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     463        Instruction := inJump;
     464        GotoAddress := StartIndex;
     465      end;
     466      First.GotoAddress := Operations.Count;
     467    end
     468    else if NextCode = 'for' then begin
     469      Expect('for');
     470      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     471        Instruction := inExpressionEvaluation;
     472        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     473        if (ExpressionTree.NodeType <> ntOperator) and
     474          (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
     475        if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
     476          ErrorMessage('Index in FOR loop have to be variable');
     477        LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
     478      end;
     479      Expect('to');
     480      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     481        Instruction := inExpressionEvaluation;
     482        ExpressionTree := TExpression.Create;
     483        with ExpressionTree do begin
     484          NodeType := ntOperator;
     485          OperatorName := '=';
     486          SubItems[0] := TExpression.Create;
     487          with TExpression(SubItems[0]) do begin
     488            NodeType := ntVariable;
     489            Variable := LoopVaraible;
     490          end;
     491          SubItems[1] := ParseCommonBlockExpression(CommonBlock);
     492        end;
     493        Negative := True;
     494      end;
     495      First := Operations[Operations.Count - 1];
     496      StartIndex := Operations.Count - 1;
     497      Expect('do');
     498      ParseCommonBlockOperation(CommonBlock);
     499      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     500        Instruction := inExpressionEvaluation;
     501        ExpressionTree := TExpression.Create;
     502        with ExpressionTree do begin
     503          NodeType := ntOperator;
     504          OperatorName := ':=';
     505          SubItems[0] := TExpression.Create;
     506          with TExpression(SubItems[0]) do begin
     507            NodeType := ntVariable;
     508            Variable := LoopVaraible;
     509          end;
     510          SubItems[1] := TExpression.Create;
     511          with TExpression(SubItems[1]) do begin
     512            NodeType := ntOperator;
     513            OperatorName := '+';
     514            SubItems[0] := TExpression.Create;
     515            with TExpression(SubItems[0]) do begin
     516              NodeType := ntVariable;
     517              Variable := LoopVaraible;
     518            end;
     519            SubItems[1] := TExpression.Create;
     520            with TExpression(SubItems[1]) do begin
     521              NodeType := ntConstant;
     522              //SetLength(Value, 1);
     523              //Value[0] := 1;
     524              Value := 1;
     525            end;
     526          end;
     527        end;
     528      end;
     529      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     530        Instruction := inJump;
     531        GotoAddress := StartIndex;
     532      end;
     533      First.GotoAddress := Operations.Count;
     534    end
     535    else begin
     536      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
     537        Instruction := inExpressionEvaluation;
     538        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
     539      end;
     540    end;
     541  *)
    710542end;
    711543
    … …  
    795627  with Parser do begin
    796628    while NextCode <> EndSymbol do begin
    797       if NextCode = 'var' then ParseVariableList(TVariableList(Variables))
    798       else if NextCode = 'const' then ParseConstantList(TConstantList(Constants))
    799       else if NextCode = 'type' then ParseTypeList(TTypeList(Types))
    800       else if NextCode = 'procedure' then ParseFunction(Methods)
     629      if NextCode = 'var' then
     630        TParserVariableList(Variables).Parse(Parser)
     631      else if NextCode = 'const' then
     632        TParserConstantList(Constants).Parse(Parser)
     633      else if NextCode = 'type' then
     634        TParserTypeList(Types).Parse(Parser)
     635      else if NextCode = 'procedure' then
     636        TParserFunctionList(Methods).Parse(Parser)
    801637      else begin
    802         ParseBeginEnd(CommonBlock, Code);
     638        TParserBeginEnd(Code).Parse(Parser);
    803639        Break;
    804640      end;
    … …  
    810646{ TParserBeginEnd }
    811647
    812 procedure TParserBeginEnd.Parse(Parser: TPascalParser; Command: TBeginEnd);
     648procedure TParserBeginEnd.Parse(Parser: TPascalParser);
    813649var
    814650  NewCommand: TCommand;
    … …  
    817653    Expect('begin');
    818654    while NextCode <> 'end' do begin
    819       NewCommand := ParseCommand(CommonBlock);
     655      NewCommand := TParserCommand(Self).Parse(Parser);
    820656      if Assigned(NewCommand) then Commands.Add(NewCommand);
    821657      //ShowMessage(NextCode);
    … …  
    826662end;
    827663
     664{ TParserParseFunctionList }
     665
     666procedure TParserFunctionList.Parse(Parser: TPascalParser);
     667var
     668  Identifiers: TStringList;
     669  NewValueType: TType;
     670  TypeName: string;
     671  VariableName: string;
     672  Variable: TParameter;
     673  I: Integer;
     674begin
     675  Identifiers := TStringList.Create;
     676  with Parser do begin
     677    with TFunction(Items[Add(TFunction.Create)]) do begin
     678      Parent := Self.Parent;
     679      Expect('procedure');
     680      Name := ReadCode;
     681      if NextCode = '(' then begin
     682        Expect('(');
     683        while NextCode <> ')' do begin
     684//    while IsIdentificator(NextCode) do begin
     685          with TParameterList(Parameters) do begin
     686            VariableName := ReadCode;
     687            Variable := Search(VariableName);
     688            if not Assigned(Variable) then begin
     689              Identifiers.Add(VariableName);
     690              while NextCode = ',' do begin
     691                Expect(',');
     692                Identifiers.Add(ReadCode);
     693              end;
     694            end else ErrorMessage('Pøedefinování existující promìnné.');
     695            Expect(':');
     696            TypeName := ReadCode;
     697            NewValueType := Parent.Types.Search(TypeName);
     698            if not Assigned(NewValueType) then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
     699              else for I := 0 to Identifiers.Count - 1 do
     700                with TParameter(Items[Add(TParameter.Create)]) do begin
     701                  Name := Identifiers[I];
     702                  ValueType := NewValueType;
     703                end;
     704          end;
     705        end;
     706        Expect(')');
     707      end;
     708    end;
     709    Expect(';');
     710    TParserCommonBlock(TFunction(Items[Count - 1])).Parse(Parser);
     711  end;
     712  Identifiers.Destroy;
     713end;
     714
     715{ TParserIfThenElse }
     716
     717procedure TParserIfThenElse.Parse(Parser: TPascalParser);
     718begin
     719  with Parser do begin
     720    Expect('if');
     721    Expect('than');
     722    if NextCode = 'else' then begin
     723      Expect('else');
     724    end;
     725  end;
     726end;
     727
     728{ TParserVariableList }
     729
     730procedure TParserVariableList.Parse(Parser: TPascalParser);
     731var
     732  Identifiers: TStringList;
     733  NewValueType: TType;
     734  TypeName: string;
     735  VariableName: string;
     736  Variable: TVariable;
     737  I: Integer;
     738begin
     739  Identifiers := TStringList.Create;
     740  with Parser do begin
     741    Expect('var');
     742    while IsIdentificator(NextCode) do begin
     743      VariableName := ReadCode;
     744      Variable := Search(VariableName);
     745      if not Assigned(Variable) then begin
     746        Identifiers.Add(VariableName);
     747        while NextCode = ',' do begin
     748          Expect(',');
     749          Identifiers.Add(ReadCode);
     750        end;
     751      end else ErrorMessage('Pøedefinování existující promìnné.');
     752      Expect(':');
     753      TypeName := ReadCode;
     754      NewValueType := Parent.Types.Search(TypeName);
     755      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
     756        else for I := 0 to Identifiers.Count - 1 do
     757          with TVariable(Items[Add(TVariable.Create)]) do begin
     758            Name := Identifiers[I];
     759            ValueType := NewValueType;
     760          end;
     761      Expect(';');
     762    end;
     763  end;
     764  Identifiers.Destroy;
     765end;
     766
     767{ TParserVariable }
     768
     769procedure TParserVariable.Parse(Parser: TPascalParser);
     770begin
     771  with Parser do begin
     772    Name := NextCode;
     773    Expect(':=');
     774
     775  end;
     776end;
     777
     778{ TParserConstantList }
     779
     780procedure TParserConstantList.Parse(Parser: TPascalParser);
     781var
     782  Identifiers: TStringList;
     783  NewValueType: TType;
     784  TypeName: string;
     785  ConstantName: string;
     786  Constant: TConstant;
     787  I: Integer;
     788  ConstantValue: string;
     789begin
     790  Identifiers := TStringList.Create;
     791  with Parser do begin
     792    Expect('const');
     793    while IsIdentificator(NextCode) do begin
     794      ConstantName := ReadCode;
     795      Constant := Search(ConstantName);
     796      if not Assigned(Constant) then begin
     797        Identifiers.Add(ConstantName);
     798        while NextCode = ',' do begin
     799          Expect(',');
     800          Identifiers.Add(ReadCode);
     801        end;
     802      end else ErrorMessage('Pøedefinování existující konstanty.');
     803      Expect(':');
     804      TypeName := ReadCode;
     805      NewValueType := Parent.Types.Search(TypeName);
     806      Expect('=');
     807      ConstantValue := ReadCode;
     808      Expect(';');
     809
     810      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
     811        else for I := 0 to Identifiers.Count - 1 do
     812          with TConstant(Items[Add(TConstant.Create)]) do begin
     813            Name := Identifiers[I];
     814            ValueType := NewValueType;
     815            Value := ConstantValue;
     816          end;
     817    end;
     818  end;
     819  Identifiers.Destroy;
     820end;
     821
     822{ TParserTypeList }
     823
     824procedure TParserTypeList.Parse(Parser: TPascalParser);
     825begin
     826  with Parser do begin
     827    Expect('type');
     828    while IsIdentificator(NextCode) do
     829      with TType(Items[Add(TType.Create)]) do begin
     830        Parent := Self;
     831        TParserType(Items[Count - 1]).Parse(Parser);
     832      end;
     833  end;
     834end;
     835
     836{ TParserType }
     837
     838procedure TParserType.Parse(Parser: TPascalParser);
     839begin
     840  with Parser do begin
     841    Name := NextCode;
     842    Expect('=');
     843    UsedType := Parent.Search(NextCode);
     844  end;
     845end;
     846
    828847end.
Note: See TracChangeset for help on using the changeset viewer.