Курсовая работа1 / Parser / UCcParser

{
  C-like language compiler v0.1.0.485

  12 november 2007

  Copyright (C) 2006, 2007 Igor Krooshch
  rheo.ikro@gmail.com

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
  License as published by the Free Software Foundation; either
  version 2.1 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  Lesser General Public License for more details.

  You should have received a copy of the GNU Lesser General Public
  License along with this library; if not, write to the Free Software
  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
}

unit UCcParser;

interface

uses
  Math,
  SysUtils, Classes,
  UCcTokenizer, UCcSyntaxEntries, UCcSymbols, UCcCodeGenerator;

type
  TCcExprProc = function: TCcExpression of object;

  TCcParser = class
  private
    FTableStack: TCcSymTableStack;
    FTokenizer: TCcTokenizer;
    FGenerator: TCcCodeGenerator;
    FCurrentFunc: TCcSymFunc;

    procedure CheckDelimiter(ASymbol: TCcTokenDelimiters);

    function ParseBinaryOp(
      AStartStateProc: TCcExprProc; ATokenTypes: TCcTokenSubTypes;
      AProc: TCcExprProc): TCcExpression;
    function ParseDelimBinaryOp(
      AStartStateProc: TCcExprProc; ATokenTypes: TCcTokenSubTypes;
      AProc: TCcExprProc): TCcExpression;

    function ParseFunction(
      AResultType: TCcSymType; const AName: string): TCcFuncDeclStatement;

    function ParseArray(AResultType: TCcSymType): TCcSymType;
  protected
    procedure InitFunctions;
    procedure AddSkipFunc(
      const AName: string; AArgs: array of TCcSymVariable;
      AResult: TCcSymType);
  public
    constructor Create(ATokenizer: TCcTokenizer);
    destructor Destroy; override;

    function ParseIdentifier(
      const AClass: TCcSyntaxVarClass;
      var ATable: TCcSymTable;
      var AResultClass: TObject): TCcExpression; overload;
    function ParseIdentifier(
      const AClass: TCcSyntaxVarClass): TCcExpression; overload;

    function ParsePrimaryExpr(
      var ATable: TCcSymTable;
      var AResultClass: TObject): TCcExpression; overload;
    function ParsePrimaryExpr: TCcExpression; overload;

    function ParseLogicalOr: TCcExpression;
    function ParseLogicalAnd: TCcExpression;
    function ParseInclusiveOr: TCcExpression;
    function ParseExclusiveOr: TCcExpression;
    function ParseAndExpr: TCcExpression;
    function ParseEqExpr: TCcExpression;
    function ParseRelationExpr: TCcExpression;
    function ParseShiftExpr: TCcExpression;
    function ParseAdditiveExpr: TCcExpression;
    function ParseMultiplicativeExpr: TCcExpression;
    function ParseCastExpr: TCcExpression;
    function ParseUnaryExpr: TCcExpression;
    function ParsePostfixExpr: TCcExpression;
    function ParseAssignmentExpr: TCcExpression;
    function ParseConditionalExpr: TCcExpression;

    function ParseArgumentExprList: TCcExpression;
    function ParseExpr: TCcExpression;

    { statements }
    function ParseStatement: TCcStatement;
    function ParseBlock: TCcStatement;
    function ParseWhile: TCcStatement;
    function ParseDoWhile: TCcStatement;
    function ParseExprStatement: TCcStatement;
    function ParseFor: TCcStatement;
    function ParseIf: TCcStatement;
    function ParseResult: TCcStatement;

    function ParseTypedef: TCcStatement;
    function ParseStruct: TCcSymStruct;
    function ParseVarDecl: TCcStatement;

    function Parse: TCcStatement;

    property Generator: TCcCodeGenerator read FGenerator;
  end;


implementation

uses
  UCcParserConsts, UCcSymanticConsts;

{ TCcParser }

procedure TCcParser.CheckDelimiter(ASymbol: TCcTokenDelimiters);
begin
  with FTokenizer do begin
    if (NextToken.SubType <> ASymbol) then
      ErrorFmt(SCcParserMissingSymbolFmt, [DELIM_VALUES[ASymbol]]);
  end;
end;


