diff --git a/components/chelper/cparsertypes.pas b/components/chelper/cparsertypes.pas index b6d330ff9..1c077d54b 100755 --- a/components/chelper/cparsertypes.pas +++ b/components/chelper/cparsertypes.pas @@ -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. diff --git a/components/chelper/ctopasconvert.pas b/components/chelper/ctopasconvert.pas index a2f130b89..a74682d70 100644 --- a/components/chelper/ctopasconvert.pas +++ b/components/chelper/ctopasconvert.pas @@ -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'' 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; diff --git a/components/chelper/objcparsing.pas b/components/chelper/objcparsing.pas index 1b00501e3..ead66fa84 100644 --- a/components/chelper/objcparsing.pas +++ b/components/chelper/objcparsing.pas @@ -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.