diff --git a/components/chelper/cconvert.lpi b/components/chelper/cconvert.lpi index 532cd8c58..6ad4e6435 100644 --- a/components/chelper/cconvert.lpi +++ b/components/chelper/cconvert.lpi @@ -31,12 +31,17 @@ - + + + + + + diff --git a/components/chelper/cconvert.lpr b/components/chelper/cconvert.lpr index 2affa914e..26c8ab4bf 100644 --- a/components/chelper/cconvert.lpr +++ b/components/chelper/cconvert.lpr @@ -22,7 +22,8 @@ program cconvert; uses SysUtils,Classes, - ctopasconvert,cparserutils,cconvconfig; + ctopasconvert,cparsertypes,cparserutils,cconvconfig, objcparsing, + objctopasconvert; var ConfigFile : AnsiString = ''; diff --git a/components/chelper/cparsertypes.pas b/components/chelper/cparsertypes.pas index d7d64afb7..b6d330ff9 100755 --- a/components/chelper/cparsertypes.pas +++ b/components/chelper/cparsertypes.pas @@ -20,12 +20,7 @@ unit cparsertypes; interface -{$ifdef fpc}{$mode delphi}{$h+} -{$else} -{$warn unsafe_code off} -{$warn unsafe_type off} -{$warn unsafe_cast off} -{$endif} +{$ifdef fpc}{$mode delphi}{$h+}{$endif} uses Classes, SysUtils, TextParsingUtils; @@ -232,7 +227,11 @@ type end; // parsing function -function ParseNextEntity(AParser: TTextParser): TEntity; +var + ParseNextEntity: function (AParser: TTextParser): TEntity = nil; + +function ParseNextCEntity(AParser: TTextParser): TEntity; + function ParseCExpression(AParser: TTextParser; var ExpS: AnsiString): Boolean; procedure ParseCNumeric(const S: AnsiString; var idx: integer; var NumStr: AnsiSTring); function ParseCString(const S: AnsiString; var idx: Integer; var CStr: AnsiString): Boolean; @@ -280,6 +279,7 @@ type 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; @@ -1455,7 +1455,7 @@ begin end; -function ParseNextEntity(AParser: TTextParser): TEntity; +function ParseNextCEntity(AParser: TTextParser): TEntity; var s : AnsiString; tt : TTokenType; @@ -1465,7 +1465,7 @@ var v : TVarFuncEntity; begin Result := nil; - if not AParser.FindNextToken(s, tt) then Exit; + s:=AParser.Token; if s = 'typedef' then begin Result:=ParseTypeDef(AParser); @@ -1507,6 +1507,16 @@ begin else Parser.SetError('Token expected: '+Token); end; +function ConsumeIdentifier(Parser: TTextParser; var Id: AnsiString): Boolean; +begin + Result:=Parser.TokenType=tt_Ident; + if Result then begin + id:=Parser.Token; + Parser.NextToken; + end else + Parser.SetError('Identifier expected'); +end; + function ParseCType(Parser: TTextParser): TEntity; var simple : TSimpleType; @@ -2011,4 +2021,8 @@ begin inherited Destroy; end; +initialization + ParseNextEntity:=@ParseNextCEntity; + + end. diff --git a/components/chelper/ctopasconvert.pas b/components/chelper/ctopasconvert.pas index b8bc83895..5c19e6698 100644 --- a/components/chelper/ctopasconvert.pas +++ b/components/chelper/ctopasconvert.pas @@ -18,13 +18,15 @@ } unit ctopasconvert; + {$mode objfpc}{$H+} interface uses Classes, SysUtils, - cparsertypes, TextParsingUtils, codewriter, cparserutils; + cparsertypes, TextParsingUtils, codewriter, cparserutils, + objcparsing; type @@ -140,6 +142,10 @@ type procedure WriteExp(x: TExpression); procedure WritePreprocessor(cent: TCPrepDefine); + function GetObjCMethodName(names: TStrings): AnsiString; + procedure WriteObjCMethod(m: TObjCMethod); + procedure WriteObjCInterface(cent: TObjCInterface); + procedure PushWriter; procedure PopWriter; public @@ -279,6 +285,8 @@ begin AParser.OnPrecompile:=@cmt.OnPrecompiler; Result:=nil; + AParser.NextToken; + ent := ParseNextEntity(AParser); entidx:=AParser.Index; @@ -582,6 +590,75 @@ begin end; end; +function TCodeConvertor.GetObjCMethodName(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]:='_'; +end; + +procedure TCodeConvertor.WriteObjCMethod(m: TObjCMethod); +var + ret : AnsiString; + i : INteger; +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('('); + 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'' then wr.W(': '+ ret); + wr.W(';'); + + wr.W(' message '''); + for i:=0 to m.Name.Count-1 do wr.W(m.Name[i]); + wr.Wln(''';'); +end; + +procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface); +var + i : Integer; + m : TObjCMethod; +begin + SetPasSection(wr, 'type'); + if cent.isCategory then begin + wr.W(cent.Name + ' = objccategory') + end else begin + wr.W(cent.Name + ' = objcclass'); + if cent.SuperClass<>'' then wr.W('('+cent.SuperClass); + if cent.Protocols.Count>0 then begin + if cent.SuperClass='' then wr.W('(id, ') + else wr.W(', '); + for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', '); + wr.W(cent.Protocols[cent.Protocols.Count-1]); + end; + if (cent.SuperClass<>'') or (cent.Protocols.Count>0) then wr.Wln(')'); + end; + + 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; + procedure TCodeConvertor.PushWriter; begin if not Assigned(fWriters) then fWriters:=TList.Create; @@ -900,6 +977,8 @@ begin WriteCommentToPas(cent as TComment) else if cent is TCPrepDefine then WritePreprocessor(cent as TCPrepDefine) + else if cent is TObjCInterface then + WriteObjCInterface(cent as TObjCInterface) else begin if DebugEntities then wr.Wln(cent.ClassName); diff --git a/components/chelper/objcparsing.pas b/components/chelper/objcparsing.pas new file mode 100644 index 000000000..741658d43 --- /dev/null +++ b/components/chelper/objcparsing.pas @@ -0,0 +1,396 @@ +unit + objcparsing; + +interface + +{$ifdef fpc}{$mode delphi}{$h+}{$endif} + +uses + Classes, SysUtils, cparsertypes; + +type + + { TObjCClasses } + + TObjCClasses = class(TEntity) + Classes : TStringList; + constructor Create(AOffset: Integer=-1); override; + destructor Destroy; override; + end; + + { TObjCMethod } + + TObjCMethodArg = record + RetType : TEntity; + TypeName : TNamePart; + Name : AnsiString; + end; + + TObjCMethod = class(TEntity) + public + isClassMethod : Boolean; + Name : TStringList; + RetType : TEntity; + RetName : TNamePart; + Args : array of TObjCMethodArg; + constructor Create(AOffset: Integer=-1); override; + destructor Destroy; override; + procedure AddArg(const ArgType: TEntity; ArgTypeName: TNamePart; const Name: AnsiString); + end; + + { TObjCInterface } + + TObjCInterface = class(TEntity) + public + Name : AnsiString; + SuperClass : AnsiString; + isCategory : Boolean; + Protocols : TStringList; + ProtVars : TList; + PrivVars : TList; + PubVars : TList; + PackVars : TList; + Methods : TList; + constructor Create(AOffset: Integer=-1); override; + destructor Destroy; override; + end; + +function ParseClassList(AParser: TTextParser): TObjCClasses; +function ParseInterface(AParser: TTextParser): TObjCInterface; +function ParseMethod(AParser: TTextParser): TObjCMethod; +function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean; +function ParserProtocol(AParser: TTextParser): TEntity; + +function ParseNextObjCEntity(AParser: TTextParser): TEntity; + +function isObjCKeyword(const token: AnsiString): Boolean; inline; +function GetObjCKeyword(const token: AnsiString): AnsiString; + +implementation + +function isObjCKeyword(const token: AnsiString): Boolean; inline; +begin + Result:=(token<>'') and (token[1]='@'); +end; + +function GetObjCKeyword(const token: AnsiString): AnsiString; +begin + if isObjCKeyword(token) then Result:=Copy(token, 2, length(token)-1) + else Result:=token; +end; + +function ParseClassList(AParser: TTextParser): TObjCClasses; +var + cl : TObjCClasses; +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); + AParser.NextToken; + if AParser.Token=',' then + AParser.NextToken + else if AParser.Token<>';' then begin + ErrorExpect(AParser,';'); + cl.Free; + Exit; + end; + end; + Result:=cl; +end; + +function ParseInstVars(AParser: TTextParser; itf: TObjCInterface): Boolean; +var + vars : TList; + v : TVarFuncEntity; + s : AnsiString; +begin + Result:=True; + if AParser.Token<>'{' then Exit; + + Result:=False; + AParser.NextToken; + vars:=itf.ProtVars; + + 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 + else begin + ErrorExpect(AParser,'}'); + Exit; + end; + AParser.NextToken; + end else begin + v:=TVarFuncEntity.Create(APArser.TokenPos); + if not ParseNames(AParser, v.RetType, v.Names) then Exit; + vars.Add(v); + if AParser.Token=';' then + AParser.NextToken; + end; + end; + AParser.NextToken; + + Result:=True; +end; + +function ParseInterface(AParser: TTextParser): TObjCInterface; +var + itf : TObjCInterface; + i : Integer; + nm : AnsiString; +begin + Result:=nil; + if AParser.Token<>'@interface' then Exit; + i:=AParser.TokenPos; + AParser.NextToken; + + if not ConsumeIdentifier(AParser, nm) then Exit; + + 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 + Exit; + end else begin + + // super-class + if AParser.Token=':' then begin + AParser.NextToken; + if not ConsumeIdentifier(AParser, itf.SuperClass) then Exit; + //writeln('SuperClass = ', itf.SuperClass); + end; + + // protocols + if AParser.Token='<' then begin + AParser.NextToken; + while AParser.Token<>'>' do begin + if not ConsumeIdentifier(AParser, nm) then Exit; + //writeln('Protos = ', nm); + itf.Protocols.Add(nm); + if AParser.Token=',' then AParser.NextToken + else if AParser.Token<>'>' then begin + ErrorExpect(AParser, '>'); + Exit; + end; + end; + AParser.NextToken; + end; + + //writeln('parsing vars1 ', AParser.Token); + ParseInstVars(AParser, itf); + //writeln('parsing vars2 ', AParser.Token); + end; + + //writeln('parsing methods1 ', AParser.Token); + if not ParseMethods(AParser, itf.Methods, '@end') then Exit; + //writeln('parsing methods2 ', AParser.Token); + + if AParser.Token='@end' then AParser.NextToken; + + Result:=itf; + finally + if not Assigned(Result) then itf.Free; + end; +end; + +function ParserProtocol(AParser: TTextParser): TEntity; +begin + Result:=nil; +end; + +var + PrevParseNextEntity : function (AParser: TTextParser): TEntity = nil; + +function ParseNextObjCEntity(AParser: TTextParser): TEntity; +var + t : AnsiString; +begin + if AParser.Token[1]='@' then begin + t:=GetObjCKeyword(AParser.Token); + if t='class' then Result:=ParseClassList(AParser) + else if t='interface' then Result:=ParseInterface(AParser) + else if t='protocol' then Result:=ParserProtocol(AParser); + end else begin + if Assigned(PrevParseNextEntity) then + Result:=PrevParseNextEntity(AParser) + else + Result:=nil; + end; +end; + +{ TObjCClasses } + +constructor TObjCClasses.Create(AOffset:Integer); +begin + inherited Create(AOffset); + Classes := TStringList.Create; +end; + +destructor TObjCClasses.Destroy; +begin + Classes.Free; + inherited Destroy; +end; + +{ TObjCInterface } + +constructor TObjCInterface.Create(AOffset:Integer); +begin + ProtVars := TList.Create; + PrivVars := TList.Create; + PubVars := TList.Create; + PackVars := TList.Create; + Methods := TList.Create; + Protocols := TStringList.Create; + inherited Create(AOffset); +end; + +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 Methods.Count-1 do TObject(Methods[i]).Free; + Methods.Free; + + Protocols.Free; + inherited Destroy; +end; + +function ParseMethod(AParser: TTextParser): TObjCMethod; +var + m : TObjCMethod; + nm : AnsiString; + atype : TEntity; + atname : TNamePart; + aname : Ansistring; + prm : Boolean; +begin + Result:=nil; + if (AParser.Token<>'+') and (AParser.Token<>'-') then Exit; + //writeln('in method: ', AParser.Token); + m:=TObjCMethod.Create(AParser.TokenPos); + try + AParser.NextToken; + + //writeln('in method2: ', AParser.Token); + if AParser.Token='(' then begin + AParser.NextToken; + if not ParseName(AParser, m.RetType, m.RetName) then Exit; + if not ConsumeToken(AParser, ')') then Exit; + end; + + //writeln('in method3: ', AParser.Token); + if not ConsumeIdentifier(AParser, nm) then Exit; + + //writeln('in method3: ', AParser.Token); + if (AParser.Token=':') then begin + m.Name.Add(nm+':'); + AParser.NextToken; + + //writeln('in method4: ', AParser.Token); + while AParser.Token<>';' do begin + prm:=ConsumeToken(AParser, '(') and + ParseName(APArser, atype, atname) and + ConsumeToken(AParser, ')') and + ConsumeIdentifier(AParser, aname); + if not prm then Exit; + m.AddArg(atype, atname, aname); + + if AParser.TokenType=tt_Ident then ConsumeIdentifier(AParser, nm) else nm:=''; + if AParser.Token<>';' then begin + if not ConsumeToken(AParser,':') then Exit; + m.Name.Add(nm+':'); + end; + end; + AParser.NextToken; + end else begin + m.Name.Add(nm); + if not ConsumeToken(AParser, ';') then Exit; + end; + + //writeln('in method5: ', AParser.Token); + Result:=m; + finally + if not Assigned(Result) then m.Free; + end; +end; + +function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = '@end'): Boolean; +var + m : TObjCMethod; +begin + Result:=False; + if not Assigned(MethodsList) or not Assigned(AParser) then Exit; + while (AParser.Token<>EndToken) and (AParser.Token<>'') and (AParser.Token[1] in ['+','-']) do begin + //writeln('AParser.Token = ', AParser.Token); + m:=ParseMethod(AParser); + //writeln('m = ', Integer(m)); + if not Assigned(m) then Exit; + MethodsList.Add(m); + end; + Result:=True; +end; + +{ TObjCMethod } + +constructor TObjCMethod.Create(AOffset:Integer); +begin + inherited Create(AOffset); + Name := TStringList.Create; + RetType := TVarFuncEntity.Create; +end; + +destructor TObjCMethod.Destroy; +var + i : Integer; +begin + Name.Free; + RetType.Free; + RetName.Free; + for i:=0 to length(Args)-1 do begin + Args[i].RetType.Free; + Args[i].TypeName.Free; + end; + inherited Destroy; +end; + +procedure TObjCMethod.AddArg(const ArgType:TEntity;ArgTypeName:TNamePart;const Name:AnsiString); +var + i : Integer; +begin + i:=length(Args); + SetLength(Args, i+1); + Args[i].Name:=Name; + Args[i].RetType:=ArgType; + Args[i].TypeName:=ArgTypeName; +end; + +initialization + PrevParseNextEntity:=ParseNextEntity; + ParseNextEntity:=ParseNextObjCEntity; + +end. +