constructor TCcParser.Create(ATokenizer: TCcTokenizer);
begin
  FTokenizer := ATokenizer;
  FTableStack := TCcSymTableStack.Create(ATokenizer.Position);
  FTableStack.Push(TCcSymTable.Create(FTokenizer.Position, nil, FTokenizer));

  FTableStack.TopTable.Add(SymInt);
  FTableStack.TopTable.Add(SymFloat);

  InitFunctions;
  FGenerator := TCcCodeGenerator.Create;
end;


function TCcParser.ParseAdditiveExpr: TCcExpression;
begin
  Result :=
    ParseBinaryOp(
      ParseMultiplicativeExpr, [tstPlus, tstMinus], ParseMultiplicativeExpr);
end;


function TCcParser.ParseAndExpr: TCcExpression;
begin
  Result := ParseBinaryOp(ParseEqExpr, [tstAnd], ParseEqExpr);
end;


function TCcParser.ParseArgumentExprList: TCcExpression;
begin
  Result := DoEval(ParseExpr);
end;


function TCcParser.ParseAssignmentExpr: TCcExpression;
begin
  Result :=
    ParseBinaryOp(
      ParseConditionalExpr, [tstAssignment..tstOrAssign], ParseAssignmentExpr);
end;


function TCcParser.ParseBinaryOp(
  AStartStateProc: TCcExprProc; ATokenTypes: TCcTokenSubTypes;
  AProc: TCcExprProc): TCcExpression;
var
  tt: TCcTokenSubType;
begin
  if (@AStartStateProc = nil) then
    Result := nil
  else
    Result := DoEval(AStartStateProc);

  FTokenizer.NextToken;
  with FTokenizer, FTokenizer.GetToken do begin
    while (SubType in ATokenTypes) do begin
      tt := SubType;
      Result := TCcBinaryOperation.Create(Position, tt, Result, DoEval(AProc));
      NextToken;
    end;
    UngetToken;
  end;
end;


function TCcParser.ParseCastExpr: TCcExpression;
begin
  Result := DoEval(ParseUnaryExpr);
end;


function TCcParser.ParseConditionalExpr: TCcExpression;
var
  c: TCcExpression;
begin
  Result := ParseLogicalOr;
  if (FTokenizer.NextToken.SubType = tstQuestion) then begin
    c := ParseExpr;
    if (FTokenizer.NextToken.SubType <> tstColon) then
      FTokenizer.ErrorFmt(
        SCcParserExpectedButFoundFmt, [':', FTokenizer.GetToken.Text]);
    Result :=
      TCcConditionOperation.Create(
        FTokenizer.Position, Result, c, DoEval(ParseConditionalExpr));
  end
  else
    FTokenizer.UngetToken;
end;


function TCcParser.ParseEqExpr: TCcExpression;
begin
  Result :=
    ParseBinaryOp(
      ParseRelationExpr, [tstEqual, tstNotEqual], ParseRelationExpr);
end;


function TCcParser.ParseExclusiveOr: TCcExpression;
begin
  Result := ParseBinaryOp(ParseAndExpr, [tstXor], ParseAndExpr);
end;


function TCcParser.ParseExpr: TCcExpression;
begin
  Result :=
    ParseDelimBinaryOp(ParseAssignmentExpr, [tstComma], ParseAssignmentExpr);
end;


function TCcParser.ParseInclusiveOr: TCcExpression;
begin
  Result := ParseBinaryOp(ParseExclusiveOr, [tstOr], ParseExclusiveOr);
end;


function TCcParser.ParseLogicalAnd: TCcExpression;
begin
  Result := ParseBinaryOp(ParseInclusiveOr, [tstBitAnd], ParseInclusiveOr);
end;


function TCcParser.ParseLogicalOr: TCcExpression;
begin
  Result := ParseBinaryOp(ParseLogicalAnd, [tstBitOr], ParseLogicalAnd);
end;


function TCcParser.ParseMultiplicativeExpr: TCcExpression;
begin
  Result :=
    ParseBinaryOp(ParseCastExpr, [tstMul, tstDiv, tstRemainder], ParseCastExpr);
end;


function TCcParser.ParsePostfixExpr: TCcExpression;
const
  POSTFIX_TOKENS = [tstInc, tstDec, tstDot, tstOpenParent, tstOpenSqParent];

var
  tt: TCcTokenSubType;
  fc: TCcFuncCall;
  state: PCcSymTableStackRec;
  typ: TCcSymType;
  tbl: TCcSymTable;
  lastIdentifier: TObject;
