+ added external functions and variables pascal code generation.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@722 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2009-02-25 19:40:38 +00:00
parent baddaf0b5c
commit 0c2e22da08
4 changed files with 190 additions and 42 deletions

View File

@ -228,8 +228,9 @@ type
function DoParse(AParser: TTextParser): Boolean; override;
function ParseAfterTypeName(AParser: TTextParser): Boolean;
public
_Type : TEntity;
_Name : AnsiString;
_Type : TEntity;
_Name : AnsiString;
_isConst : Boolean;
end;
{ TFunctionParam }
@ -237,9 +238,10 @@ type
protected
function DoParse(AParser: TTextParser): Boolean; override;
public
_Type : TEntity;
_Name : AnsiString;
_IsAny : Boolean;
_Type : TEntity;
_Name : AnsiString;
_IsAny : Boolean;
_IsArray : Boolean;
end;
{ TFunctionParamsList }
@ -542,6 +544,23 @@ implementation
var
CustomList : TList = nil;
function IsCReserved(const Token: AnsiString): Boolean;
begin
if Token = '' then begin
Result := false;
Exit;
end;
Result := true;
case Token[1] of
'c': begin
if Token = 'const' then Exit;
end;
end;
Result := false;
end;
function ParseSeq(Parser: TTextParser; const OpenSeq, CloseSeq: AnsiString): AnsiString;
var
i : integer;
@ -1449,7 +1468,11 @@ var
isext : Boolean;
idx : Integer;
Modifiers : TStringList;
begin
Modifiers := TStringList.Create;
Result := false;
idx := AParser.TokenPos;
try
@ -1468,7 +1491,13 @@ begin
end;
// expecting name of Variable or Function name
AParser.FindNextToken(_name, tt);
repeat
AParser.FindNextToken(_name, tt);
if isCReserved (_name) then begin
Modifiers.Add(_name);
_name := '';
end;
until _name <> '';
if tt <> tt_Ident then begin
Result := false;
@ -1498,6 +1527,7 @@ begin
finally
if not Result then
AParser.Index := idx;
Modifiers.Free;
end;
end;
@ -2414,6 +2444,19 @@ begin
AParser.Index := AParser.TokenPos
else
_Name := s;
AParser.FindNextToken(s, tt);
if (tt = tt_Symbol) and (s = '[') then begin
_IsArray := true;
AParser.FindNextToken(s, tt);
if s <> ']' then begin
AParser.SetError( ErrExpectStr(']', s));
Result := false;
Exit;
end;
end else
AParser.Index := AParser.TokenPos;
Result:=true;
end;

View File

