chelper: fix for objc methods, protocols parsing and writting

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1288 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz 2010-08-16 13:23:30 +00:00
parent e3d745b988
commit dd80a33837
3 changed files with 247 additions and 171 deletions

View File

@ -226,9 +226,69 @@ type
_Params : AnsiString;
end;
// parsing function
type
{ TSimpleType }
TSimpleType = class(TEntity)
public
Name : AnsiString;
end;
{ TExpression }
TExpPart = record
Token : AnsiString;
TokenType : TTokenType;
end;
TExpression = class(TEntity)
function DoParse(AParser: TTextParser): Boolean; override;
public
Tokens : array of TExpPart;
Count : Integer;
procedure PushToken(const AToken: AnsiString; ATokenType: TTokenType);
end;
const
nk_Ident = 0;
nk_Ref = 1;
nk_Array = 2;
nk_Func = 3;
type
TNameKind = Integer;
type
TNamePart = class;
TFuncParam = record
prmtype : TEntity;
name : TNamePart;
end;
{ TNamePart }
TNamePart = class(TObject)
private
fChild : TNamePart;
fOwner : TNamePart;
public
Kind : TNameKind;
RefCount : Integer;
Id : AnsiString;
arrayexp : array of TExpression;
params : array of TFuncParam;
constructor Create(AKind: TNameKind);
procedure AddParam(prmtype: TEntity; prmname: TNamePart);
procedure AddArrayExpr(expr: TExpression);
property child: TNamePart read fchild write fChild; // int (*p)[10]; "[10]" is child of (*p)
property owner: TNamePart read fowner write fOwner;
end;
var
ParseNextEntity: function (AParser: TTextParser): TEntity = nil;
ParseNamePart : function (Parser: TTextParser): TNamePart = nil;
function ParseNextCEntity(AParser: TTextParser): TEntity;
@ -254,64 +314,12 @@ function CreateCParser(const CHeaderText: AnsiString;
type
TCustomEntityProc = function (Parent: TEntity; Parser: TTextParser): TEntity;
type
{ TSimpleType }
TSimpleType = class(TEntity)
public
Name : AnsiString;
end;
{ TExpression }
TExpPart = record
Token : AnsiString;
TokenType : TTokenType;
end;
TExpression = class(TEntity)
function DoParse(AParser: TTextParser): Boolean; override;
public
Tokens : array of TExpPart;
Count : Integer;
procedure PushToken(const AToken: AnsiString; ATokenType: TTokenType);
end;
procedure ErrorExpect(Parser: TTextParser; const Expect: AnsiString);
function ConsumeToken(Parser: TTextParser; const Token: AnsiString): Boolean;
function ConsumeIdentifier(Parser: TTextParser; var Id: AnsiString): Boolean;
function ParseCType(Parser: TTextParser): TEntity;
type
TNamePart = class;
TFuncParam = record
prmtype : TEntity;
name : TNamePart;
end;
TNameKind = (nk_Ident, nk_Ref, nk_Array, nk_Func);
{ TNamePart }
TNamePart = class(TObject)
private
fChild : TNamePart;
fOwner : TNamePart;
public
Kind : TNameKind;
RefCount : Integer;
Id : AnsiString;
arrayexp : array of TExpression;
params : array of TFuncParam;
constructor Create(AKind: TNameKind);
procedure AddParam(prmtype: TEntity; prmname: TNamePart);
procedure AddArrayExpr(expr: TExpression);
property child: TNamePart read fchild write fChild; // int (*p)[10]; "[10]" is child of (*p)
property owner: TNamePart read fowner write fOwner;
end;
function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean=True): Boolean;
function ParseName(Parser: TTextParser; var NameType: TEntity; var name: TNamePart): Boolean;
@ -1458,8 +1466,6 @@ end;
function ParseNextCEntity(AParser: TTextParser): TEntity;
var
s : AnsiString;
tt : TTokenType;
tp : TEntity;
nm : TNamePart;
v : TVarFuncEntity;
@ -1493,6 +1499,8 @@ begin
end else
Result:=v;
end;
if AParser.Token<>';' then ErrorExpect(AParser,';');
end;
procedure ErrorExpect(Parser:TTextParser;const Expect:AnsiString);
@ -1644,7 +1652,7 @@ begin
Parser.NextToken;
end;
function ParseNamePart(Parser: TTextParser): TNamePart;
function ParseCNamePart(Parser: TTextParser): TNamePart;
var
prefix : TNamePart;
id : TNamePart;
@ -2023,6 +2031,7 @@ end;
initialization
ParseNextEntity:=@ParseNextCEntity;
ParseNamePart:=@ParseCNamePart;
end.