begin
  // These expressions must be parsed here:
  //   postfix-expression [ expression ]
  //   postfix-expression ( argument-expression-list opt )
  //   postfix-expression . identifier
	//   postfix-expression ++
  //   postfix-expression --

  state := FTableStack.SaveState;
  tbl := FTableStack.TopTable;
  Result := DoEval(ParsePrimaryExpr(tbl, lastIdentifier));
  FTokenizer.NextToken;
  with FTokenizer do begin
    while (GetToken.SubType in POSTFIX_TOKENS) do begin
      tt := GetToken.SubType;
      case tt of
        tstInc, tstDec:
          Result := TCcUnaryOperation.Create(FTokenizer.Position, tt, Result);
        tstDot:
          begin
            if
              (not TCcSymType(lastIdentifier).IsType(TCcSymStruct)) or
              not (
                (Result is TCcSyntaxVar) or
                (Result is TCcItemSelectionOperation) or
                (
                  (Result is TCcBinaryDelimOperation) and
                  (TCcBinaryDelimOperation(Result).Operation = tstDot)
                )
              )
            then
              Error(SCcParserStructExpected);

            Result := TCcBinaryDelimOperation.Create(
              FTokenizer.Position, tt, Result,
              ParseIdentifier(
                TCcSyntaxStructField, tbl, lastIdentifier),
              FTableStack);
          end;
        tstOpenParent:
          begin
            if not (Result is TCcFuncCall) then
              Error(SCcParserFunctionNameExpected);
            fc := Result as TCcFuncCall;
            tt := NextToken.SubType;
            UngetToken;
            if tt <> tstCloseParent then
              while (tt <> tstCloseParent) do begin
                fc.AddArgument(ParseAssignmentExpr);
                NextToken;
                if (GetToken.SubType = tstComma) then
                  while (GetToken.SubType = tstComma) do begin
                    fc.AddArgument(ParseAssignmentExpr);
                    NextToken;
                  end;
                tt := GetToken.SubType;
              end
            else
              NextToken;
            Result := fc;
          end;
        tstOpenSqParent:
          begin
            typ := nil;
            if (Result is TCcSyntaxVar) then
              typ :=
                TCcSymVariable(
                  TCcSyntaxVar(Result).Variable
                ).ValType as TCcSymType
            else if (Result is TCcItemSelectionOperation) then
              typ := TCcItemSelectionOperation(Result).LValueType as TCcSymType
            else if
              (
                (Result is TCcBinaryDelimOperation) and
                (TCcBinaryDelimOperation(Result).Operation = tstDot)
              )
            then
              typ := lastIdentifier as TCcSymType 
            else
              Error(SCcSymanticArrayTypeExpected);

            if typ.IsType(TCcSymArray) then
              typ := TCcSymArray(typ.GetType).ValType
            else if typ.IsType(TCcSymTypePointer) then
              typ := TCcSymTypePointer(typ.GetType).PtrType
            else
              Error(SCcSymanticArrayTypeExpected);

            Result :=
              TCcItemSelectionOperation.Create(
                FTokenizer.Position, Result, DoEval(ParseExpr), typ);
            if (NextToken.SubType <> tstCloseSqParent) then
              ErrorFmt(SCcParserExpectedButFoundFmt, [')', GetToken.Text]);
            if typ.IsType(TCcSymStruct) then begin
              tbl := TCcSymStruct(typ.GetType).Fields;
              lastIdentifier := typ;
            end;
          end;
      end;
      NextToken;
    end;
    UngetToken;
  end;
  FTableStack.LoadState(state);
end;


function TCcParser.ParsePrimaryExpr(
  var ATable: TCcSymTable; var AResultClass: TObject): TCcExpression;
var
  sym: TCcSymbol;
  vt: TCcSymType;
  s: string;