@ -1,7 +1,7 @@
{ * This file is part of ObjCParser tool
{ * This file is part of ObjCParser tool
* Copyright (C) 2008-2009 by Dmitry Boyarintsev under the GNU LGPL
* license version 2.0 or 2.1. You should have received a copy of the
* LGPL license along with at http://www.gnu.org/
* LGPL license along with at http://www.gnu.org/
}
unit ObjCParserUtils;
@ -323,14 +323,14 @@ begin
if l = 'float' then Result := 'Single';
end;
if Result = objcType then begin
if isPointer then r := ConvertSettings.PtrTypeReplace[objcType]
else r := ConvertSettings.TypeDefReplace[objcType];
if r <> '' then
Result := r;
end;
if isPointer then begin
if ((objctype = 'char') or (objctype = 'const char')) then
Result := 'PChar'
@ -340,7 +340,7 @@ end;
function ObjCResultToDelphiType(Res: TObjCResultTypeDef) : AnsiString;
begin
if Res._Type is TTypeDef then
Result := ObjCToDelphiType( TTypeDef(Res._Type)._Name, TTypeDef(Res._Type)._IsPointer)
Result := ObjCToDelphiType( TTypeDef(Res._Type)._Name, TTypeDef(Res._Type)._IsPointer)
else begin
end;
end;
@ -829,6 +829,66 @@ begin
else Result := prefix + postfix;
end;
procedure WriteOutVariableToHeader(v: TVariable; const SpacePrefix: String; Vars: TStringList);
var
tp : TTypeDef;
s : AnsiString;
begin
tp := TTypeDef(v._Type);
s := Format('%s : %s; // external name ''%s''; ', [v._Name, ObjCToDelphiType(tp._Name, tp._IsPointer), v._Name] );
Vars.Add(SpacePrefix + s);
end;
function CParamsListToPascalStr(Params: TFunctionParamsList): AnsiString;
var
i : integer;
num : Integer;
prm : TFunctionParam;
vs : AnsiString;
begin
Result := '';
num := 1;
for i := 0 to Params.Items.Count - 1 do
if TObject(Params.Items[i]) is TFunctionParam then begin
prm := TFunctionParam(Params.Items[i]);
if prm._IsAny then Continue;
vs := ObjCToDelphiType( GetTypeNameFromEntity(prm._Type), IsTypeDefIsPointer(prm._Type));
if prm._Name = ''
then vs := '_param'+IntToStr(num) + ': ' + vs
else vs := prm._Name + ': ' + vs;
if Result <> '' then
Result := Result + '; ' + vs
else
Result := vs;
inc(num);
end;
end;
procedure WriteOutFunctionToHeader(f: TFunctionDef; st: TStringList);
var
restype : AnsiString;
fntype : AnsiString;
isptr : Boolean;
s : AnsiString;
begin
if not Assigned(f._ResultType) then begin
isptr := false;
fntype := 'int';
end else if (f._ResultType is TTypeDef) then begin
isptr := TTypeDef(f._ResultType)._IsPointer;
fntype := TTypeDef(f._ResultType)._Name;
end else begin
isptr := false;
fntype := '{todo: not implemented... see .h file for type}';
end;
restype := ObjCToDelphiType(fntype, isptr);
s:= GetProcFuncHead(f._Name, '', CParamsListToPascalStr(f._ParamsList), restype) + ' cdecl';
st.Add( s);
s := Format(' external name ''_%s'';', [f._Name]);
st.Add(s);
end;
procedure WriteOutEnumToHeader(enm: TEnumTypeDef; st: TStrings);
var
i : Integer;
@ -904,31 +964,6 @@ begin
end;
end;
function CParamsListToPascalStr(Params: TFunctionParamsList): AnsiString;
var
i : integer;
num : Integer;
prm : TFunctionParam;
vs : AnsiString;
begin
Result := '';
num := 1;
for i := 0 to Params.Items.Count - 1 do
if TObject(Params.Items[i]) is TFunctionParam then begin
prm := TFunctionParam(Params.Items[i]);
if prm._IsAny then Continue;
vs := ObjCToDelphiType( GetTypeNameFromEntity(prm._Type), IsTypeDefIsPointer(prm._Type));
if prm._Name = ''
then vs := '_param'+IntToStr(num) + ': ' + vs
else vs := prm._Name + ': ' + vs;
if Result <> '' then
Result := Result + '; ' + vs
else
Result := vs;
inc(num);
end;
end;
function CToDelphiFuncType(AFuncType: TFunctionTypeDef): AnsiString;
var
restype : AnsiString;
@ -1109,6 +1144,8 @@ var
subs : TStringList;
// s : AnsiString;
consts : TStringList;
vars : TStringList;
functs : TStringList;
const
SpacePrefix = ' ';
begin
@ -1116,7 +1153,8 @@ begin
BeginExcludeSection( GetIfDefFileName(hdr._FileName, 'H'), st);
subs := TStringList.Create;
consts := TStringList.Create;
vars := TStringList.Create;
functs := TStringList.Create;
try
for i := 0 to hdr.Items.Count - 1 do
if Assigned(hdr.Items[i]) then
@ -1144,7 +1182,11 @@ begin
subs.Add('//'+ TSkip(hdr.Items[i])._Skip)
else if (TObject(hdr.Items[i]) is TComment) then
//WriteOutIfComment(hdr.Items, i, SpacePrefix, subs);
WriteOutCommentStr( TComment(hdr.Items[i])._Comment, SpacePrefix, Subs);
WriteOutCommentStr( TComment(hdr.Items[i])._Comment, SpacePrefix, Subs)
else if (TObject(hdr.Items[i]) is TVariable) then
WriteOutVariableToHeader(TVariable(hdr.Items[i]), SpacePrefix, Vars)
else if (TObject(hdr.Items[i]) is TFunctionDef) then
WriteOutFunctionToHeader(TFunctionDef(hdr.Items[i]), Functs);
end; {of if}
st.add('');
@ -1154,12 +1196,27 @@ begin
subs.Clear;
end;
if vars.Count > 0 then begin
st.Add('');
st.Add('var');
st.AddStrings(vars);
end;
if functs.Count > 0 then begin
st.Add('');
st.AddStrings(functs);
end;
finally
EndSection(st);
EndSection(st);
subs.Add('');
subs.Free;
consts.Free;
vars.Free;
functs.Free;
end;
end;
@ -2072,6 +2129,7 @@ begin
TReplaceItem(fItems.Objects[i]).ReplaceStr := AValue;
end;
initialization
ConvertSettings := TConvertSettings.Create;
InitConvertSettings;

View File

@ -1,8 +1,8 @@
unit ObjCToPas;
{ * This file is part of ObjCParser tool
{ * This file is part of ObjCParser tool
* Copyright (C) 2008-2009 by Dmitry Boyarintsev under the GNU LGPL
* license version 2.0 or 2.1. You should have received a copy of the
* LGPL license along with at http://www.gnu.org/
* LGPL license along with at http://www.gnu.org/
}
// the unit contains (should contain) ObjC to Pascal convertion utility routines
// todo: move all ObjCParserUtils functions here.
@ -43,4 +43,8 @@ begin
end;
end;
end.

View File

@ -16,11 +16,12 @@ program objcparser;
{$endif}
uses
Classes,
Classes,
IniFiles,
SysUtils,
ObjCParserUtils,
ObjCParserTypes,
ObjCParserTypes,
ObjCTemplate,
gnuccFeatures;
type
@ -505,7 +506,49 @@ begin
end;
end;}
procedure TestTemplate;
var
fn : TFileStream;
tmp : AnsiString;
tp : TTemplateProc;
s : string;
pv : TPascalValues;
root: TTemplateList;
cl : TTemplateList;
begin
root:=TTemplateList.Create(nil);
cl:=TTemplateList.Create(root);
cl.Name :='class';
cl.Params.Values['class_objcname'] := 'NSNotebook';
cl.Params.Values['class_objcsupername'] := 'NSObject';
root.SubLists.Add(cl);
fn := TFileStream.Create('templatesample.txt', fmOpenRead or fmShareDenyNone);
tp := TTemplateProc.Create;
pv := TPascalValues.Create;
try
SetLength(tmp, fn.Size);
fn.Read(tmp[1], fn.Size);
s := tp.Parse(tmp, root, pv);
writeln(s);
readln;
finally
pv.Free;
tp.Free;
fn.Free;
end;
end;
begin
// TestTemplate;
// Exit;
doOutput := true;
try
GetConvertSettings(ConvertSettings, inpf);