added enum types support, #ifdef

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@390 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz 2008-03-27 15:27:46 +00:00
parent 794bde9c44
commit 4d76e4ee47

View File

@ -20,7 +20,7 @@ uses
Classes;
type
TTokenType = (tt_Ident, tt_Symbol, tt_None);
TTokenType = (tt_Ident, tt_Symbol, tt_None, tt_Numeric);
TCharSet = set of Char;
@ -30,68 +30,125 @@ type
end;
TTokenTable = class(TObject)
SpaceChars : TCharSet;
CmtBlock : array of TTokenPair;
CmtCount : Integer;
CmtLine : TStrings;
Symbols : TCharSet;
SpaceChars : TCharSet;
CmtBlock : array of TTokenPair;
CmtCount : Integer;
CmtLine : TStrings;
Symbols : TCharSet;
Precompile : AnsiString;
constructor Create;
destructor Destroy; override;
end;
{ TTextParser }
TTextParser = class(TObject)
protected
function HandlePrecomiler: Boolean; virtual;
public
Buf : AnsiString;
Index : Integer;
TokenTable : TTokenTable;
Buf : AnsiString;
Index : Integer;
TokenTable : TTokenTable;
OnPrecompile : TNotifyEvent;
Stack : TList;
constructor Create;
destructor Destroy; override;
procedure BeginParse(AObject: TObject);
procedure EndParse;
function SkipComments: Boolean;
function FindNextToken(var Token: AnsiString; var TokenType: TTokenType): Boolean;
constructor Create;
end;
{ TEntity }
TEntity = class(TObject)
protected
procedure DoParse(AParser: TTextParser); virtual; abstract;
public
owner : TEntity;
Items : TList;
constructor Create(AOwner: TEntity);
destructor Destroy; override;
procedure Parse(AParser: TTextParser); virtual; abstract;
procedure Parse(AParser: TTextParser); virtual;
end;
{ TPrecompiler }
TPrecompiler = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_Directive : AnsiString;
_Params : AnsiString;
end;
{ TEnumValue }
TEnumValue = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_Name : AnsiString;
_Value : AnsiString;
end;
{ TEnumTypeDef }
TEnumTypeDef = class(TEntity)
protected
fValCount : Integer;
function GetValue(idx: integer): TEnumValue;
procedure DoParse(AParser: TTextParser); override;
public
_Name : AnsiString;
property Value[idx: Integer]: TEnumValue read GetValue;
property ValuesCount: Integer read fValCount;
end;
{ TParameterDef }
TResultTypeDef = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_isRef : Boolean;
_TypeName : AnsiString;
_isConst : Boolean; // (const Sometype)
_Prefix : AnsiString; // reserved-word type descriptors
procedure Parse(AParser: TTextParser); override;
end;
TParameterDef = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_Res : TResultTypeDef;
_Name : AnsiString;
procedure Parse(AParser: TTextParser); override;
function GetResultType: TResultTypeDef;
end;
{ TParamDescr }
TParamDescr = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_Descr : AnsiString;
procedure Parse(AParser: TTextParser); override;
end;
{ TClassMethodDef }
TClassMethodDef = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_IsClassMethod : Boolean; // is class function as delphi would say
_CallChar : AnsiChar; // + or -
_Name : AnsiString;
procedure Parse(AParser: TTextParser); override;
function GetResultType: TResultTypeDef;
end;
@ -99,27 +156,31 @@ type
//todo: implement
TSubSection = class(TEntity) // for public, protected and private sections
protected
procedure DoParse(AParser: TTextParser); override;
public
_EntityName : AnsiString;
procedure Parse(AParser: TTextParser); override;
end;
{ TClassDef }
TClassDef = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_ClassName : AnsiString;
_SuperClass : AnsiString;
_Category : AnsiString;
procedure Parse(AParser: TTextParser); override;
end;
{ TObjCHeader }
TObjCHeader = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_FileName : AnsiString;
constructor Create;
procedure Parse(AParser: TTextParser); override;
end;
@ -127,14 +188,33 @@ const
EoLnChars : TCharSet = [#10,#13];
InvsChars : TCharSet = [#32,#9];
procedure SkipLine(const s: AnsiString; var index: Integer);
function IsSubStr(const sbs, s: AnsiString; index: Integer): Boolean;
function SkipLine(const s: AnsiString; var index: Integer): AnsiString;
procedure SetCComments(Table: TTokenTable);
procedure SetCSymbols(var ch: TCharSet);
function CreateObjCTokenTable: TTokenTable;
function LastEntity(ent: TEntity): TEntity;
function ParseCExpression(AParser: TTextParser): AnsiString;
implementation
function LastEntity(ent: TEntity): TEntity;
var
i : integer;
pre : TEntity;
begin
pre := nil;
while Assigned(ent) do begin
pre := ent;
i := pre.Items.Count - 1;
if i >= 0 then ent := TEntity(pre.Items[i])
else ent := nil;
end;
Result := pre;
end;
function CreateObjCTokenTable: TTokenTable;
begin
Result := TTokenTable.Create;
@ -191,15 +271,13 @@ begin
index := length(s) + 1;
end;
{ TTextParser }
function IsSubStr(const sbs, s: AnsiString; index: Integer): Boolean;
var
i : Integer;
j : Integer;
begin
Result := false;
if length(sbs) > length(s) - index then Exit;
if (sbs = '') or (length(sbs) > length(s) - index) then Exit;
j := index;
for i := 1 to length(sbs) do begin
if sbs[i] <> s[j] then Exit;
@ -224,20 +302,45 @@ begin
end;
end;
procedure SkipLine(const s: AnsiString; var index: Integer);
function SkipLine(const s: AnsiString; var index: Integer): AnsiString;
begin
ScanTo(s, index, EoLnChars);
ScanWhile(s, index, EoLnChars);
Result := ScanTo(s, index, EoLnChars);
ScanWhile(s, index, EoLnChars); // todo: skip a single line!
end;
{ TTextParser }
constructor TTextParser.Create;
begin
Index := 1;
Stack := TList.Create;
end;
destructor TTextParser.Destroy;
begin
Stack.Free;
inherited Destroy;
end;
procedure TTextParser.BeginParse(AObject: TObject);
begin
Stack.Add(AObject);
end;
procedure TTextParser.EndParse;
begin
if Stack.Count > 0 then Stack.Delete(Stack.Count - 1);
end;
function TTextParser.HandlePrecomiler: Boolean;
var
idx : Integer;
begin
idx := Index;
if Assigned(OnPrecompile) then
OnPrecompile(Self);
Result := Index <> idx;
end;
function TTextParser.FindNextToken(var Token: AnsiString; var TokenType: TTokenType): Boolean;
var
@ -266,28 +369,36 @@ begin
TokenType := tt_Ident;
while (not Result) and (index <= length(Buf)) do begin
ScanWhile(Buf, index, TokenTable.SpaceChars);
if (Buf[index] in TokenTable.Symbols) then begin
if (not (Buf[index] in blck)) or (not SkipComments) then begin
Result := true;
TokenType := tt_Symbol;
Token := Buf[index];
inc(index);
Exit;
end;
end else begin
Token := Token + ScanTo(Buf, index, srch+TokenTable.Symbols);
if (Buf[index] in blck) then begin
Result := SkipComments;
Result := Result or (Buf[index] in TokenTable.SpaceChars);
if not Result then begin
Token := Token + Buf[index];
if not (IsSubStr(TokenTable.Precompile, Buf, Index) and HandlePrecomiler) then begin
if (Buf[index] in TokenTable.Symbols) then begin
if (not (Buf[index] in blck)) or (not SkipComments) then begin
Result := true;
TokenType := tt_Symbol;
Token := Buf[index];
inc(index);
Exit;
end;
end else
end else if (Buf[index] in ['0'..'9']) then begin
//todo: Hex and floats support!
//todo: Negative numbers support;
TokenType := tt_Numeric;
Token := ScanWhile(Buf, index, ['0'..'9']);
Result := true;
Result := Result and (Token <> '');
Exit;
end else begin
Token := Token + ScanTo(Buf, index, srch+TokenTable.Symbols);
if (Buf[index] in blck) then begin
Result := SkipComments;
Result := Result or (Buf[index] in TokenTable.SpaceChars);
if not Result then begin
Token := Token + Buf[index];
inc(index);
end;
end else
Result := true;
Result := Result and (Token <> '');
end;
end;
end; {of while}
if not Result then TokenType := tt_None;
end;
@ -340,15 +451,31 @@ begin
inherited Destroy;
end;
procedure TEntity.Parse(AParser: TTextParser);
begin
AParser.BeginParse(Self);
try
DoParse(AParser);
finally
AParser.EndParse;
end;
end;
{ TClassDef }
procedure TClassDef.Parse(AParser:TTextParser);
procedure TClassDef.DoParse(AParser:TTextParser);
var
s : AnsiString;
tt : TTokenType;
cnt : Integer;
mtd : TClassMethodDef;
begin
AParser.FindNextToken(s, tt);
if s <> '@interface' then begin
//writeln(s);
Exit;
end;
AParser.FindNextToken(_ClassName, tt);
if (not AParser.FindNextToken(s, tt)) then Exit;
if tt = tt_Symbol then begin
@ -391,18 +518,27 @@ begin
inherited Create(nil);
end;
procedure TObjCHeader.Parse(AParser:TTextParser);
procedure TObjCHeader.DoParse(AParser:TTextParser);
var
s : AnsiString;
tt : TTokenType;
cl : TClassDef;
ent : TEntity;
i : Integer;
begin
i := AParser.Index;
while AParser.FindNextToken(s, tt) do begin
if s = '@interface' then begin
cl := TClassDef.Create(Self);
cl.Parse(AParser);
Items.Add(cl);
end;
if s = 'enum' then begin
AParser.Index := i;
ent := TEnumTypeDef.Create(Self);
ent.Parse(AParser);
end else if s = '@interface' then begin
AParser.Index := i;
ent := TClassDef.Create(Self);
ent.Parse(AParser);
end else
ent := nil;
if Assigned(ent) then Items.Add(ent);
i := AParser.Index;
end;
end;
@ -429,7 +565,7 @@ end;
procedure TClassMethodDef.Parse(AParser:TTextParser);
procedure TClassMethodDef.DoParse(AParser:TTextParser);
var
s : AnsiString;
tt : TTokenType;
@ -483,7 +619,7 @@ end;
procedure TParameterDef.Parse(AParser:TTextParser);
procedure TParameterDef.DoParse(AParser:TTextParser);
var
tt : TTokenType;
begin
@ -512,7 +648,7 @@ begin
end;
end;
procedure TResultTypeDef.Parse(AParser: TTextParser);
procedure TResultTypeDef.DoParse(AParser: TTextParser);
var
s : AnsiString;
tt : TTokenType;
@ -551,7 +687,7 @@ end;
{ TParamDescr }
procedure TParamDescr.Parse(AParser: TTextParser);
procedure TParamDescr.doParse(AParser: TTextParser);
var
tt : TTokenType;
begin
@ -560,9 +696,147 @@ end;
{ TSubSection }
procedure TSubSection.Parse(AParser: TTextParser);
procedure TSubSection.DoParse(AParser: TTextParser);
begin
//todo:
end;
{ TPrecompiler }
procedure TPrecompiler.DoParse(AParser: TTextParser);
var
tt : TTokenType;
idx : Integer;
begin
idx := AParser.Index;
if not AParser.FindNextToken(_Directive, tt) then begin
AParser.Index := idx;
Exit;
end;
if (_Directive = '') or (_Directive[1] <> '#') then begin
AParser.Index := idx;
Exit;
end;
_Params := SkipLine(AParser.Buf, AParser.Index);
end;
{ TEnumTypeDef }
function TEnumTypeDef.GetValue(idx: integer): TEnumValue;
var
i : Integer;
v : Integer;
begin
v := 0;
for i := 0 to Items.Count - 1 do
if (TObject(Items[i]) is TEnumValue) and (v=idx) then begin
Result := TEnumValue(Items[i]);
Exit;
end else
inc(v);
Result := nil;
end;
procedure TEnumTypeDef.DoParse(AParser: TTextParser);
var
token : AnsiString;
tt : TTokenType;
nm : AnsiString;
i : Integer;
vl : TEnumValue;
begin
if not AParser.FindNextToken(token, tt) then Exit;
if token <> 'enum' then Exit;
i := AParser.Index;
if not AParser.FindNextToken(nm, tt) then Exit;
if tt <> tt_Ident then AParser.Index := i
else _Name := nm;
AParser.FindNextToken(nm, tt);
if nm <> '{' then Exit;
repeat
vl := TEnumValue.Create(Self);
vl.Parse(AParser);
Items.Add(vl);
AParser.FindNextToken(nm, tt);
//writeln('enum separator: ', nm);
if (nm <> ',') and (nm <> '}') then // if not , then ; must be followed!
Exit;
until nm = '}';
AParser.FindNextToken(nm, tt); // skip last ';'
end;
function ParseCOperator(AParser: TTextParser; var Vl: AnsiString): Boolean;
var
nm : AnsiSTring;
tt : TTokenType;
begin
Result := false;
if not AParser.FindNextToken(nm, tt) then Exit;
Result := nm <> '';
if not Result then Exit;
vl := nm[1];
case vl[1] of
'+', '-', '*': Result := true;
'<', '>': begin
Result := false;
vl := nm[1];
Result := AParser.FindNextToken(nm, tt);
if (not Result) or (nm = '') then Exit;
Result := nm[1] = vl[1] ;
if Result then vl := vl[1] + nm[1];
end;
else
Result := false;
end;
end;
function ParseCExpression(AParser: TTextParser): AnsiString;
var
i : integer;
nm : AnsiString;
tt : TTokenType;
begin
i := AParser.Index;
Result := '';
while AParser.FindNextToken(nm, tt) do begin
if (tt = tt_Numeric) or (tt = tt_Ident) then begin
Result := Result + nm;
i := AParser.Index;
if not ParseCOperator(AParser, nm) then begin
AParser.Index := i;
Exit;
end else
Result := Result + ' ' + nm + ' ';
end else begin
i := AParser.Index;
Exit;
end;
end;
end;
{ TEnumValue }
procedure TEnumValue.DoParse(AParser: TTextParser);
var
i : integer;
s : AnsiString;
tt : TTokenType;
begin
AParser.FindNextToken(_Name, tt);
if tt <> tt_Ident then Exit;
i := AParser.Index;
AParser.FindNextToken(s, tt);
if s <> '=' then begin
AParser.Index := i;
Exit;
end;
_Value := ParseCExpression(AParser);
//writeln('enmvalName ', _Name);
//writeln('enmvalValue ', _Value);
end;
end.