begin
  Result := nil;
  AResultClass := nil;
  FTokenizer.NextToken;
  with FTokenizer, FTokenizer.GetToken do begin
    if (SubType = tstIdentifier) then begin
      s := GetToken.Text;
      if ATable = nil then
        sym := FTableStack.TopTable.Find(Position, s, TCcSymbol)
      else
        sym := ATable.Find(Position, s, TCcSymbol);

      AResultClass := sym;
      if sym is TCcSymVariable then begin
        Result := TCcSyntaxVar.Create(Position, s, sym);
        vt := TCcSymVariable(sym).ValType;
        AResultClass := vt;
        if vt.IsType(TCcSymStruct) then begin
          if ATable = nil then
            FTableStack.Push(TCcSymStruct(vt.GetType).Fields);
          ATable := TCcSymStruct(vt.GetType).Fields;
        end
        else if
          vt.IsType(TCcSymTypePointer) and
          TCcSymTypePointer(vt.GetType).PtrType.IsType(TCcSymStruct)
        then begin
          if ATable = nil then
            FTableStack.Push(
              TCcSymStruct(TCcSymTypePointer(vt.GetType).PtrType.GetType).Fields);
          ATable := TCcSymStruct(TCcSymTypePointer(vt.GetType).PtrType.GetType).Fields;
          AResultClass := TCcSymTypePointer(vt.GetType).PtrType.GetType;
        end;
      end
      else if sym is TCcSymFunc then begin
        Result := TCcFuncCall.Create(FTokenizer.Position, s, sym);
      end
      else
        Error(SCcParserUnexpectedTypeOfSymbol);
    end
    else if (SubType = tstIntConst) then
      Result :=
        TCcSyntaxConstInteger.Create(FTokenizer.Position, Value.AsInteger)
    else if (SubType = tstFloatConst) then
      Result :=
        TCcSyntaxConstFloat.Create(FTokenizer.Position, Value.AsDouble)
    else if (SubType = tstStrConst) then
      Result :=
        TCcSyntaxConstString.Create(FTokenizer.Position, Text, Generator)
    else if (SubType = tstOpenParent) then begin
      Result := ParseExpr;
      CheckDelimiter(tstCloseParent);
    end
    else
      if (SubType = tstEof) then
        Error(SCcParserUnexpectedEOF)
      else
        ErrorFmt(SCcParserUnexpectedSymbolFmt, [Text]);
  end;
end;


function TCcParser.ParseRelationExpr: TCcExpression;
begin
  Result :=
    ParseBinaryOp(
      ParseShiftExpr, [tstLess, tstGreater, tstLessEqual, tstGreatEqual],
      ParseShiftExpr);
end;


function TCcParser.ParseShiftExpr: TCcExpression;
begin
  Result :=
    ParseBinaryOp(ParseAdditiveExpr, [tstShl, tstShr], ParseAdditiveExpr);
end;


function TCcParser.ParseUnaryExpr: TCcExpression;
const
  UNARY_OPS =
    [tstInc, tstDec, tstAnd, tstPlus, tstMinus, tstAddition, tstNot, tstAnd];
var
  tt: TCcTokenSubType;
begin
  Result := nil;
  FTokenizer.NextToken;
  with FTokenizer, FTokenizer.GetToken do begin
    if (SubType in UNARY_OPS) then begin
      while (SubType in UNARY_OPS) do begin
        tt := SubType;
        if (tt in [tstInc, tstDec]) then
          Result :=
            TCcUnaryOperation.Create(
              FTokenizer.Position, tt, DoEval(ParseUnaryExpr), false)
        else
          Result :=
            TCcUnaryOperation.Create(
              FTokenizer.Position, tt, DoEval(ParseCastExpr), false)
      end;
      FTokenizer.UngetToken;
    end
    else begin
      FTokenizer.UngetToken;
      Result := DoEval(ParsePostfixExpr);
    end;
  end;
end;


function TCcParser.ParseIdentifier(
  const AClass: TCcSyntaxVarClass; var ATable: TCcSymTable;
  var AResultClass: TObject): TCcExpression;
var
  obj: TCcSymbol;
begin
  Result := nil;
  AResultClass := nil;
  FTokenizer.NextToken;
  with FTokenizer, FTokenizer.GetToken do begin
    if (SubType = tstIdentifier) then begin
      if (ATable = nil) then
        obj :=
          FTableStack.TopTable.Find(Position, GetToken.Text, TCcSymVariable)
      else
        obj := ATable.Find(Position, GetToken.Text, TCcSymVariable);
        
      Result := AClass.Create(Position, GetToken.Text, obj);
      if
        (obj is TCcSymVariable) and
        TCcSymVariable(obj).ValType.IsType(TCcSymStruct)
      then begin
        if ATable = nil then
          FTableStack.Push(TCcSymStruct(TCcSymVariable(obj).ValType.GetType).Fields);
        ATable := TCcSymStruct(TCcSymVariable(obj).ValType.GetType).Fields;
      end;

      if obj is TCcSymVariable then
        AResultClass := TCcSymVariable(obj).ValType.GetType
      else
        AResultClass := obj;
    end
    else
      if (SubType = tstEof) then
        Error(SCcParserUnexpectedEOF)
      else
        ErrorFmt(SCcParserIdentifierExpectedFmt, [Text]);
  end;
