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

chelper: improved objc interface parsing and code generation

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1284 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2010-08-15 11:53:16 +00:00
parent 2a5f151adc
commit 838a446e4a
2 changed files with 107 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

77
components/chelper/ctopasconvert.pas
View File

@ -18,7 +18,6 @@
}
unit ctopasconvert;
{$mode objfpc}{$H+}
interface
@ -50,6 +49,8 @@ type
CustomDefines : AnsiString;
// obj-c
RemoveLastUnderscores : Boolean;
constructor Create;
destructor Destroy; override;
@ -142,7 +143,7 @@ type
procedure WriteExp(x: TExpression);
procedure WritePreprocessor(cent: TCPrepDefine);
function GetObjCMethodName(names: TStrings): AnsiString;
function GetPasObjCMethodName(names: TStrings): AnsiString;
procedure WriteObjCMethod(m: TObjCMethod);
procedure WriteObjCInterface(cent: TObjCInterface);
@ -590,40 +591,40 @@ begin
end;
end;
function TCodeConvertor.GetObjCMethodName(names:TStrings):AnsiString;
function TCodeConvertor.GetPasObjCMethodName(names:TStrings):AnsiString;
var
i : Integer;
begin
Result:='';
for i:=0 to names.Count-1 do Result:=Result+names[i];
for i:=1 to length(Result) do if Result[i]=':' then Result[i]:='_';
if cfg.RemoveLastUnderscores then begin
i:=length(Result);
while (i>0) and (Result[i]='_') do dec(i);
Result:=Copy(Result, 1, i);
end;
end;
procedure TCodeConvertor.WriteObjCMethod(m: TObjCMethod);
var
ret : AnsiString;
i : INteger;
ret : AnsiString;
i : Integer;
PNames : array of AnsiString;
PTypes : array of AnsiString;
begin
if m.RetType=nil then ret:='id' else ret:=GetPasTypeName(m.RetType, m.RetName);
if ret='' then wr.W('procedure ')
else wr.W('function ');
wr.W( GetObjCMethodName(m.Name) );
if length(m.Args)>0 then begin
wr.W('(');
SetLength(PNames, length(m.Args));
SetLength(PTypes, length(m.Args));
if length(m.Args)>0 then
for i:=0 to length(m.Args)-1 do begin
if m.Args[i].Name='' then wr.W(cfg.ParamPrefix+IntToStr(i))
else wr.W(m.Args[i].Name);
wr.W(': ');
wr.W(GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName));
if i<length(m.Args)-1 then wr.W('; ');
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);
end;
wr.W(')');
end;
if ret<>'' then wr.W(': '+ ret);
DefFuncWrite(wr, GetPasObjCMethodName(m.Name), ret, PNames, PTypes);
wr.W(';');
wr.W(' message ''');
for i:=0 to m.Name.Count-1 do wr.W(m.Name[i]);
wr.Wln(''';');
@ -633,6 +634,11 @@ procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
var
i : Integer;
m : TObjCMethod;
sc : TObjCScope;
v : TObjCInstVar;
sect : AnsiString;
const
sectname : array [TObjCScope] of AnsiString = ('private', 'protected', 'public', 'protected');
begin
SetPasSection(wr, 'type');
if cent.isCategory then begin
@ -647,16 +653,33 @@ begin
wr.W(cent.Protocols[cent.Protocols.Count-1]);
end;
if (cent.SuperClass<>'') or (cent.Protocols.Count>0) then wr.Wln(')');
sect:='';
sc:=os_Public;
for i:=0 to cent.Vars.Count-1 do begin
v:=TObjCInstVar(cent.Vars[i]);
if (sect='') or (v.scope<>sc) then begin
if sect<>'' then wr.DecIdent;
sc:=v.scope;
sect:=sectname[sc];
wr.Wln(sect);
wr.IncIdent;
end;
WriteFuncOrVar(v.v, false, true);
end;
if sect<>'' then wr.DecIdent;
end;
wr.Wln('public');
wr.IncIdent;
for i:=0 to cent.Methods.Count-1 do begin
m:=TObjCMethod(cent.Methods[i]);
WriteObjCMethod(m)
if cent.Methods.Count>0 then begin
wr.Wln('public');
wr.IncIdent;
for i:=0 to cent.Methods.Count-1 do begin
m:=TObjCMethod(cent.Methods[i]);
WriteObjCMethod(m)
end;
wr.DecIdent;
wr.Wln('end;')
end;
wr.DecIdent;
wr.Wln('end;')
end;
procedure TCodeConvertor.PushWriter;

87
components/chelper/objcparsing.pas
View File

@ -1,3 +1,21 @@
{ The unit is part of Lazarus Chelper package
Copyright (C) 2010 Dmitry Boyarintsev skalogryz dot lists at gmail.com
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 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 Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit
objcparsing;
@ -38,6 +56,17 @@ type
procedure AddArg(const ArgType: TEntity; ArgTypeName: TNamePart; const Name: AnsiString);
end;
TObjCScope = (os_Private, os_Protected, os_Public, os_Package);
{ TObjCInstVar }
TObjCInstVar = class(TEntity)
public
scope : TObjCScope;
v : TVarFuncEntity;
destructor Destroy; override;
end;
{ TObjCInterface }
TObjCInterface = class(TEntity)
@ -46,10 +75,7 @@ type
SuperClass : AnsiString;
isCategory : Boolean;
Protocols : TStringList;
ProtVars : TList;
PrivVars : TList;
PubVars : TList;
PackVars : TList;
Vars : TList;
Methods : TList;
constructor Create(AOffset: Integer=-1); override;
destructor Destroy; override;
@ -106,37 +132,40 @@ begin
Result:=cl;
end;
function ParseInstVars(AParser: TTextParser; itf: TObjCInterface): Boolean;
function ParseInstVars(AParser: TTextParser; Vars: TList): Boolean;
var
vars : TList;
v : TVarFuncEntity;
iv : TObjCInstVar;
s : AnsiString;
scope : TObjCScope;
begin
Result:=True;
if AParser.Token<>'{' then Exit;
Result:=False;
AParser.NextToken;
vars:=itf.ProtVars;
scope:=os_Protected;
while AParser.Token<>'}' do begin
if isObjCKeyword(AParser.Token) then begin
s:=GetObjCKeyword(APArser.Token);
if s='protected' then vars:=itf.ProtVars
else if s='private' then vars:=itf.PrivVars
else if s='public' then vars:=itf.PubVars
else if s='package' then vars:=itf.PackVars
if s='protected' then scope:=os_Protected
else if s='private' then scope:=os_Private
else if s='public' then scope:=os_Public
else if s='package' then scope:=os_Package
else begin
ErrorExpect(AParser,'}');
Exit;
end;
AParser.NextToken;
end else begin
v:=TVarFuncEntity.Create(APArser.TokenPos);
v:=TVarFuncEntity.Create(AParser.TokenPos);
if not ParseNames(AParser, v.RetType, v.Names) then Exit;
vars.Add(v);
if AParser.Token=';' then
AParser.NextToken;
iv:=TObjCInstVar.Create(v.Offset);
iv.v:=v;
iv.scope:=scope;
Vars.Add(iv);
if AParser.Token=';' then AParser.NextToken;
end;
end;
AParser.NextToken;
@ -191,7 +220,7 @@ begin
end;
//writeln('parsing vars1 ', AParser.Token);
ParseInstVars(AParser, itf);
ParseInstVars(AParser, itf.Vars);
//writeln('parsing vars2 ', AParser.Token);
end;
@ -250,10 +279,7 @@ end;
constructor TObjCInterface.Create(AOffset:Integer);
begin
ProtVars := TList.Create;
PrivVars := TList.Create;
PubVars := TList.Create;
PackVars := TList.Create;
Vars := TList.Create;
Methods := TList.Create;
Protocols := TStringList.Create;
inherited Create(AOffset);
@ -263,18 +289,10 @@ destructor TObjCInterface.Destroy;
var
i : Integer;
begin
for i:=0 to ProtVars.Count-1 do TObject(ProtVars[i]).Free;
for i:=0 to PrivVars.Count-1 do TObject(PrivVars[i]).Free;
for i:=0 to PubVars.Count-1 do TObject(PubVars[i]).Free;
for i:=0 to PackVars.Count-1 do TObject(PubVars[i]).Free;
PrivVars.Free;
PubVars.Free;
ProtVars.Free;
PackVars.Free;
for i:=0 to Vars.Count-1 do TObject(Vars[i]).Free;
Vars.Free;
for i:=0 to Methods.Count-1 do TObject(Methods[i]).Free;
Methods.Free;
Protocols.Free;
inherited Destroy;
end;
@ -388,6 +406,15 @@ begin
Args[i].TypeName:=ArgTypeName;
end;
{ TObjCInstVar }
destructor TObjCInstVar.Destroy;
begin
v.Free;
inherited Destroy;
end;
initialization
PrevParseNextEntity:=ParseNextEntity;
ParseNextEntity:=ParseNextObjCEntity;