Курсовая работа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.