end;


function TCcParser.ParseDelimBinaryOp(
  AStartStateProc: TCcExprProc; ATokenTypes: TCcTokenSubTypes;
  AProc: TCcExprProc): TCcExpression;
var
  tt: TCcTokenSubType;
begin
  if (@AStartStateProc = nil) then
    Result := nil
  else
    Result := DoEval(AStartStateProc);

  FTokenizer.NextToken;
  with FTokenizer, FTokenizer.GetToken do begin
    while (SubType in ATokenTypes) do begin
      tt := SubType;
      Result :=
        TCcBinaryDelimOperation.Create(
          Position, tt, Result, DoEval(AProc), FTableStack);
      NextToken;
    end;
    UngetToken;
  end;
end;


function TCcParser.ParseBlock: TCcStatement;
var
  b: TCcBlockStatement;
  tt: TCcTokenSubType;
begin
  b := TCcBlockStatement.Create(FTokenizer.Position);
  with FTokenizer do begin
    RequireToken(tstOpenBraces, '{');
    tt := NextToken.SubType;
    while (tt <> tstCloseBraces) do begin
      UngetToken;
      b.AddStatement(ParseStatement);
      tt := NextToken.SubType;
    end;
    UngetToken;
    RequireToken(tstCloseBraces, '}');
  end;
  Result := b;
end;


function TCcParser.ParseStatement: TCcStatement;
var
  tt: TCcTokenSubType;
  s: string;
begin
  with FTokenizer do begin
    tt := NextToken.SubType;
    s := GetToken.Text;
    UngetToken;
    case tt of
      tstOpenBraces:
        Result := ParseBlock;
      tstWhile:
        Result := ParseWhile;
      tstDo:
        Result := ParseDoWhile;
      tstFor:
        Result := ParseFor;
      tstIf:
        Result := ParseIf;
      tstTypedef:
        Result := ParseTypedef;
      tstReturn:
        Result := ParseResult;
      tstBreak:
        begin
          NextToken;
          Result := BreakStmt;
          RequireToken(tstSemicolon);
        end;
      tstContinue:
        begin
          NextToken;
          Result := ContinueStmt;
          RequireToken(tstSemicolon);
        end;
      tstSemicolon:
        begin
          Result := TCcEmptyStatement.Create(Position);
          NextToken;
        end;
      tstInt..tstEnum, tstConst:
        Result := ParseVarDecl;
    else
      if
        (tt = tstIdentifier) and
        (FTableStack.TopTable.Find(Position, s, TCcSymType, true, false) <> nil)
      then
        Result := ParseVarDecl
      else
        Result := ParseExprStatement;
    end;
  end;
end;


function TCcParser.ParseStruct: TCcSymStruct;
var
  name: string;
  str: TCcSymStruct;
  st: TCcSymTable;
begin
  with FTokenizer do begin
    if (NextToken.SubType = tstIdentifier) then
      name := GetToken.Text
    else begin
      name := Format('%s%d', [SCcPrefixStruct, FTableStack.TopTable.Count]);
      UngetToken;
    end;
    RequireToken(tstOpenBraces);
    st := TCcSymTable.Create(Position, FTableStack.TopTable, FTokenizer);
    str := TCcSymStruct.Create(Position, st);
    str.Name := name;
    FTableStack.Push(st);
    NextToken;
    while (GetToken.SubType <> tstCloseBraces) do begin
      UngetToken;
      ParseVarDecl;
      UngetToken;
      RequireToken(tstSemicolon);
      NextToken;
    end;
    NextToken;
    FTableStack.Pop;
    FTableStack.TopTable.Add(str);
  end;
  Result := str;
end;


function TCcParser.ParseWhile: TCcStatement;
var
  expr: TCcExpression;
begin
  with FTokenizer do begin
    RequireToken(tstWhile, KW_VALUES[tstWhile]);
    RequireToken(tstOpenParent, DELIM_VALUES[tstOpenParent]);
    expr := ParseExpr;
    RequireToken(tstCloseParent, DELIM_VALUES[tstCloseParent]);
    Result := TCcWhileStatement.Create(Position, expr, ParseStatement);
  end;
end;


