pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

updated. categories are added to the class if possible

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@399 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2008-03-31 12:45:50 +00:00
parent 6930a5c720
commit 0c99d758e2
1 changed files with 306 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files

336
bindings/pascocoa/parser/ObjCParserTypes.pas
View File

@ -6,8 +6,7 @@
objc parsing unit objc parsing unit
} }
//todo: pre-compile directives // todo: remove last ';' skipping. must be added lately
//todo: enum and struct and a lot of other types...
unit ObjCParserTypes; unit ObjCParserTypes;
@ -17,7 +16,7 @@ interface
{$ifdef fpc}{$mode delphi}{$endif fpc} {$ifdef fpc}{$mode delphi}{$endif fpc}
uses uses
Classes; Classes, SysUtils;
type type
TTokenType = (tt_Ident, tt_Symbol, tt_None, tt_Numeric); TTokenType = (tt_Ident, tt_Symbol, tt_None, tt_Numeric);
@ -80,6 +79,7 @@ type
{ TComment } { TComment }
//C tokens: /*, //
TComment = class(TEntity) TComment = class(TEntity)
protected protected
procedure DoParse(AParser: TTextParser); override; procedure DoParse(AParser: TTextParser); override;
@ -89,6 +89,7 @@ type
{ TPrecompiler } { TPrecompiler }
//C token: #
TPrecompiler = class(TEntity) TPrecompiler = class(TEntity)
protected protected
procedure DoParse(AParser: TTextParser); override; procedure DoParse(AParser: TTextParser); override;
@ -110,6 +111,7 @@ type
{ TEnumTypeDef } { TEnumTypeDef }
//C token: enum
TEnumTypeDef = class(TEntity) TEnumTypeDef = class(TEntity)
protected protected
fValCount : Integer; fValCount : Integer;
@ -121,37 +123,71 @@ type
property ValuesCount: Integer read fValCount; property ValuesCount: Integer read fValCount;
end; end;
{ TStructField }
TStructField = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_Name : AnsiString;
_BitSize : Integer;
_Type : TEntity;
_TypeName : AnsiString;
end;
{ TStructTypeDef }
//C token: struct
TStructTypeDef = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_Name : AnsiString;
end;
{ TTypeDef }
//C token - any type, including unsigned short
TTypeDefSpecs = set of (td_Unsigned, td_Signed, td_Volitale, td_Const, td_Long, td_Short);
TTypeDef = class(TEntity)
protected
procedure DoParse(AParser: TTextParser); override;
public
_Name : AnsiString;
_Spec : TTypeDefSpecs;
_IsPointer : Boolean;
end;
{ TTypeNameDef } { TTypeNameDef }
//C token: typdef
TTypeNameDef = class(TEntity) TTypeNameDef = class(TEntity)
protected protected
procedure DoParse(AParser: TTextParser); override; procedure DoParse(AParser: TTextParser); override;
public public
fValCount : Integer;
_Inherited : AnsiString; _Inherited : AnsiString;
_OfType : TEntity; // if _Inheried = ''; _Type : TEntity;
_TypeName : AnsiString; _TypeName : AnsiString;
end; end;
{ TParameterDef } { TObjCParameterDef }
TResultTypeDef = class(TEntity) TObjCResultTypeDef = class(TTypeDef)
protected protected
procedure DoParse(AParser: TTextParser); override; procedure DoParse(AParser: TTextParser); override;
public public
_isRef : Boolean; _isRef : Boolean;
_TypeName : AnsiString;
_isConst : Boolean; // (const Sometype) _isConst : Boolean; // (const Sometype)
_Prefix : AnsiString; // reserved-word type descriptors _Prefix : AnsiString; // reserved-word type descriptors
end; end;
TParameterDef = class(TEntity) TObjCParameterDef = class(TEntity)
protected protected
procedure DoParse(AParser: TTextParser); override; procedure DoParse(AParser: TTextParser); override;
public public
_Res : TResultTypeDef; _Res : TObjCResultTypeDef;
_Name : AnsiString; _Name : AnsiString;
function GetResultType: TResultTypeDef;
end; end;
{ TParamDescr } { TParamDescr }
@ -172,7 +208,7 @@ type
_IsClassMethod : Boolean; // is class function as delphi would say _IsClassMethod : Boolean; // is class function as delphi would say
_CallChar : AnsiChar; // + or - _CallChar : AnsiChar; // + or -
_Name : AnsiString; _Name : AnsiString;
function GetResultType: TResultTypeDef; function GetResultType: TObjCResultTypeDef;
end; end;
{ TSubSection } { TSubSection }
@ -194,6 +230,9 @@ type
_ClassName : AnsiString; _ClassName : AnsiString;
_SuperClass : AnsiString; _SuperClass : AnsiString;
_Category : AnsiString; _Category : AnsiString;
_Protocols : TStringList;
constructor Create(AOwner : TEntity);
destructor Destroy; override;
end; end;
{ TObjCHeader } { TObjCHeader }
@ -224,8 +263,53 @@ function ParseCExpression(AParser: TTextParser): AnsiString;
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString; function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString; function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function ParseTypeDef(Owner: TEntity; AParser: TTextParser): TEntity;
implementation implementation
function GetTypeNameFromEntity(Entity: TEntity): AnsiString;
begin
Result := '';
if Assigned(Entity) then begin
if Entity is TStructTypeDef then // hmm... a common ancsessotor should be used?
Result := TStructTypeDef(Entity)._Name
else if Entity is TEnumTypeDef then
Result := TEnumTypeDef(Entity)._Name
else if Entity is TTypeDef then begin
Result := TTypeDef(Entity)._Name;
end;
end;
end;
(* ANSI C reserved words
auto break case char const continue default do double else enum
extern float for goto if int long register return short signed
sizeof static struct switch typedef union unsigned void volatile while
*)
function ParseTypeDef(Owner: TEntity; AParser: TTextParser): TEntity;
var
s : AnsiString;
tt : TTokenType;
res : Boolean;
begin
Result := nil;
res := AParser.FindNextToken(s, tt);
if not Res or (tt <> tt_Ident) then Exit;
s := AnsiLowerCase(s);
if s = 'enum' then
Result := TEnumTypeDef.Create(Owner)
else if s = 'struct' then
Result := TStructTypeDef.Create(Owner)
else
Result := TTypeDef.Create(Owner);
AParser.Index := AParser.TokenPos;
if Assigned(Result) then Result.Parse(AParser);
end;
function LastEntity(ent: TEntity): TEntity; function LastEntity(ent: TEntity): TEntity;
var var
i : integer; i : integer;
@ -396,6 +480,7 @@ begin
Token := ''; Token := '';
Result := false; Result := false;
TokenType := tt_Ident; TokenType := tt_Ident;
try
while (not Result) and (index <= length(Buf)) do begin while (not Result) and (index <= length(Buf)) do begin
ScanWhile(Buf, index, TokenTable.SpaceChars); ScanWhile(Buf, index, TokenTable.SpaceChars);
if not (IsSubStr(TokenTable.Precompile, Buf, Index) and HandlePrecomiler) then begin // 1. check is Compiler directive is found if not (IsSubStr(TokenTable.Precompile, Buf, Index) and HandlePrecomiler) then begin // 1. check is Compiler directive is found
@ -429,9 +514,12 @@ begin
end; end;
end; end;
end; {of while} end; {of while}
if not Result then TokenType := tt_None finally
if not Result
then TokenType := tt_None
else TokenPos := Index - length(Token); else TokenPos := Index - length(Token);
end; end;
end;
function TTextParser.SkipComments: Boolean; function TTextParser.SkipComments: Boolean;
var var
@ -501,6 +589,18 @@ end;
{ TClassDef } { TClassDef }
constructor TClassDef.Create(AOwner: TEntity);
begin
inherited Create(AOwner);
_Protocols := TStringList.Create;
end;
destructor TClassDef.Destroy;
begin
_Protocols.Free;
inherited;
end;
procedure TClassDef.DoParse(AParser:TTextParser); procedure TClassDef.DoParse(AParser:TTextParser);
var var
s : AnsiString; s : AnsiString;
@ -510,12 +610,12 @@ var
begin begin
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
if s <> '@interface' then begin if s <> '@interface' then begin
//writeln(s);
Exit; Exit;
end; end;
AParser.FindNextToken(_ClassName, tt); AParser.FindNextToken(_ClassName, tt);
if (not AParser.FindNextToken(s, tt)) then Exit;
if (not AParser.FindNextToken(s, tt)) then Exit; // parsing super class or category
if tt = tt_Symbol then begin if tt = tt_Symbol then begin
if s[1] = ':' then if s[1] = ':' then
AParser.FindNextToken(_SuperClass, tt) AParser.FindNextToken(_SuperClass, tt)
@ -526,7 +626,18 @@ begin
Exit; Exit;
end; end;
cnt := 0; AParser.FindNextToken(s, tt); // parsing protocols
if (tt = tt_Symbol) and (s = '<') then begin
repeat
if not AParser.FindNextToken(s, tt) then Exit;
if (s <> '>') then _Protocols.Add(s);
AParser.FindNextToken(s, tt); // "," or ">"
until (s = '>');
end else
AParser.Index := AParser.TokenPos;
cnt := 0; // pasring private declarations
repeat repeat
if not AParser.FindNextToken(s, tt) then begin if not AParser.FindNextToken(s, tt) then begin
s := ''; s := '';
@ -537,6 +648,7 @@ begin
else if s = '}' then dec(cnt) else if s = '}' then dec(cnt)
else if (cnt = 0) then begin else if (cnt = 0) then begin
//todo: better parsing //todo: better parsing
// parsing methods
if s[1] ='#' then SkipLine(AParser.buf, AParser.Index); if s[1] ='#' then SkipLine(AParser.buf, AParser.Index);
if (s = '+') or (s = '-') then begin if (s = '+') or (s = '-') then begin
dec(AParser.Index ); // roll back a single character dec(AParser.Index ); // roll back a single character
@ -545,7 +657,7 @@ begin
Items.Add(mtd); Items.Add(mtd);
end; end;
end; end;
until (s = '@end') or (s = ''); until (s = '@end') or (s = ''); // looking for declaration end
end; end;
{ TObjCHeader } { TObjCHeader }
@ -569,9 +681,9 @@ begin
ent.Parse(AParser); ent.Parse(AParser);
end else if s = 'enum' then begin end else if s = 'enum' then begin
AParser.Index := AParser.TokenPos; AParser.Index := AParser.TokenPos;
//writeln('start parse TEnumAt ', AParser.Index);
ent := TEnumTypeDef.Create(Self); ent := TEnumTypeDef.Create(Self);
ent.Parse(AParser); ent.Parse(AParser);
AParser.FindNextToken(s, tt); // skipping last ';'
end else if s = '@interface' then begin end else if s = '@interface' then begin
AParser.Index := AParser.TokenPos; AParser.Index := AParser.TokenPos;
ent := TClassDef.Create(Self); ent := TClassDef.Create(Self);
@ -584,19 +696,16 @@ end;
{ TClassMethodDef } { TClassMethodDef }
function TClassMethodDef.GetResultType: TResultTypeDef; function TClassMethodDef.GetResultType: TObjCResultTypeDef;
var var
i : integer; i : integer;
begin begin
for i := 0 to Items.Count - 1 do for i := 0 to Items.Count - 1 do
if TObject(Items[i]) is TResultTypeDef then begin if TObject(Items[i]) is TObjCResultTypeDef then begin
Result := TObjCResultTypeDef(Items[i]);
Result := TResultTypeDef(Items[i]);
Exit; Exit;
end; end;
Result := nil; Result := nil;
@ -609,8 +718,8 @@ procedure TClassMethodDef.DoParse(AParser:TTextParser);
var var
s : AnsiString; s : AnsiString;
tt : TTokenType; tt : TTokenType;
res : TResultTypeDef; res : TObjCResultTypeDef;
para : TParameterDef; para : TObjCParameterDef;
des : TParamDescr; des : TParamDescr;
begin begin
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
@ -621,27 +730,24 @@ begin
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
if (tt = tt_Symbol) and(s = '(') then begin if (tt = tt_Symbol) and(s = '(') then begin
// _Class methods can be with out type // _Class methods can be with out type
dec(AParser.Index); AParser.Index:=AParser.TokenPos;
res := TResultTypeDef.Create(Self); res := TObjCResultTypeDef.Create(Self);
res.Parse(AParser); res.Parse(AParser);
Items.Add(res); Items.Add(res);
end; end;
AParser.FindNextToken(_Name, tt); AParser.FindNextToken(_Name, tt);
if _Name = '_id' then
_Name := '_id';
while AParser.FindNextToken(s, tt) do begin while AParser.FindNextToken(s, tt) do begin
if s = ';' then if s = ';' then
Exit Exit
else if s = ':' then begin else if s = ':' then begin
para := TParameterDef.Create(Self); para := TObjCParameterDef.Create(Self);
para.Parse(AParser); para.Parse(AParser);
Items.Add(para); Items.Add(para);
end else if tt = tt_Ident then begin end else if tt = tt_Ident then begin
des := TParamDescr.Create(Self); des := TParamDescr.Create(Self);
des._Descr := s; des._Descr := s;
Items.Add(des) Items.Add(des);
end; end;
end; end;
@ -650,23 +756,14 @@ end;
{ TParameterDef } { TParameterDef }
function TParameterDef.GetResultType: TResultTypeDef; procedure TObjCParameterDef.DoParse(AParser:TTextParser);
begin
Result := _Res;
end;
procedure TParameterDef.DoParse(AParser:TTextParser);
var var
tt : TTokenType; tt : TTokenType;
begin begin
_Res := TResultTypeDef.Create(Self); _Res := TObjCResultTypeDef.Create(Self);
Items.Add(_Res);
_Res.Parse(AParser); _Res.Parse(AParser);
AParser.FindNextToken(_Name, tt) Items.Add(_Res);
AParser.FindNextToken(_Name, tt);
end; end;
{ TResultTypeDef } { TResultTypeDef }
@ -688,17 +785,15 @@ begin
end; end;
end; end;
procedure TResultTypeDef.DoParse(AParser: TTextParser); procedure TObjCResultTypeDef.DoParse(AParser: TTextParser);
var var
s : AnsiString; s : AnsiString;
tt : TTokenType; tt : TTokenType;
begin begin
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
if (tt <> tt_Symbol) and (s <> '(') then Exit; if (tt <> tt_Symbol) and (s <> '(') then Exit;
inherited DoParse(AParser);
_prefix := ''; (* _prefix := '';
_TypeName := ''; _TypeName := '';
repeat repeat
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
@ -716,8 +811,9 @@ begin
if (tt = tt_Symbol) and (s = '*') then begin if (tt = tt_Symbol) and (s = '*') then begin
_isRef := true; _isRef := true;
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
end; end;*)
AParser.FindNextToken(s, tt);
if s <> ')' then ; // an error if s <> ')' then ; // an error
end; end;
@ -808,11 +904,12 @@ begin
end; end;
AParser.FindNextToken(nm, tt); AParser.FindNextToken(nm, tt);
//writeln('enum separator: ', nm);
if (nm <> ',') and (nm <> '}') then // if not , then ; must be followed! if (nm <> ',') and (nm <> '}') then // if not , then ; must be followed!
Exit; Exit;
until nm = '}'; until nm = '}';
AParser.FindNextToken(nm, tt); // skip last ';'
//AParser.FindNextToken(nm, tt); // skip last ';'
end; end;
function ParseCOperator(AParser: TTextParser; var Vl: AnsiString): Boolean; function ParseCOperator(AParser: TTextParser; var Vl: AnsiString): Boolean;
@ -828,7 +925,6 @@ begin
case vl[1] of case vl[1] of
'+', '-', '*': Result := true; '+', '-', '*': Result := true;
'<', '>': begin '<', '>': begin
Result := false;
vl := nm[1]; vl := nm[1];
Result := AParser.FindNextToken(nm, tt); Result := AParser.FindNextToken(nm, tt);
if (not Result) or (nm = '') then Exit; if (not Result) or (nm = '') then Exit;
@ -846,7 +942,7 @@ var
nm : AnsiString; nm : AnsiString;
tt : TTokenType; tt : TTokenType;
begin begin
i := AParser.Index; // i := AParser.Index;
Result := ''; Result := '';
while AParser.FindNextToken(nm, tt) do begin while AParser.FindNextToken(nm, tt) do begin
if (tt = tt_Numeric) or (tt = tt_Ident) then begin if (tt = tt_Numeric) or (tt = tt_Ident) then begin
@ -858,7 +954,7 @@ begin
end else end else
Result := Result + ' ' + nm + ' '; Result := Result + ' ' + nm + ' ';
end else begin end else begin
i := AParser.Index; //i := AParser.Index;
Exit; Exit;
end; end;
end; end;
@ -872,7 +968,6 @@ var
s : AnsiString; s : AnsiString;
tt : TTokenType; tt : TTokenType;
begin begin
//writeln('Start to TEnumVal scan at: ', AParser.Index);
AParser.FindNextToken(_Name, tt); AParser.FindNextToken(_Name, tt);
if tt <> tt_Ident then Exit; if tt <> tt_Ident then Exit;
@ -883,8 +978,6 @@ begin
_Value := ''; _Value := '';
end else end else
_Value := ParseCExpression(AParser); _Value := ParseCExpression(AParser);
//writeln('enmvalName ', _Name);
//writeln('enmvalValue ', _Value);
end; end;
{ TComment } { TComment }
@ -903,10 +996,129 @@ var
begin begin
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
if s <> 'typedef' then Exit; if s <> 'typedef' then Exit;
// _OfType is not supported _Type := ParseTypeDef(Self, AParser);
AParser.FindNextToken(_Inherited, tt);
AParser.FindNextToken(_TypeName, tt); AParser.FindNextToken(_TypeName, tt);
_inherited := GetTypeNameFromEntity(_Type);
AParser.FindNextToken(s, tt); // skip last ';'; AParser.FindNextToken(s, tt); // skip last ';';
end; end;
{ TStructTypeDef }
procedure TStructTypeDef.DoParse(AParser: TTextParser);
var
s : AnsiString;
tt : TTokenType;
i : Integer;
st : TStructField;
begin
AParser.FindNextToken(s, tt);
if s <> 'struct' then Exit;
AParser.FindNextToken(s, tt);
i := AParser.TokenPos;
if (tt = tt_Ident) then begin
_Name := s;
AParser.FindNextToken(s, tt);
AParser.Index := i;
end;
if (tt <> tt_Symbol) and (s <> '{') then begin
AParser.Index := i;
Exit;
end;
AParser.FindNextToken(s, tt);
while s <> '}' do begin
//i := AParser.TokenPos;
st := TStructField.Create(Self);
st.Parse(AParser);
Items.Add(st);
AParser.FindNextToken(s, tt);
end;
//no skipping last ';', because after structure a variable can be defined
//ie: struct POINT {int x; int y} point;
end;
{ TStructField }
function CVal(c: AnsiString; var v: Integer): Boolean; // todo: hex, oct handling (0x, x)
var
err : Integer;
begin
Val(c, v, err);
Result := err = 0;
end;
procedure TStructField.DoParse(AParser: TTextParser);
var
tt : TTokenType;
s : AnsiString;
begin
_Type := ParseTypeDef(Self, AParser);
if Assigned(_Type) then Exit;
_TypeName := GetTypeNameFromEntity(_Type);
if not (AParser.FindNextToken(_Name, tt)) or (tt <> tt_Ident) then Exit;
AParser.FindNextToken(s, tt);
if (tt = tt_Symbol) and (s = ':') then begin
AParser.FindNextToken(s, tt);
CVal(s, _BitSize);
AParser.FindNextToken(s, tt);
end;
//success: (tt = tt_Symbol) and (s = ';')
end;
{ TTypeDef }
function IsSpecifier(const s: AnsiSTring; var SpecVal, SpecMask: TTypeDefSpecs): Boolean;
begin
Result := true;
if (s = 'volitle') then begin
SpecVal := [td_Volitale];
SpecMask := [td_Volitale, td_Const];
end else if (s = 'const') then begin
SpecVal := [td_Volitale];
SpecMask := [td_Volitale, td_Const];
end else if (s = 'signed') then begin
SpecVal := [td_Signed];
SpecMask := [td_Signed, td_Unsigned];
end else if (s = 'unsigned') then begin
SpecVal := [td_Unsigned];
SpecMask := [td_Signed, td_Unsigned];
end else if (s = 'long') then begin
SpecVal := [td_Long];
SpecMask := [td_Long, td_Short];
end else if (s = 'short') then begin
SpecVal := [td_Short];
SpecMask := [td_Long, td_Short];
end else
Result := false;
end;
procedure TTypeDef.DoParse(AParser: TTextParser);
var
s : AnsiString;
tt : TTokenType;
vl : TTypeDefSpecs;
msk : TTypeDefSpecs;
begin
AParser.FindNextToken(s, tt);
while (tt = tt_Ident) and (IsSpecifier(s, vl, msk)) do begin
if _Spec * msk <> [] then Exit;
_Spec := _Spec + vl;
AParser.FindNextToken(s, tt);
end;
if tt = tt_Ident then begin
_Name := s;
AParser.FindNextToken(s, tt);
if (tt = tt_Symbol) and (s = '*') then begin
_isPointer := true;
end else begin
AParser.Index := AParser.TokenPos;
end;
end else ; //error
end;
end. end.