View File

@ -81,6 +81,23 @@ function isNumberExp(x: TExpression; var v: Int64): Boolean;
// int a[MAXCONST] -> a: array [0..MAXCONST-1] of Integer;
function PasArrayLimit(x: TExpression): AnsiString;
type
{ TStopComment }
TStopComment = class(TObject)
public
FirstComment : boolean;
CommentFound : boolean;
CommentEnd : Integer;
Precomp : TEntity;
PrecompEnd : Integer;
procedure OnComment(Sender: TObject; const Str: ansistring);
procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
procedure Clear;
end;
implementation
type
@ -114,7 +131,6 @@ type
CmtList : TList;
Breaker : TLineBreaker;
LastOffset : Integer;
function FindCommentForLine(ln: Integer): TComment;
protected
fWriters : TList;
AuxTypeCounter : Integer;
@ -140,7 +156,7 @@ type
procedure WriteEnumAsConst(en: TEnumType; FinishWithInteger: Boolean=True);
procedure WriteUnion(st: TUnionType);
procedure WriteStruct(st: TStructType);
procedure WriteCommentToPas(cent: TComment);
procedure WriteCommentToPas(cent: TComment; NeedLineBreak: Boolean);
procedure WriteExp(x: TExpression);
procedure WritePreprocessor(cent: TCPrepDefine);
@ -239,21 +255,7 @@ begin
end;
type
{ TStopComment }
TStopComment = class(TObject)
public
FirstComment : boolean;
CommentFound : boolean;
CommentEnd : Integer;
Precomp : TEntity;
PrecompEnd : Integer;
procedure OnComment(Sender: TObject; const Str: ansistring);
procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
end;
{ TStopComment }
procedure TStopComment.OnComment(Sender: TObject; const Str: ansistring);
var
@ -278,22 +280,24 @@ begin
end;
end;
function ParseNextEntityOrComment(AParser: TTextParser): TEntity;
procedure TStopComment.Clear;
begin
FirstComment:=False;
CommentFound:=False;
Precomp:=nil;
CommentEnd:=-1;
PrecompEnd:=-1;
end;
function ParseNextEntityOrComment(AParser: TTextParser; cmt: TStopComment): TEntity;
var
cmt : TStopComment;
ent : TEntity;
entidx : Integer;
begin
cmt := TStopComment.Create;
AParser.UseCommentEntities := True;
AParser.OnComment := @cmt.OnComment;
AParser.OnPrecompile:=@cmt.OnPrecompiler;
Result:=nil;
AParser.NextToken;
ent := ParseNextEntity(AParser);
entidx:=AParser.Index;
entidx := AParser.Index;
if cmt.FirstComment then begin
if Assigned(cmt.Precomp) then begin
@ -306,11 +310,11 @@ begin
end;
end;
cmt.Free;
if (not Assigned(Result)) or (Assigned(ent) and (ent.Offset<Result.Offset)) then begin
Result:=ent;
AParser.Index:=entidx;
end;
end else
AParser.NextToken;
end;
function GetRefAsterix(const AstCount: integer): ansistring;
@ -343,7 +347,6 @@ begin
Result:=PasExp(x) + '-1';
end;
procedure WriteArray(arr: TNamePart; wr: TCodeWriter);
var
i : Integer;
@ -353,7 +356,6 @@ begin
wr.W(' of ');
end;
type
TMacrosMaker = class(TObject)
public
@ -436,6 +438,7 @@ var
owncfg : Boolean;
lastsec : AnsiString; // last code section
ofs : Integer;
cmt : TStopComment;
begin
Result:='';
ent:=nil;
@ -447,13 +450,19 @@ begin
if cfg.CustomDefines<>'' then PrepareMacros(cfg.CustomDefines, macros);
cmt := TStopComment.Create;
p := CreateCParser(t);
p.MacroHandler:=macros;
p.UseCommentEntities := True;
p.OnComment := @cmt.OnComment;
p.OnPrecompile:=@cmt.OnPrecompiler;
try
repeat
try
ofs := p.Index;
ent := ParseNextEntityOrComment(p);
p.NextToken;
ent := ParseNextEntityOrComment(p, cmt);
except
ent:=nil;
end;
@ -473,7 +482,7 @@ begin
end;
end;
cnv.WriteCtoPas(ent, p.Comments, t);
cnv.WriteCtoPas(ent, p.Comments, p.Buf);
lastsec:=cnv.wr.Section;
except
@ -495,15 +504,14 @@ begin
while i < p.Index do begin
Inc(endPoint.Y);
le := i;
SkipLine(t, i);
SkipLine(p.Buf, i);
end;
endPoint.X := p.Index - le + 1 + p.MacrosDelta;
finally
p.Free;
macros.Free;
cmt.Free;
end;
except
on e: Exception do Result:=Result+LineEnding+' internal error: '+ e.Message;
@ -533,7 +541,7 @@ begin
inherited Destroy;
end;
procedure TCodeConvertor.WriteCommentToPas(cent: TComment);
procedure TCodeConvertor.WriteCommentToPas(cent: TComment; NeedLineBreak: Boolean);
var
u: ansistring;
begin
@ -541,12 +549,13 @@ begin
if cent.CommenType = ctBlock then
begin
u := StringReplace(u, '*)', '* )', [rfReplaceAll]);
wr.Wln('(*' + u + ' *)');
wr.W('(*' + u + ' *)');
end
else
begin
wr.Wln('//' + u);
wr.W('//' + u);
end;
if NeedLineBreak then wr.Wln;
end;
procedure TCodeConvertor.WriteExp(x:TExpression);
@ -625,7 +634,10 @@ begin
if m.Args[i].Name=''
then PNames[i]:=cfg.ParamPrefix+IntToStr(i)
else PNames[i]:=m.Args[i].Name;
PTypes[i]:=GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName);
if not Assigned(m.Args[i].RetType) then
PTypes[i]:='id'
else
PTypes[i]:=GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName);
end;
DefFuncWrite(wr, GetPasObjCMethodName(m.Name), ret, PNames, PTypes);
@ -662,7 +674,6 @@ begin
wr.W('procedure '+nm+'(AValue: '+tp+'); message '''+mtd+''';');
end;
end;
end;
@ -675,14 +686,17 @@ begin
for i:=0 to list.Count-1 do begin
ent:=TEntity(list[i]);
if not Assigned(ent) then Continue;
WriteLnCommentsBeforeOffset(ent.Offset);
if ent is TObjCMethod then
WriteObjCMethod(TObjCMethod(ent))
else if ent is TObjCProperty then begin
WriteObjCProperty(TObjCProperty(ent));
end;
WriteLnCommentForOffset(ent.Offset);
end;
end;
procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
@ -696,7 +710,9 @@ const
begin
SetPasSection(wr, 'type');
if cent.isCategory then begin
wr.W(cent.Name + ' = objccategory')
wr.W(cent.Name + ' = objccategory');
if cent.SuperClass<>'' then wr.W('('+cent.SuperClass+')');
wr.Wln;
end else begin
wr.W(cent.Name + ' = objcclass');
if cent.SuperClass<>'' then wr.W('('+cent.SuperClass);
@ -730,7 +746,7 @@ begin
WriteObjCMethods(cent.Methods);
wr.DecIdent;
end;
wr.Wln('end external;')
wr.Wln('end external;');
end;
procedure TCodeConvertor.WriteObjCProtocol(cent:TObjCProtocol);
@ -738,19 +754,24 @@ var
i : Integer;
begin
SetPasSection(wr, 'type');
wr.W(cent.Name+'Protocol = objcprotocol');
if cent.Names.Count=1 then begin
wr.W(cent.Names[0]+'Protocol = objcprotocol');
if cent.Protocols.Count>0 then begin
wr.W('(');
for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', ');
wr.W(cent.Protocols[cent.Protocols.Count-1]);
wr.Wln(')');
if cent.Protocols.Count>0 then begin
wr.W('(');
for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', ');
wr.W(cent.Protocols[cent.Protocols.Count-1]);
wr.Wln(')');
end;
wr.IncIdent;
WriteObjCMethods(cent.Methods);
wr.DecIdent;
wr.W('end; ');
wr.Wln(' external name '''+cent.Names[0]+''';');
end else begin
for i:=0 to cent.Names.Count-1 do
wr.Wln(cent.Names[i]+'Protocol = objcprotocol; external name '''+cent.Names[i]+''';');
end;
wr.IncIdent;
WriteObjCMethods(cent.Methods);
wr.DecIdent;
wr.W('end; ');
wr.Wln(' external name '''+cent.Name+''';');
end;
procedure TCodeConvertor.PushWriter;
@ -808,14 +829,25 @@ end;
procedure TCodeConvertor.WriteLnCommentForOffset(AOffset:Integer; NeedOffset: Boolean);
var
cmt : TComment;
ln : Integer;
c : Integer;
i : Integer;
begin
cmt:=FindCommentForLine( Breaker.LineNumber(AOffset));
if Assigned(cmt) then begin
LastOffset:=cmt.Offset;
if NeedOffset then wr.W(' ');
WriteCommentToPas(cmt);
end else
wr.Wln;
ln:= Breaker.LineNumber(AOffset);
c:=0;
for i:=0 to CmtList.Count-1 do begin
cmt:=TComment(CmtList[i]);
if Breaker.LineNumber(TComment(CmtList[i]).Offset)=ln then begin
if NeedOffset then begin
wr.W(' ');
NeedOffset:=False;
end;
WriteCommentToPas(cmt, false);
LastOffset:=cmt.Offset;
inc(c);
end;
end;
wr.Wln;
end;
function TCodeConvertor.NextCommentBefore(AOffset:Integer):Integer;
@ -1078,7 +1110,7 @@ begin
wr.Wln(';');
end;
end else if cent is TComment then
WriteCommentToPas(cent as TComment)
WriteCommentToPas(cent as TComment, True)
else if cent is TCPrepDefine then
WritePreprocessor(cent as TCPrepDefine)
else if cent is TObjCInterface then
@ -1332,20 +1364,7 @@ begin
wr.W(PasTypeName + ' = ');}
wr.W('todo: '+TypeEntity.ClassName);
end;
//todo: ...
end;
function TCodeConvertor.FindCommentForLine(ln:Integer):TComment;
var
i : Integer;
begin
Result:=nil;
if not Assigned(CmtList) then Exit;
for i:=0 to CmtList.Count-1 do
if Breaker.LineNumber(TComment(CmtList[i]).Offset)=ln then begin
Result:=TComment(CmtList[i]);
Exit;
end;
//todo: ...parse any Entity
end;
procedure TCodeConvertor.DefFuncWrite(wr:TCodeWriter;const FuncName,FuncRetType:AnsiString;

View File

@ -26,6 +26,9 @@ interface
uses
Classes, SysUtils, cparsertypes;
const
objcend = '@end';
type
{ TObjCClasses }
@ -54,6 +57,7 @@ type
RetName : TNamePart;
Args : array of TObjCMethodArg;
Option : TObjCMethodOpt;
VarParams : Boolean;
constructor Create(AOffset: Integer=-1); override;
destructor Destroy; override;
procedure AddArg(const ArgType: TEntity; ArgTypeName: TNamePart; const Name: AnsiString);
@ -88,7 +92,7 @@ type
TObjCProtocol = class(TEntity)
public
Name : AnsiString;
Names : TStringList;
isForward : Boolean;
Protocols : TStringList;
Methods : TList;
@ -113,7 +117,7 @@ function ParseClassList(AParser: TTextParser): TObjCClasses;
function ParseInterface(AParser: TTextParser): TObjCInterface;
function ParseMethod(AParser: TTextParser): TObjCMethod;
function ParseProperty(AParser: TTextParser): TObjCProperty;
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean;
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = objcend): Boolean;
function ParseProtocol(AParser: TTextParser): TEntity;
function ParseNextObjCEntity(AParser: TTextParser): TEntity;
@ -121,6 +125,9 @@ function ParseNextObjCEntity(AParser: TTextParser): TEntity;
function isObjCKeyword(const token: AnsiString): Boolean; inline;
function GetObjCKeyword(const token: AnsiString): AnsiString;
const
nk_Protocol = $1000;
implementation
function isObjCKeyword(const token: AnsiString): Boolean; inline;
@ -140,25 +147,30 @@ var
begin
Result:=nil;
if AParser.Token<>'@class' then Exit;
cl:=TObjCClasses.Create(AParser.TokenPos);
AParser.NextToken;
while AParser.Token<>';' do begin
if AParser.TokenType<>tt_Ident then begin
ErrorExpect(AParser,'identifier');
cl.Free;
Exit;
end;
cl.Classes.Add(AParser.Token);
try
cl:=TObjCClasses.Create(AParser.TokenPos);
AParser.NextToken;
if AParser.Token=',' then
AParser.NextToken
else if AParser.Token<>';' then begin
ErrorExpect(AParser,';');
cl.Free;
Exit;
while AParser.Token<>';' do begin
if AParser.TokenType<>tt_Ident then begin
ErrorExpect(AParser,'identifier');
cl.Free;
Exit;
end;
cl.Classes.Add(AParser.Token);
AParser.NextToken;
if AParser.Token=',' then
AParser.NextToken
else if AParser.Token<>';' then begin
ErrorExpect(AParser,';');
cl.Free;
Exit;
end;
end;
if AParser.Token<>';' then ErrorExpect(AParser, ';');
Result:=cl;
finally
if not Assigned(Result) then cl.Free;
end;
Result:=cl;
end;
function ParseInstVars(AParser: TTextParser; Vars: TList): Boolean;
@ -217,14 +229,14 @@ begin
itf:=TObjCInterface.Create(i);
try
itf.Name:=nm;
itf.isCategory:=AParser.Token='(';
if itf.isCategory then begin
AParser.NextToken;
if not ConsumeIdentifier(AParser, itf.SuperClass) and ConsumeToken(AParser, ')') then
itf.SuperClass:=nm;
AParser.NextToken;
if not (ConsumeIdentifier(AParser, itf.Name) and ConsumeToken(AParser, ')')) then
Exit;
end else begin
itf.Name:=nm;
// super-class
if AParser.Token=':' then begin
AParser.NextToken;
@ -249,8 +261,8 @@ begin
ParseInstVars(AParser, itf.Vars);
end;
if not ParseMethods(AParser, itf.Methods, '@end') then Exit;
if AParser.Token='@end' then AParser.NextToken;
if not ParseMethods(AParser, itf.Methods, objcend) then Exit;
if AParser.Token<>objcend then ErrorExpect(AParser, objcend);
Result:=itf;
finally
@ -268,11 +280,17 @@ begin
p := TObjCProtocol.Create(AParser.TokenPos);
try
AParser.NextToken;
if not ConsumeIdentifier(AParser, p.Name) then Exit;
p.isForward:= AParser.Token=';';
if not ConsumeIdentifier(AParser, nm) then Exit;
p.Names.Add(nm);
p.isForward:= (AParser.Token=';') or (AParser.Token=',');
if p.isForward then begin
while AParser.Token<>';' do begin
AParser.NextToken;
ConsumeIdentifier(AParser, nm);
p.Names.Add(nm);
end;
Result:=p;
AParser.NextToken;
if AParser.Token<>';' then ErrorExpect(AParser, ';');
Exit;
end;
@ -286,8 +304,8 @@ begin
if AParser.Token='>' then AParser.NextToken;
end;
if ParseMethods(AParser, p.Methods, '@end') then Result:=p;
if AParser.Token='@end' then AParser.NextToken;
if ParseMethods(AParser, p.Methods, objcend) then Result:=p;
if AParser.Token<>objcend then ErrorExpect(AParser, objcend);
finally
if not Assigned(Result) then p.Free;
end;
@ -295,6 +313,7 @@ end;
var
PrevParseNextEntity : function (AParser: TTextParser): TEntity = nil;
PrevNamePart : function (AParser: TTextParser): TNamePart = nil;
function ParseNextObjCEntity(AParser: TTextParser): TEntity;
var
@ -377,25 +396,36 @@ begin
m.Name.Add(nm+':');
AParser.NextToken;
while AParser.Token<>';' do begin
prm:=ConsumeToken(AParser, '(') and
ParseName(APArser, atype, atname) and
ConsumeToken(AParser, ')') and
ConsumeIdentifier(AParser, aname);
while (AParser.Token<>';') and (AParser.Token<>',') do begin
if AParser.Token='(' then begin
prm:=ConsumeToken(AParser, '(') and
ParseName(APArser, atype, atname) and
ConsumeToken(AParser, ')');
end else begin
prm:=True;
atype:=nil;
atname:=nil;
end;
if not prm then Exit;
ConsumeIdentifier(AParser, aname);
m.AddArg(atype, atname, aname);
// the next name starts
if AParser.TokenType=tt_Ident then ConsumeIdentifier(AParser, nm) else nm:='';
if AParser.Token<>';' then begin
if (AParser.Token<>';') and (AParser.Token<>',') then begin
if not ConsumeToken(AParser,':') then Exit;
m.Name.Add(nm+':');
end;
end;
AParser.NextToken;
end else begin
end else
m.Name.Add(nm);
if not ConsumeToken(AParser, ';') then Exit;
if AParser.Token=',' then begin
AParser.NextToken;
if ConsumeToken(AParser,'...') then m.VarParams:=True
else ErrorExpect(AParser, '...');
end;
if not ConsumeToken(AParser, ';') then Exit;
Result:=m;
finally
@ -403,7 +433,7 @@ begin
end;
end;
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = '@end'): Boolean;
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean;
var
m : TObjCMethod;
p : TObjCProperty;
@ -484,6 +514,7 @@ begin
inherited Create(AOffset);
Protocols := TStringList.Create;
Methods := TList.Create;
Names := TStringList.Create;
end;
destructor TObjCProtocol.Destroy;
@ -493,6 +524,7 @@ begin
for i:=0 to Methods.Count-1 do TObject(Methods[i]).Free;
Methods.Free;
Protocols.Free;
Names.Free;
inherited Destroy;
end;
@ -521,7 +553,7 @@ begin
Result:=nil;
if AParser.Token<>'@property' then Exit;
AParser.NextToken;
p := TObjCProperty.Create;
p := TObjCProperty.Create(AParser.TokenPos);
try
if AParser.Token='(' then begin
AParser.NextToken;
@ -556,9 +588,25 @@ begin
end;
end;
function ParseObjCNamePart(AParser: TTextParser): TNamePart;
var
p : AnsiString;
begin
// skipping protocol adopted type definition
if AParser.Token='<' then begin
Result:=nil;
AParser.NextToken;
if not (ConsumeIdentifier(AParser, p) and ConsumeToken(AParser,'>')) then Exit;
end;
Result:=PrevNamePart(AParser);
end;
initialization
PrevParseNextEntity:=ParseNextEntity;
ParseNextEntity:=ParseNextObjCEntity;
PrevNamePart:=ParseNamePart;
ParseNamePart:=ParseObjCNamePart;
end.