function TCcParser.ParseExprStatement: TCcStatement;
begin
  Result := TCcExprStatement.Create(FTokenizer.Position, ParseExpr.Evaluate);
  FTokenizer.RequireToken(tstSemicolon, DELIM_VALUES[tstSemicolon]);
end;


function TCcParser.Parse: TCcStatement;
begin
  Result := ParseStatement;
  Result.Generate(FGenerator);
end;


function TCcParser.ParseDoWhile: TCcStatement;
var
  stmt: TCcStatement;
  expr: TCcExpression;
begin
  with FTokenizer do begin
    RequireToken(tstDo, KW_VALUES[tstDo]);
    stmt := ParseStatement;
    RequireToken(tstWhile, KW_VALUES[tstWhile]);
    RequireToken(tstOpenParent, DELIM_VALUES[tstOpenParent]);
    expr := ParseExpr;
    RequireToken(tstCloseParent, DELIM_VALUES[tstCloseParent]);
    FTokenizer.RequireToken(tstSemicolon, DELIM_VALUES[tstSemicolon]);
    Result := TCcDoWhileStatement.Create(FTokenizer.Position, expr, stmt);
  end;
end;


function TCcParser.ParseFor: TCcStatement;
var
  expr: array[0..2] of TCcExpression;
  i: integer;
begin
  with FTokenizer do begin
    RequireToken(tstFor, KW_VALUES[tstFor]);
    RequireToken(tstOpenParent, DELIM_VALUES[tstOpenParent]);
    for i := 0 to 2 do
      if (LookAhead.SubType = tstSemicolon) then begin
        expr[i] := TCcEmptyExpression.Create(Position);
        NextToken;
      end
      else begin
        expr[i] := ParseExpr;
        if i < 2 then
          RequireToken(tstSemicolon, DELIM_VALUES[tstSemicolon]);
      end;

    RequireToken(tstCloseParent, DELIM_VALUES[tstCloseParent]);
    Result :=
      TCcForStatement.Create(
        Position, expr[0], expr[1], expr[2], ParseStatement);
  end;
end;


function TCcParser.ParseIf: TCcStatement;
var
  expr: TCcExpression;
  th, el: TCcStatement;
begin
  with FTokenizer do begin
    RequireToken(tstIf, KW_VALUES[tstIf]);
    RequireToken(tstOpenParent, DELIM_VALUES[tstOpenParent]);
    expr := ParseExpr;
    RequireToken(tstCloseParent, DELIM_VALUES[tstCloseParent]);
    th := ParseStatement;
    if (LookAhead.SubType = tstElse) then begin
      NextToken;
      el := ParseStatement;
    end
    else
      el := TCcEmptyStatement.Create(Position);
    Result := TCcIfStatement.Create(Position, expr, th, el);
  end;
end;


function TCcParser.ParseVarDecl: TCcStatement;
var
  constant: boolean;
  vt, avt: TCcSymType;
  v: TCcSymVariable;
  tt: TCcTokenSubType;
  name: string;
begin
  vt := nil;
  with FTokenizer do begin
    NextToken;
    tt := GetToken.SubType;
    constant := tt = tstConst;
    if constant then
      NextToken;
    case GetToken.SubType of
      tstInt:
        vt := SymInt;
      tstFloat:
        vt := SymFloat;
      tstVoid:
        vt := SymVoid;
      tstIdentifier:
        vt :=
          FTableStack.TopTable.Find(
            Position, GetToken.Text, TCcSymType) as TCcSymType;
      tstStruct:
        vt := ParseStruct;
    end;

    if not (tt = tstStruct) then
      NextToken;

    while (GetToken.SubType <> tstSemicolon) do begin
      avt := nil;
      if GetToken.SubType <> tstIdentifier then
        ErrorFmt(SCcParserIdentifierExpectedFmt, [GetToken.Text]);
      name := GetToken.Text;
      if
        FTableStack.TopTable.Find(
          Position, name, nil, false, false) <> nil
      then
        ErrorFmt(SCcParserRedefinitionFmt, [name]);
      NextToken;
      if (GetToken.SubType = tstOpenParent) then begin
        if constant then
          Error(SCcParserConstantFunction);
        Result := ParseFunction(vt, name);
        Exit;
      end
      else if (GetToken.SubType = tstOpenSqParent) then begin
        avt := ParseArray(vt);
      end;
      if (GetToken.SubType in [tstComma, tstSemicolon]) then begin
        if (avt = nil) then
          avt := vt;
        v :=
          TCcSymVariable.Create(Position, name, avt, nil, FTableStack.TopTable);
        FTableStack.TopTable.Add(v);
        if GetToken.SubType = tstComma then
          NextToken;
      end
      else if (GetToken.SubType = tstAssignment) then begin
        if (not vt.IsType(TCcSymTypeScalar)) or (avt <> nil) then
          Error(SCcParserInitialization);
        if (avt = nil) then
          avt := vt.GetType;
        v :=
          TCcSymVariable.Create(
            Position, name, avt, ParseAssignmentExpr, FTableStack.TopTable);
        FTableStack.TopTable.Add(v);
        if (GetToken.SubType = tstComma) then 
          NextToken(true);
      end
      else
        ErrorFmt(SCcParserUnexpectedSymbolFmt, [GetToken.Text]);
    end;
  end;
  Result :=
    TCcVarDeclStatement.Create(
      FTokenizer.Position, FTableStack.TopTable);
end;


function TCcParser.ParseTypedef: TCcStatement;
var
  sym: TCcSymType;
  sa: TCcSymAlias;
  n: string;
begin
  with FTokenizer do begin
    RequireToken(tstTypedef);
    n := NextToken.Text;
    sym := TCcSymType(FTableStack.TopTable.Find(Position, n, TCcSymType));
    RequireToken(tstIdentifier);
    n := GetToken.Text;
    if FTableStack.TopTable.Find(Position, n, TCcSymType, false, false) <> nil then
      SymanticWarning(Position, SCcSymanticReintroduction);
    if NextToken.SubType = tstOpenSqParent then
      sym := ParseArray(sym);
    sa := TCcSymAlias.Create(sym, Position);
    sa.Name := n;
    FTableStack.TopTable.Add(sa);
  end;
  Result :=  TCcVarDeclStatement.Create(FTokenizer.Position, FTableStack.TopTable);
end;


destructor TCcParser.Destroy;
begin
  FGenerator.Free;
  FTableStack.Free;
  inherited;
end;


function TCcParser.ParseFunction(
  AResultType: TCcSymType; const AName: string): TCcFuncDeclStatement;
var
  vt: TCcSymType;
  n: string;
  func: TCcSymFunc;
begin
  if (FCurrentFunc <> nil) then
    FTokenizer.Error(SCcParserNestedFunctionsAreNotAllowed);

  if
    not (
      AResultType.IsType(TCcSymTypeScalar) or
      AResultType.IsType(TCcSymTypeVoid)
    )
  then
    FTokenizer.Error(SCcParserNotScalarResult);

  func :=
    TCcSymFunc.Create(FTokenizer.Position, FTableStack.TopTable, FTokenizer);
  func.Name := AName;
  func.SetReturn(AResultType.GetType);
  FTableStack.TopTable.Add(func);
  FTableStack.Push(func.Params);
  FTableStack.Push(func.Table);

  FCurrentFunc := func;

  if (AResultType <> SymVoid) then
    func.AddParam(
      TCcSymVariable.Create(
        FTokenizer.Position, '%%result', AResultType.GetType, nil, func.Params), true);

  vt := nil;
  with FTokenizer do begin
    NextToken;
    while (GetToken.SubType <> tstCloseParent) do begin
      case GetToken.SubType of
        tstInt:
          vt := SymInt;
        tstFloat:
          vt := SymFloat;
        tstIdentifier:
          begin
            vt :=
              FTableStack.TopTable.Find(
                Position, GetToken.Text, TCcSymType) as TCcSymType;
            if not (vt.IsType(TCcSymTypeScalar) or vt.IsType(TCcSymStruct)) then
              Error(SCcParserNotScalarArgument);
            if vt.IsType(TCcSymStruct) then begin
              RequireToken(tstAnd, '&');
              vt := TCcSymTypePointer.Create(Position, vt.GetType);
            end;
          end;
      else
        ErrorFmt(SCcParserUnexpectedResultTypeFmt, [GetToken.Text]);
      end;
      RequireToken(tstIdentifier);
      n := GetToken.Text;
      NextToken;
      if (GetToken.SubType = tstOpenSqParent) then begin
        RequireToken(tstCloseSqParent);
        vt := TCcSymTypePointer.Create(Position, vt.GetType);
        NextToken;
      end;
      func.AddParam(TCcSymVariable.Create(Position, n, vt.GetType, nil, func.Params));
      if (GetToken.SubType = tstComma) then begin
        NextToken;
        if (GetToken.SubType = tstCloseParent) then
          ErrorFmt(SCcParserArgTypeExpectedFmt, [GetToken.Text]);
      end;
    end;
    func.SetBlock(ParseBlock as TCcBlockStatement);
    NextToken;
    if (GetToken.SubType <> tstSemicolon) then
      UngetToken;
  end;
  Result := TCcFuncDeclStatement.Create(FTokenizer.Position, func);
  FTableStack.Pop;
  FTableStack.Pop;
  FCurrentFunc := nil;
end;


procedure TCcParser.InitFunctions;
begin
  AddSkipFunc(
    'putn', [
      TCcSymVariable.Create(FTokenizer.Position, 'AValue', SymInt)], SymVoid);
  AddSkipFunc('randomize', [], SymVoid);
  AddSkipFunc(
    'random', [
      TCcSymVariable.Create(FTokenizer.Position, 'AValue', SymInt)], SymInt);
  AddSkipFunc('puttext', [
    TCcSymVariable.Create(FTokenizer.Position, 'AValue', SymStr)], SymVoid);
  AddSkipFunc('printf', [], SymVoid);
  AddSkipFunc(
    'trunc', [TCcSymVariable.Create(FTokenizer.Position, 'AValue', SymFloat)], SymInt);
  AddSkipFunc(
    'putfl', [TCcSymVariable.Create(FTokenizer.Position, 'AValue', SymFloat)],
    SymVoid);
  AddSkipFunc(
    '_float', [TCcSymVariable.Create(FTokenizer.Position, 'AValue', SymInt)],
    SymFloat);
  AddSkipFunc(
    'sqrt', [TCcSymVariable.Create(FTokenizer.Position, 'AValue', SymFloat)],
    SymFloat);
end;


function TCcParser.ParseResult: TCcStatement;
var
  expr: TCcExpression;
  tst: TCcTokenSubType;
begin
  if (FCurrentFunc = nil) then
    FTokenizer.Error(SCcParserUnableToReturn);
  expr := nil;
  with FTokenizer do begin
    RequireToken(tstReturn, KW_VALUES[tstReturn]);
    tst := NextToken.SubType;
    UngetToken;
    if (tst <> tstSemicolon) then begin
      expr := ParseExpr;
      UngetToken;
    end;
    RequireToken(tstSemicolon);
    Result := TCcReturnStatement.Create(Position, expr, FCurrentFunc);
  end;
end;


procedure TCcParser.AddSkipFunc(const AName: string; AArgs: array of TCcSymVariable; AResult: TCcSymType);
var
  sf: TCcSymFunc;
  i: integer;
begin
  sf := TCcSymFunc.Create(FTokenizer.Position, FTableStack.TopTable, FTokenizer);
  sf.Name := AName;
  for i := Low(AArgs) to High(AArgs) do
    sf.AddParam(AArgs[i]);
  sf.SetReturn(AResult);
  FTableStack.TopTable.Add(sf);
  FTableStack.TopTable.AddSkipGenFunc(sf.Name);
end;


function TCcParser.ParseIdentifier(
  const AClass: TCcSyntaxVarClass): TCcExpression;
var
  rc: TObject;
  tbl: TCcSymTable;
begin
  Result := ParseIdentifier(AClass, tbl, rc);
end;


function TCcParser.ParsePrimaryExpr: TCcExpression;
var
  rc: TObject;
  tbl: TCcSymTable;
begin
  Result := ParsePrimaryExpr(tbl, rc);
end;


function TCcParser.ParseArray(AResultType: TCcSymType): TCcSymType;
var
  dims: TList;
  i: integer;
begin
  with FTokenizer do begin
    Result := AResultType;
    dims := nil;
    try
      dims := TList.Create;
      while (GetToken.SubType = tstOpenSqParent) do begin
        NextToken;
        if GetToken.SubType <> tstIntConst then
          ErrorFmt(SCcParserIntegerValueExpectedFmt, [GetToken.Text]);
        dims.Add(Pointer(GetToken.Value.AsInteger));
        RequireToken(tstCloseSqParent);
        NextToken;
      end;
      i := dims.Count;
      while (i > 0) do begin
        Dec(i);
        Result := TCcSymArray.Create(Position, Result, integer(dims[i]));
        dims.Delete(i);
      end;
    finally
      FreeAndNil(dims);
    end;
  end;
end;


end.