freepascal.compiler/packages/webidl/src/webidltopas.pp

{
    This file is part of the Free Component Library

    WEBIDL to pascal code converter
    Copyright (c) 2021 by Michael Van Canneyt [email protected]

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    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.

 **********************************************************************}
unit webidltopas;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, contnrs, WebIDLParser, WebIDLScanner, WebIDLDefs, pascodegen;

Type

  { TPasData }

  TPasData = Class(TObject)
  private
    FPasName: String;
  Public
    IDL: TIDLBaseObject;
    Line, Column: integer;
    SrcFile: string;
    Resolved: TIDLDefinition;
    Constructor Create(APasName: String; D: TIDLBaseObject);
    Property PasName: String read FPasName;
  end;
  TPasDataClass = class of TPasData;

  TBaseConversionOption = (
    coAddOptionsToHeader,
    coExpandUnionTypeArgs,
    coDictionaryAsClass
    );
  TBaseConversionOptions = Set of TBaseConversionOption;

const
  BaseConversionOptionName: array[TBaseConversionOption] of string = (
    'AddOptionsToHeader',
    'ExpandUnionTypeArgs',
    'DictionaryAsClass'
    );

type

  { TBaseWebIDLToPas }

  TBaseWebIDLToPas = Class(TPascalCodeGenerator)
  private
    FArrayPrefix: String;
    FArraySuffix: String;
    FAutoTypes: TStrings;
    FBaseOptions: TBaseConversionOptions;
    FClassPrefix: String;
    FClassSuffix: String;
    FContext: TWebIDLContext;
    FDictionaryClassParent: String;
    FFieldPrefix: String;
    FTypePrefix: String;
    FGetterPrefix: String;
    FIncludeImplementationCode: TStrings;
    FIncludeInterfaceCode: TStrings;
    FInputFileName: String;
    FGlobalDefs: TFPHashList;
    FOutputFileName: String;
    FPasDataClass: TPasDataClass;
    FPasNameList: TFPObjectList; // list TPasData
    FSetterPrefix: String;
    FTypeAliases: TStrings; // user defined type maping name to name
    FVerbose: Boolean;
    FWebIDLVersion: TWebIDLVersion;
    procedure SetIncludeImplementationCode(AValue: TStrings);
    procedure SetIncludeInterfaceCode(AValue: TStrings);
    procedure SetTypeAliases(AValue: TStrings);
  Protected
    procedure AddOptionsToHeader;
    Procedure Parse; virtual;
    Procedure WritePascal; virtual;
    function CreateParser(aContext: TWebIDLContext; S: TWebIDLScanner): TWebIDLParser; virtual;
    function CreateScanner(S: TStream): TWebIDLScanner; virtual;
    Function CreateContext: TWebIDLContext; virtual;
    // Auxiliary routines
    procedure GetOptions(L: TStrings; Full: boolean); virtual;
    procedure ProcessDefinitions; virtual;
    function CreatePasName(aName: String; D: TIDLBaseObject): TPasData; virtual;
    procedure AllocatePasNames(aList: TIDLDefinitionList; ParentName: String=''); virtual;
    function AllocatePasName(D: TIDLDefinition; ParentName: String=''): TPasData; virtual;
    procedure AddJSIdentifier(D: TIDLDefinition); virtual;
    procedure ResolveTypeDefs(aList: TIDLDefinitionList); virtual;
    procedure ResolveTypeDef(D: TIDLDefinition); virtual;
    function FindGlobalDef(const aName: UTF8String): TIDLDefinition; virtual;
    function GetDefPos(Def: TIDLBaseObject; WithoutFile: boolean = false): string; virtual;
    function GetPasDataPos(D: TPasData; WithoutFile: boolean = false): string; virtual;
    procedure EnsureUniqueNames(ML: TIDLDefinitionList); virtual;
    function AddSequenceDef(ST: TIDLSequenceTypeDefDefinition): Boolean; virtual;
    function GetName(ADef: TIDLDefinition): String; virtual;
    function GetPasClassName(const aName: string): string; overload; virtual;
    function GetTypeName(Const aTypeName: String; ForTypeDef: Boolean=False): String; overload; virtual;
    function GetTypeName(aTypeDef: TIDLTypeDefDefinition; ForTypeDef: Boolean=False): String; overload; virtual;
    function GetResolvedTypeName(Const aTypeName: String): String; overload; virtual;
    function GetSequenceTypeName(Seq: TIDLSequenceTypeDefDefinition; ForTypeDef: Boolean=False): string; virtual;
    function GetInterfaceDefHead(Intf: TIDLInterfaceDefinition): String; virtual;
    function GetDictionaryDefHead(const CurClassName: string; Dict: TIDLDictionaryDefinition): String; virtual;
    function CheckUnionTypeDefinition(D: TIDLDefinition): TIDLUnionTypeDefDefinition; virtual;
    procedure AddArgumentToOverloads(aList: TFPObjectlist; AName, ATypeName: String; PosEl: TIDLBaseObject); overload; virtual;
    procedure AddArgumentToOverloads(aList: TFPObjectlist; aDef: TIDLArgumentDefinition); overload; virtual;
    procedure AddUnionOverloads(aList: TFPObjectlist; AName: String;  UT: TIDLUnionTypeDefDefinition); virtual;
    procedure AddOverloads(aList: TFPObjectlist; adef: TIDLFunctionDefinition; aIdx: Integer); virtual;
    function CloneNonPartialArgumentList(aList: TFPObjectlist; ADest: TFPObjectlist= Nil; AsPartial: Boolean=True): integer; virtual;
    function GetOverloads(aDef: TIDLFunctionDefinition): TFPObjectlist; virtual;
    function GetArguments(aList: TIDLDefinitionList; ForceBrackets: Boolean): String; virtual;
    function HaveConsts(aList: TIDLDefinitionList): Boolean; virtual;
    // Code generation routines. Return the number of actually written defs.
    function WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
    function WriteAttributeImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
    function WriteOtherImplicitTypes(Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer; virtual;
    function WriteDictionaryMemberImplicitTypes(aDict: TIDLDictionaryDefinition; aList: TIDLDefinitionList): Integer; virtual;
    function WriteCallBackDefs(aList: TIDLDefinitionList): Integer; virtual;
    function WriteDictionaryDefs(aList: TIDLDefinitionList): Integer; virtual;
    function WriteForwardClassDefs(aList: TIDLDefinitionList): Integer; virtual;
    function WriteInterfaceDefs(aList: TIDLDefinitionList): Integer; virtual;
    function WriteMethodDefs(aList: TIDLDefinitionList): Integer; virtual;
    function WriteUtilityMethods(Intf: TIDLInterfaceDefinition): Integer; virtual;
    function WriteTypeDefs(aList: TIDLDefinitionList): Integer; virtual;
    function WriteEnumDefs(aList: TIDLDefinitionList): Integer; virtual;
    function WriteConsts(aList: TIDLDefinitionList): Integer; virtual;
    function WriteProperties(aList: TIDLDefinitionList): Integer; virtual;
    function WritePlainFields(aList: TIDLDefinitionList): Integer; virtual;
    function WriteDictionaryFields(aList: TIDLDefinitionList): Integer; virtual;
    function WritePrivateReadOnlyFields(aList: TIDLDefinitionList): Integer; virtual;
    function WritePrivateGetters(aList: TIDLDefinitionList): Integer; virtual;
    function WritePrivateSetters(aList: TIDLDefinitionList): Integer; virtual;
    // Definitions. Return true if a definition was written.
    function WriteForwardClassDef(D: TIDLStructuredDefinition): Boolean; virtual;
    function WriteFunctionTypeDefinition(aDef: TIDLFunctionDefinition): Boolean; virtual;
    function WriteFunctionDefinition(aDef: TIDLFunctionDefinition): Boolean; virtual;
    function WriteTypeDef(aDef: TIDLTypeDefDefinition): Boolean; virtual;
    function WriteRecordDef(aDef: TIDLRecordDefinition): Boolean; virtual;
    function WriteEnumDef(aDef: TIDLEnumDefinition): Boolean; virtual;
    function WriteDictionaryField(aField: TIDLDictionaryMemberDefinition): Boolean; virtual;
    function WriteField(aAttr: TIDLAttributeDefinition): Boolean; virtual;
    function WriteConst(aConst: TIDLConstDefinition): Boolean ; virtual;
    function WriteInterfaceDef(Intf: TIDLInterfaceDefinition): Boolean; virtual;
    function WriteDictionaryDef(aDict: TIDLDictionaryDefinition): Boolean; virtual;
    // Additional
    procedure WriteAliasTypeDef(aDef: TIDLTypeDefDefinition); virtual;
    procedure WritePromiseDef(aDef: TIDLPromiseTypeDefDefinition); virtual;
    procedure WriteSequenceDef(aDef: TIDLSequenceTypeDefDefinition); virtual;
    procedure WriteUnionDef(aDef: TIDLUnionTypeDefDefinition); virtual;
    // Extra interface/Implementation code.
    procedure WriteImplementation; virtual;
    procedure WriteIncludeInterfaceCode; virtual;
    Property Context: TWebIDLContext Read FContext;
  Public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure Execute; virtual;
    procedure WriteOptions; virtual;
  Public
    Property InputFileName: String Read FInputFileName Write FInputFileName;
    Property OutputFileName: String Read FOutputFileName Write FOutputFileName;
    Property Verbose: Boolean Read FVerbose Write FVerbose;
    Property FieldPrefix: String Read FFieldPrefix Write FFieldPrefix;
    Property ClassPrefix: String Read FClassPrefix Write FClassPrefix;
    Property ClassSuffix: String Read FClassSuffix Write FClassSuffix;
    Property ArrayPrefix: String Read FArrayPrefix Write FArrayPrefix;
    Property ArraySuffix: String Read FArraySuffix Write FArraySuffix;
    Property GetterPrefix: String read FGetterPrefix write FGetterPrefix;
    Property SetterPrefix: String read FSetterPrefix write FSetterPrefix;
    Property TypePrefix: String read FTypePrefix write FTypePrefix;
    Property WebIDLVersion: TWebIDLVersion Read FWebIDLVersion Write FWebIDLVersion;
    Property TypeAliases: TStrings Read FTypeAliases Write SetTypeAliases;
    Property IncludeInterfaceCode: TStrings Read FIncludeInterfaceCode Write SetIncludeInterfaceCode;
    Property IncludeImplementationCode: TStrings Read FIncludeImplementationCode Write SetIncludeImplementationCode;
    Property DictionaryClassParent: String Read FDictionaryClassParent Write FDictionaryClassParent;
    Property BaseOptions: TBaseConversionOptions read FBaseOptions write FBaseOptions;
    Property PasDataClass: TPasDataClass read FPasDataClass write FPasDataClass;
  end;

function BaseConversionOptionsToStr(Opts: TBaseConversionOptions): string;

implementation

uses typinfo;

function BaseConversionOptionsToStr(Opts: TBaseConversionOptions): string;
var
  o: TBaseConversionOption;
begin
  Result:='';
  for o in Opts do
    begin
    if Result<>'' then Result:=Result+',';
    Result:=Result+BaseConversionOptionName[o];
    end;
  Result:='['+Result+']';
end;

{ TPasData }

constructor TPasData.Create(APasName: String; D: TIDLBaseObject);
begin
  FPasName:=APasName;
  IDL:=D;
  SrcFile:=D.SrcFile;
  Line:=D.Line;
  Column:=D.Column;
end;

{ TBaseWebIDLToPas }

function TBaseWebIDLToPas.CreateContext: TWebIDLContext;
begin
  Result:=TWebIDLContext.Create(True);
end;

function TBaseWebIDLToPas.CreateScanner(S: TStream):  TWebIDLScanner;

begin
  Result:=TWebIDLScanner.Create(S);
end;

function TBaseWebIDLToPas.CreateParser(aContext: TWebIDLContext;S: TWebIDLScanner):  TWebIDLParser;

begin
  Result:=TWebIDLParser.Create(aContext,S);
  Result.Version:=FWebIDLVersion;
end;

procedure TBaseWebIDLToPas.Parse;

Var
  ms: TMemoryStream;
  S: TWebIDLScanner;
  P: TWebIDLParser;

begin
  P:=Nil;
  ms:=TMemoryStream.Create;
  try
    ms.LoadFromFile(InputFileName);
    ms.Position:=0;
    S:=CreateScanner(ms);
    S.CurFile:=InputFileName;
    P:=CreateParser(Context,S);
    P.Parse;
  finally
    P.Free;
    S.Free;
    ms.Free;
  end;
end;

function TBaseWebIDLToPas.GetName(ADef: TIDLDefinition): String;

begin
  If Assigned(ADef) and (TObject(ADef.Data) is TPasData) then
    Result:=TPasData(ADef.Data).PasName
  else
    Result:=ADef.Name;
end;

function TBaseWebIDLToPas.GetPasClassName(const aName: string): string;
begin
  Result:=ClassPrefix+aName+ClassSuffix;
end;

function TBaseWebIDLToPas.HaveConsts(aList: TIDLDefinitionList): Boolean;

Var
  D: TIDLDefinition;

begin
  Result:=False;
  For D in aList do
    if D is TIDLConstDefinition then
      Exit(True);
end;

function TBaseWebIDLToPas.WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer;

Var
  D,D2,D3: TIDLDefinition;
  FD: TIDLFunctionDefinition absolute D;
  DA: TIDLArgumentDefinition absolute D2;
  UT: TIDLUnionTypeDefDefinition;

begin
  Result:=0;
  for D in aList do
    if D is TIDLFunctionDefinition then
      if Not (foCallBack in FD.Options) then
        begin
        if (FD.ReturnType is TIDLSequenceTypeDefDefinition) then
          if AddSequenceDef(FD.ReturnType as TIDLSequenceTypeDefDefinition) then
            Inc(Result);
        For D2 in FD.Arguments do
          if (DA.ArgumentType is TIDLSequenceTypeDefDefinition) then
            begin
            if AddSequenceDef(DA.ArgumentType as TIDLSequenceTypeDefDefinition) then
              Inc(Result);
            end
          else
            begin
            UT:=CheckUnionTypeDefinition(DA.ArgumentType);
            if Assigned(UT) then
              For D3 in UT.Union do
                if (D3 is TIDLSequenceTypeDefDefinition) then
                  if AddSequenceDef(D3 as TIDLSequenceTypeDefDefinition) then
                    Inc(Result);
            end;
        end;
  if Result>0 then
    AddLn('');
end;

function TBaseWebIDLToPas.WriteAttributeImplicitTypes(aList: TIDLDefinitionList
  ): Integer;
Var
  D: TIDLDefinition;
  FA: TIDLAttributeDefinition absolute D;

begin
  Result:=0;
  for D in aList do
    if D is TIDLAttributeDefinition then
      if (FA.AttributeType is TIDLSequenceTypeDefDefinition) then
        if AddSequenceDef(FA.AttributeType as TIDLSequenceTypeDefDefinition) then
          Inc(Result);
end;

function TBaseWebIDLToPas.WriteOtherImplicitTypes(
  Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer;
begin
  Result:=0;
  if Intf=nil then ;
  if aMemberList=nil then ;
end;

function TBaseWebIDLToPas.WriteDictionaryMemberImplicitTypes(
  aDict: TIDLDictionaryDefinition; aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  FD: TIDLDictionaryMemberDefinition absolute D;

begin
  Result:=0;
  if aDict=nil then ;
  for D in aList do
    if D is TIDLDictionaryMemberDefinition then
      if (FD.MemberType is TIDLSequenceTypeDefDefinition) then
        if AddSequenceDef(FD.MemberType as TIDLSequenceTypeDefDefinition) then
          Inc(Result);
end;

function TBaseWebIDLToPas.WritePrivateReadOnlyFields(aList: TIDLDefinitionList): Integer;
begin
  Result:=0;
  if aList=nil then ;
end;

function TBaseWebIDLToPas.WritePrivateGetters(aList: TIDLDefinitionList
  ): Integer;
begin
  Result:=0;
  if aList=nil then ;
end;

function TBaseWebIDLToPas.WritePrivateSetters(aList: TIDLDefinitionList
  ): Integer;
begin
  Result:=0;
  if aList=nil then ;
end;

function TBaseWebIDLToPas.WriteProperties(aList: TIDLDefinitionList): Integer;
begin
  Result:=0;
  if aList=nil then ;
end;

function TBaseWebIDLToPas.WriteConst(aConst: TIDLConstDefinition): Boolean;
var
  S: UTF8String;
begin
  Result:=true;
  S:=aConst.Value;
  if aConst.ConstType=ctInteger then
    S:=StringReplace(S,'0x','$',[]);
  Addln('%s = %s;',[GetName(aConst),S])
end;

function TBaseWebIDLToPas.WriteConsts(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;

begin
  EnsureSection(csConst);
  Indent;
  Result:=0;
  For D in aList do
    if D is TIDLConstDefinition then
      if WriteConst(D as TIDLConstDefinition) then
        Inc(Result);
  Undent;
end;

function TBaseWebIDLToPas.WritePlainFields(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  A: TIDLAttributeDefinition absolute D;

begin
  EnsureSection(csDeclaration);
  Result:=0;
  For D in aList do
    if D is TIDLAttributeDefinition then
      if Not (aoReadOnly in A.Options) then
        if WriteField(A) then
          Inc(Result);
end;

function TBaseWebIDLToPas.WriteDictionaryField(
  aField: TIDLDictionaryMemberDefinition): Boolean;

Var
  Def,N,TN: String;

begin
  Result:=True;
  N:=GetName(aField);
  TN:=GetTypeName(aField.MemberType);
  if TN='record' then
    TN:='TJSObject';
  if SameText(N,TN) then
    N:='_'+N;
  Def:=Format('%s: %s;',[N,TN]);
  if (N<>aField.Name) then
    Def:=Def+Format('external name ''%s'';',[aField.Name]);
  AddLn(Def);
end;

function TBaseWebIDLToPas.WriteDictionaryFields(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  M: TIDLDictionaryMemberDefinition absolute D;

begin
  Indent;
  Result:=0;
  For D in aList do
    if D is TIDLDictionaryMemberDefinition then
      if WriteDictionaryField(M) then
        Inc(Result);
  Undent;
end;

function TBaseWebIDLToPas.WriteMethodDefs(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  FD: TIDLFunctionDefinition absolute D;

begin
  Result:=0;
  for D in aList do
    if D is TIDLFunctionDefinition then
      if Not (foCallBack in FD.Options) then
         if WriteFunctionDefinition(FD) then
           Inc(Result);
end;

function TBaseWebIDLToPas.WriteUtilityMethods(Intf: TIDLInterfaceDefinition
  ): Integer;
begin
  Result:=0;
  if Intf=nil then ;
end;

function TBaseWebIDLToPas.AddSequenceDef(ST: TIDLSequenceTypeDefDefinition
  ): Boolean;

var
  TN: String;
begin
  TN:=GetTypeName(ST);
  Result:=FAutoTypes.IndexOf(TN)=-1;
  if Result then
    begin
    FAutoTypes.Add(TN);
    DoLog('Automatically adding %s sequence definition for %s.',[TN,GetDefPos(ST)]);
    AddLn('%s = Array of %s;',[TN,GetTypeName(ST.ElementType)]);
    ST.Data:=CreatePasName(TN,ST);
    end;
end;

procedure TBaseWebIDLToPas.EnsureUniqueNames(ML: TIDLDefinitionList);

Var
  L: TFPObjectHashTable;

  Procedure CheckRename(Def: TIDLDefinition);

  var
    I: integer;
    OrigName,BaseName,NewName: String;
    IsOverload: Boolean;
    CurDef , ConflictDef: TIDLDefinition;

  begin
    OrigName:=GetName(Def);
    BaseName:=LowerCase(OrigName);
    NewName:=BaseName;
    I:=0;
    IsOverload:=False;
    ConflictDef:=nil;
    Repeat
      CurDef:=TIDLDefinition(L.Items[NewName]);
      if (CurDef<>Nil) then
        // Overloads
        begin
        IsOverload:=((CurDef is TIDLFunctionDefinition) and (Def is TIDLFunctionDefinition));
        if IsOverload then
          CurDef:=Nil
        else
          begin
          ConflictDef:=CurDef;
          inc(I);
          if I>1 then
            raise EConvertError.Create('Duplicate identifier '+GetDefPos(Def)+' and '+GetDefPos(CurDef)+' (20220620073704)');
          NewName:=KeywordPrefix+BaseName+KeywordSuffix;
          OrigName:=KeywordPrefix+OrigName+KeywordSuffix;
          end;
        end;
    Until (CurDef=Nil);
    if (BaseName<>NewName) then
      begin
      BaseName:=GetName(Def);
      DoLog('Renaming duplicate identifier (%s) %s at %s to %s, other at %s',[Def.ClassName,BaseName,GetDefPos(Def),OrigName,GetDefPos(ConflictDef)]);
      // Original TPasName is in list, will be freed automatically
      Def.Data:=CreatePasName(OrigName,Def);
      end;
    if not IsOverload then
      L.Add(NewName,Def);
  end;

var
  D: TIDLDefinition;

begin
  L:=TFPObjectHashTable.Create(False);
  try
    For D in ML Do
      if not (D is TIDLConstDefinition) then
        CheckRename(D);
    For D in ML Do
      if (D is TIDLConstDefinition) then
        CheckRename(D);
  finally
    L.Free;
  end;
end;

function TBaseWebIDLToPas.WriteInterfaceDef(Intf: TIDLInterfaceDefinition): Boolean;

Var
  aClassName: String;
  Decl: String;
  ML: TIDLDefinitionList;

begin
  Result:=True;
  ML:=TIDLDefinitionList.Create(Nil,False);
  try
    Intf.GetFullMemberList(ML);
    EnsureUniqueNames(ML);
    aClassName:=GetName(Intf);
    // class comment
    ClassComment(aClassName);
    // sub types
    WriteFunctionImplicitTypes(ML);
    WriteAttributeImplicitTypes(ML);
    WriteOtherImplicitTypes(Intf,ML);
    // class and ancestor
    Decl:=aClassName+' = '+GetInterfaceDefHead(Intf);
    AddLn(Decl);
    // private section
    AddLn('Private');
    Indent;
    WritePrivateReadOnlyFields(ML);
    WritePrivateGetters(ML);
    WritePrivateSetters(ML);
    Undent;
    // write public section
    AddLn('Public');
    if HaveConsts(ML) then
      begin
      Indent;
      PushSection(csUnknown);
      WriteConsts(ML);
      PopSection;
      Undent;
      AddLn('Public');
      end;
    Indent;
    WritePlainFields(ML);
    WriteMethodDefs(ML);
    WriteUtilityMethods(Intf);
    WriteProperties(ML);
    Undent;
    AddLn('end;');
  finally
    ML.Free;
  end;
end;

function TBaseWebIDLToPas.WriteDictionaryDef(aDict: TIDLDictionaryDefinition
  ): Boolean;

Var
  CurClassName, Decl: String;
  DefList: TIDLDefinitionList;
  CurDefs: TIDLDictionaryDefinition;

begin
  Result:=True;
  DefList:=TIDLDefinitionList.Create(Nil,False);
  try
    CurDefs:=aDict;
    While CurDefs<>Nil do
      begin
      CurDefs.GetFullMemberList(DefList);
      CurDefs:=CurDefs.ParentDictionary;
      end;
    CurClassName:=GetName(aDict);
    ClassComment(CurClassName);
    WriteDictionaryMemberImplicitTypes(aDict, DefList);
    // class and ancestor
    Decl:=GetDictionaryDefHead(CurClassName,aDict);
    AddLn(Decl);
    WriteDictionaryFields(DefList);
    AddLn('end;');
  finally
    DefList.Free;
  end;
end;

constructor TBaseWebIDLToPas.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  WebIDLVersion:=v2;
  FieldPrefix:='F';
  ClassPrefix:='T';
  ClassSuffix:='';
  ArrayPrefix:='T';
  ArraySuffix:='DynArray';
  GetterPrefix:='Get';
  SetterPrefix:='Set';
  TypePrefix:='T';
  FTypeAliases:=TStringList.Create;
  FPasNameList:=TFPObjectList.Create(True);
  FPasDataClass:=TPasData;
  FAutoTypes:=TStringList.Create;
  FIncludeInterfaceCode:=TStringList.Create;
  FIncludeImplementationCode:=TStringList.Create;
  FGlobalDefs:=TFPHashList.Create;
end;


destructor TBaseWebIDLToPas.Destroy;
begin
  FreeAndNil(FGlobalDefs);
  FreeAndNil(FIncludeInterfaceCode);
  FreeAndNil(FIncludeImplementationCode);
  FreeAndNil(FAutoTypes);
  FreeAndNil(FTypeAliases);
  FreeAndNil(FPasNameList);
  inherited Destroy;
end;

procedure TBaseWebIDLToPas.WriteImplementation;

Var
  S: String;

begin
  Addln('');
  For S in FIncludeImplementationCode do
    Addln(S);
  Addln('');
end;

function TBaseWebIDLToPas.GetTypeName(aTypeDef: TIDLTypeDefDefinition; ForTypeDef: Boolean = False): String;

begin
  if ATypeDef is TIDLSequenceTypeDefDefinition then
    begin
    if Assigned(aTypeDef.Data) then
      Result:=GetName(aTypeDef)
    else
      Result:=GetSequenceTypeName(TIDLSequenceTypeDefDefinition(aTypeDef),ForTypeDef);
    end
  else
    Result:=GetTypeName(aTypeDef.TypeName,ForTypeDef);
end;

function TBaseWebIDLToPas.GetResolvedTypeName(const aTypeName: String): String;
var
  aDef: TIDLDefinition;
begin
  aDef:=FindGlobalDef(aTypeName);
  if aDef is TIDLTypeDefDefinition then
    Result:=GetResolvedTypeName(TIDLTypeDefDefinition(aDef).TypeName)
  else
    Result:=GetTypeName(aTypeName);
end;

function TBaseWebIDLToPas.GetSequenceTypeName(
  Seq: TIDLSequenceTypeDefDefinition; ForTypeDef: Boolean): string;
begin
  //writeln('TBaseWebIDLToPas.GetSequenceTypeName ',Seq.ElementType.Name,' ',Seq.ElementType.TypeName);
  Result:=GetTypeName(Seq.ElementType,ForTypeDef);
  if Result='' then
    raise EConvertError.Create('sequence without name at '+GetDefPos(Seq));
  if LeftStr(Result,length(ArrayPrefix))<>ArrayPrefix then
    Result:=ArrayPrefix+Result;
  Result:=Result+ArraySuffix;
end;

function TBaseWebIDLToPas.GetInterfaceDefHead(Intf: TIDLInterfaceDefinition
  ): String;
begin
  Result:='class';
  if Intf=nil then ;
end;

function TBaseWebIDLToPas.GetDictionaryDefHead(const CurClassName: string;
  Dict: TIDLDictionaryDefinition): String;
var
  CurParent: String;
begin
  if Dict=nil then ;
  if (coDictionaryAsClass in BaseOptions) then
    begin
    CurParent:=DictionaryClassParent;
    if CurParent='' then
      CurParent:='TJSObject';
    Result:='class('+CurParent+')'
    end
  else
    Result:='record';
  Result:=CurClassName+' = '+Result;
end;

function TBaseWebIDLToPas.GetTypeName(const aTypeName: String; ForTypeDef: Boolean
  ): String;
Var
  A: UTF8String;
  D: TIDLDefinition;
begin
  Case aTypeName of
    'boolean': Result:='Boolean';

    'byte': Result:='ShortInt';
    'octet': Result:='Byte';
    'short': Result:='SmallInt';
    'unsigned short': Result:='Word';
    'long': Result:='Integer';
    'unsigned long': Result:='LongWord';
    'long long': Result:='Int64';
    'unsigned long long': Result:='QWord';

    'float',
    'unrestricted float': Result:='Single';
    'double',
    'unrestricted double': Result:='Double';

    'union',
    'any': Result:='JSValue';

    'DOMString',
    'USVString',
    'ByteString': Result:='UnicodeString';

    'record',
    'object': Result:=GetPasClassName('Object');
    'Error',
    'DOMException': Result:=GetPasClassName('Error');

    'ArrayBuffer',
    'DataView',
    'Int8Array',
    'Int16Array',
    'Int32Array',
    'Uint8Array',
    'Uint16Array',
    'Uint32Array',
    'Uint8ClampedArray',
    'Float32Array',
    'Float64Array': Result:=GetPasClassName(aTypeName);

    'void': Result:=aTypeName;
  else
    if ForTypeDef then ;

    Result:=aTypeName;
    D:=FContext.FindDefinition(Result);
    if D<>Nil then
      Result:=GetName(D)
    else
      begin
      A:=FTypeAliases.Values[Result];
      If (A<>'') then
        Result:=A;
      end;
  end;
end;

function TBaseWebIDLToPas.WriteField(aAttr: TIDLAttributeDefinition): Boolean;
begin
  Result:=false;
  if aAttr=nil then ;
end;

function TBaseWebIDLToPas.WriteForwardClassDef(D: TIDLStructuredDefinition): Boolean;

begin
  Result:=not D.IsPartial;
  if Result then
    AddLn('%s = Class;',[GetName(D)]);
end;

function TBaseWebIDLToPas.WriteForwardClassDefs(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;

begin
  Result:=0;
  Comment('Forward class definitions');
  For D in aList do
    if D is TIDLInterfaceDefinition then
      if WriteForwardClassDef(D as TIDLInterfaceDefinition) then
        Inc(Result);
  if coDictionaryAsClass in BaseOptions then
    For D in aList do
      if D is TIDLDictionaryDefinition then
        if WriteForwardClassDef(D as TIDLDictionaryDefinition) then
          Inc(Result);
end;

procedure TBaseWebIDLToPas.WriteSequenceDef(aDef: TIDLSequenceTypeDefDefinition);

begin
  Addln('%s = array of %s;',[GetName(aDef),GetTypeName(aDef.ElementType)])
end;


procedure TBaseWebIDLToPas.WriteUnionDef(aDef: TIDLUnionTypeDefDefinition);

Var
  S: UTF8String;
  D: TIDLDefinition;
begin
  S:='';
  For D in adef.Union do
    begin
    if (S<>'') then
      S:=S+', ';
    S:=S+(D as TIDLTypeDefDefinition).TypeName;
    end;
  Comment('Union of '+S);
  AddLn('%s = JSValue; ',[GetName(aDef)])
end;


procedure TBaseWebIDLToPas.WritePromiseDef(aDef: TIDLPromiseTypeDefDefinition);

begin
  AddLn('%s = TJSPromise;',[GetName(aDef)]);
end;

procedure TBaseWebIDLToPas.WriteAliasTypeDef(aDef: TIDLTypeDefDefinition);

Var
  TN: String;

begin
  TN:=GetTypeName(aDef,True);
  AddLn('%s = %s;',[GetName(aDef),TN]);
end;

function TBaseWebIDLToPas.WriteTypeDef(aDef: TIDLTypeDefDefinition): Boolean;

begin
  Result:=True;
  if ADef is TIDLSequenceTypeDefDefinition then
    WriteSequenceDef(aDef as TIDLSequenceTypeDefDefinition)
  else if ADef is TIDLUnionTypeDefDefinition then
    WriteUnionDef(aDef as TIDLUnionTypeDefDefinition)
  else if ADef is TIDLPromiseTypeDefDefinition then
    WritePromiseDef(aDef as TIDLPromiseTypeDefDefinition)
  else if ADef is TIDLRecordDefinition then
    WriteRecordDef(aDef as TIDLRecordDefinition)
  else
    WriteAliasTypeDef(aDef);
end;

function TBaseWebIDLToPas.WriteRecordDef(aDef: TIDLRecordDefinition): Boolean;

Var
  KT,VT: String;

begin
  Result:=True;
  KT:=GetTypeName(aDef.KeyType);
  VT:=GetTypeName(aDef.ValueType);
  AddLn('%s = Class(TJSObject)',[GetName(aDef)]);
  AddLn('private');
  Indent;
  AddLn('function GetValue(aKey: %s): %s; external name ''[]'';',[KT,VT]);
  AddLn('procedure SetValue(aKey: %s; const AValue: %s); external name ''[]'';',[KT,VT]);
  Undent;
  AddLn('public');
  Indent;
  AddLn('property Values[Name: %s]: %s read GetProperties write SetProperties; default;',[KT,VT]);
  Undent;
  AddLn('end;');
end;

function TBaseWebIDLToPas.WriteTypeDefs(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  TD: TIDLTypeDefDefinition absolute D;

begin
  Result:=0;
  EnsureSection(csType);
  for D in aList do
    if D is TIDLTypeDefDefinition then
      if WriteTypeDef(TD) then
        Inc(Result);
end;

function TBaseWebIDLToPas.WriteEnumDef(aDef: TIDLEnumDefinition): Boolean;

begin
  Result:=True;
  AddLn('%s = String;',[GetName(aDef)]);
end;

function TBaseWebIDLToPas.WriteEnumDefs(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  ED: TIDLEnumDefinition absolute D;

begin
  Result:=0;
  EnsureSection(csType);
  for D in aList do
    if D is TIDLEnumDefinition then
      if WriteEnumDef(ED) then
        Inc(Result);
end;

function TBaseWebIDLToPas.GetArguments(aList: TIDLDefinitionList;
  ForceBrackets: Boolean): String;

Var
  I, Def: TIDLDefinition;
  A: TIDLArgumentDefinition absolute I;
  Arg, aTypeName: string;

begin
  Result:='';
  For I in aList do
    begin
    Arg:=GetName(A);
    aTypeName:=GetTypeName(A.ArgumentType);
    Arg:=Arg+': '+aTypeName;
    Def:=FindGlobalDef(A.ArgumentType.TypeName);
    //writeln('TBaseWebIDLToPas.GetArguments Arg="',Arg,'" A.ArgumentType.TypeName=',A.ArgumentType.TypeName,' ',Def<>nil);
    if (Def is TIDLFunctionDefinition)
        or (Def is TIDLDictionaryDefinition)
        or (A.ArgumentType.TypeName='sequence')
        or SameText(aTypeName,'UnicodeString') then
      Arg:='const '+Arg;
    if Result<>'' then
      Result:=Result+'; ';
    Result:=Result+Arg;
    end;
  if (Result<>'') or ForceBrackets then
    Result:='('+Result+')';
end;

Type
  // A partial argument list is a list which has been generated for a optional argument.
  // Additional arguments can never be added to a partial list...
  TIDLPartialDefinitionList = Class(TIDLDefinitionList);

function TBaseWebIDLToPas.CloneNonPartialArgumentList(aList: TFPObjectlist;
  ADest: TFPObjectlist; AsPartial: Boolean): integer;

Var
  I,J: Integer;
  CD: TIDLDefinition;
  DL,CL: TIDLDefinitionList;

begin
  Result:=0;
  if ADest=Nil then
    ADest:=aList;
  I:=aList.Count-1;
  While (I>=0) do
    begin
    DL:=TIDLDefinitionList(alist[i]);
    if Not (DL is TIDLPartialDefinitionList) then
      begin
      Inc(Result);
      if AsPartial then
        CL:=TIDLPartialDefinitionList.Create(Nil,True)
      else
        CL:=TIDLDefinitionList.Create(Nil,True);
      aDest.Add(CL);
      For J:=0 to DL.Count-1 do
        begin
        CD:=(DL.Definitions[J] as TIDLArgumentDefinition).Clone(Nil);
        CL.Add(CD);
        AllocatePasName(CD);
        end;
      end;
    Dec(I);
    end;
end;

procedure TBaseWebIDLToPas.AddArgumentToOverloads(aList: TFPObjectlist; AName,
  ATypeName: String; PosEl: TIDLBaseObject);

Var
  I: Integer;
  CD: TIDLArgumentDefinition;
  DL: TIDLDefinitionList;

begin
  For I:=0 to aList.Count-1 do
    begin
    DL:=TIDLDefinitionList(alist[i]);
    if Not (DL is TIDLPartialDefinitionList) then
      begin
      CD:=TIDLArgumentDefinition.Create(Nil,aName,PosEl.SrcFile,PosEl.Line,PosEl.Column);
      CD.ArgumentType:=TIDLTypeDefDefinition.Create(CD,'',PosEl.SrcFile,PosEl.Line,PosEl.Column);
      CD.ArgumentType.TypeName:=aTypeName;
      DL.Add(CD);
      AllocatePasName(cd,'');
      end;
    end;
end;

procedure TBaseWebIDLToPas.AddArgumentToOverloads(aList: TFPObjectlist; aDef: TIDLArgumentDefinition);

Var
  I: Integer;
  CD: TIDLDefinition;
  DL: TIDLDefinitionList;

begin
  For I:=0 to aList.Count-1 do
    begin
    DL:=TIDLDefinitionList(aList[i]);
    if Not (DL is TIDLPartialDefinitionList) then
      begin
      CD:=aDef.Clone(Nil);
      DL.Add(CD);
      if aDef.Data<>Nil then
        CD.Data:=CreatePasName(TPasData(aDef.Data).PasName,CD)
      else
        AllocatePasName(cd,'');
      end;
    end;
end;

procedure TBaseWebIDLToPas.AddUnionOverloads(aList: TFPObjectlist; AName: String; UT: TIDLUnionTypeDefDefinition);

Var
  L,L2: TFPObjectList;
  I,J: Integer;
  D: TIDLDefinitionList;
  Dups: TStringList;

begin
  L2:=Nil;
  Dups:=TStringList.Create;
  Dups.Sorted:=True;
  Dups.Duplicates:=dupIgnore;
  L:=TFPObjectList.Create(False);
  try
    L2:=TFPObjectList.Create(False);
    // Collect non partial argument lists
    for I:=0 to aList.Count-1 do
      begin
      D:=TIDLDefinitionList(aList[i]);
      if Not (D is TIDLPartialDefinitionList) then
        L.Add(D);
      end;
    // Collect unique pascal types. Note that this can reduce the list to 1 element...
    For I:=0 to UT.Union.Count-1 do
      Dups.Add(GetTypeName(UT.Union[I] as TIDLTypeDefDefinition));
    // First, clone list and add argument to cloned lists
    For I:=1 to Dups.Count-1 do
      begin
      // Clone list
      CloneNonPartialArgumentList(L,L2,False);
      // Add argument to cloned list
      AddArgumentToOverloads(L2,aName,Dups[i],UT.Union[I]);
      // Add overloads to original list
      For J:=0 to L2.Count-1 do
        aList.Add(L2[J]);
      L2.Clear;
      end;
    // Add first Union to original list
    AddArgumentToOverloads(L,aName,Dups[0],UT.Union[0]);
  finally
    Dups.Free;
    L2.Free;
    L.Free;
  end;
end;

function TBaseWebIDLToPas.CheckUnionTypeDefinition(D: TIDLDefinition
  ): TIDLUnionTypeDefDefinition;

begin
  Result:=Nil;
  If (D is TIDLUnionTypeDefDefinition) then
    Result:=D as TIDLUnionTypeDefDefinition
  else
    begin
    D:=Context.FindDefinition((D as TIDLTypeDefDefinition).TypeName);
    if (D is TIDLUnionTypeDefDefinition) then
      Result:=D as TIDLUnionTypeDefDefinition
    end
end;

procedure TBaseWebIDLToPas.AddOverloads(aList: TFPObjectlist;
  adef: TIDLFunctionDefinition; aIdx: Integer);

Var
  Arg: TIDLArgumentDefinition;
  D: TIDLDefinition;
  UT: TIDLUnionTypeDefDefinition;

begin
 if aIdx>=ADef.Arguments.Count then
    exit;
  Arg:=ADef.Argument[aIdx];
  if Arg.IsOptional then
    CloneNonPartialArgumentList(aList);
  // Add current to list.
  D:=Arg.ArgumentType;
  UT:=Nil;
  if coExpandUnionTypeArgs in BaseOptions then
    UT:=CheckUnionTypeDefinition(D);
  if UT=Nil then
    AddArgumentToOverloads(aList,Arg)
  else
    AddUnionOverLoads(aList,Arg.Name,UT);
  AddOverloads(aList,aDef,aIdx+1);
end;

function TBaseWebIDLToPas.GetOverloads(aDef: TIDLFunctionDefinition): TFPObjectlist;

begin
  Result:=TFPObjectList.Create;
  try
    Result.Add(TIDLDefinitionList.Create(Nil,True));
    AddOverloads(Result,adef,0);
  except
    Result.Free;
    Raise;
  end;
end;

function TBaseWebIDLToPas.WriteFunctionTypeDefinition(aDef: TIDLFunctionDefinition): Boolean;

Var
  FN,RT,Args: String;

begin
  Result:=True;
  FN:=GetName(aDef);
  RT:=GetTypeName(aDef.ReturnType,False);
  if (RT='void') then
    RT:='';
  Args:=GetArguments(aDef.Arguments,False);
  if (RT='') then
    AddLn('%s = procedure %s;',[FN,Args])
  else
    AddLn('%s = function %s: %s;',[FN,Args,RT])
end;

function TBaseWebIDLToPas.WriteFunctionDefinition(aDef: TIDLFunctionDefinition): Boolean;
begin
  Result:=true;
  if aDef=nil then exit;
end;

function TBaseWebIDLToPas.WriteCallBackDefs(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  FD: TIDLFunctionDefinition absolute D;

begin
  Result:=0;
  EnsureSection(csType);
  for D in aList do
    if D is TIDLFunctionDefinition then
      if (foCallBack in FD.Options) then
         if WriteFunctionTypeDefinition(FD) then
           Inc(Result);
end;

function TBaseWebIDLToPas.WriteDictionaryDefs(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  DD: TIDLDictionaryDefinition absolute D;

begin
  Result:=0;
  EnsureSection(csType);
  for D in aList do
    if D is TIDLDictionaryDefinition then
      if not TIDLDictionaryDefinition(D).IsPartial then
        if WriteDictionaryDef(DD) then
          Inc(Result);
end;

function TBaseWebIDLToPas.WriteInterfaceDefs(aList: TIDLDefinitionList): Integer;

Var
  D: TIDLDefinition;
  ID: TIDLInterfaceDefinition absolute D;

begin
  Result:=0;
  EnsureSection(csType);
  for D in aList do
    if D is TIDLInterfaceDefinition then
      if not TIDLInterfaceDefinition(D).IsPartial then
        if WriteInterfaceDef(ID) then
          Inc(Result);
end;

procedure TBaseWebIDLToPas.GetOptions(L: TStrings; Full: boolean);

  function CountLines(const s: string): integer;
  var
    p: Integer;
  begin
    Result:=1;
    p:=1;
    while p<=length(s) do
      case s[p] of
      #10:
        begin
          inc(p);
          inc(Result);
        end;
      #13:
        begin
          inc(p);
          inc(Result);
          if (p<=length(s)) and (s[p]=#10) then inc(p);
        end;
      else
        inc(p);
      end;
  end;

  function CodeInfo(Src: TStrings): string;
  var
    LineCount, i: Integer;
  begin
    Result:='';
    if Src.Count=0 then
      exit;
    LineCount:=0;
    for i:=0 to Src.Count-1 do
      inc(LineCount,CountLines(Src[i]));
    Result:=Result+IntToStr(Src.Count)+' chunks in '+IntToStr(LineCount)+' lines';
  end;

Var
  S: String;
  I: Integer;

begin
  L.Add('Used command-line options: ');
  For I:=1 to ParamCount do
    L.Add(ParamStr(i));
  L.Add('');
  L.Add('Command-line options translated to: ');
  L.Add('');
  if Full then
    begin
    L.Add('Verbose: '+BoolToStr(Verbose,true));
    L.Add('Converter: '+ClassName);
    L.Add('InputFileName: '+InputFileName);
    L.Add('OutputFileName: '+OutputFileName);
    end;
  L.Add('Keyword prefix: '+KeywordPrefix);
  L.Add('Keyword suffix: '+KeywordSuffix);
  L.Add('Class prefix: '+ClassPrefix);
  L.Add('Class suffix: '+ClassSuffix);
  L.Add('Field prefix: '+FieldPrefix);
  L.Add('Getter prefix: '+GetterPrefix);
  L.Add('Setter prefix: '+SetterPrefix);
  Str(WebIDLVersion,S);
  L.Add('WebIDL version: '+S);
  if TypeAliases.Count>0 then
    begin
    L.Add('Type aliases:');
    L.AddStrings(Self.TypeAliases);
    end;
  L.Add('Dictionary class parent: '+DictionaryClassParent);
  if Full then
    begin
    L.Add('Include interface code: '+CodeInfo(IncludeInterfaceCode));
    L.Add('Include implementation code: '+CodeInfo(IncludeImplementationCode));
    end;
  L.Add('Base Options: '+BaseConversionOptionsToStr(BaseOptions));
end;

procedure TBaseWebIDLToPas.AddOptionsToHeader;

Var
  L: TStrings;
begin
  L:=TStringList.Create;
  try
    L.Add('Automatically generated file by '+ClassName+' on '+FormatDateTime('yyyy-mm-dd hh:nn:ss',Now));
    L.Add('');
    GetOptions(L,false);
    Comment(L);
  finally
    L.Free;
  end;
end;

procedure TBaseWebIDLToPas.WriteIncludeInterfaceCode;

Var
  S: String;

begin
  For S in IncludeInterfaceCode do
    Addln(S);
end;

procedure TBaseWebIDLToPas.WritePascal;

begin
  CreateUnitClause;
  CreateHeader;
  if coAddOptionsToHeader in BaseOptions then
    AddOptionsToHeader;
  EnsureSection(csType);
  Indent;
  WriteForwardClassDefs(Context.Definitions);
  WriteEnumDefs(Context.Definitions);
  WriteTypeDefs(Context.Definitions);
  WriteCallbackDefs(Context.Definitions);
  WriteDictionaryDefs(Context.Definitions);
  WriteInterfaceDefs(Context.Definitions);
  Undent;
  WriteIncludeInterfaceCode;
  Addln('');
  AddLn('implementation');
  WriteImplementation;
  AddLn('end.');
  Source.SaveToFile(OutputFileName);
end;

function TBaseWebIDLToPas.CreatePasName(aName: String; D: TIDLBaseObject
  ): TPasData;
begin
  Result:=PasDataClass.Create(EscapeKeyWord(aName),D);
  FPasNameList.Add(Result);
end;

function TBaseWebIDLToPas.AllocatePasName(D: TIDLDefinition; ParentName: String): TPasData;

Var
  CN: String;
  aData: TPasData;

begin
  //writeln('TBaseWebIDLToPas.AllocatePasName ',ParentName,'.',D.Name,':',D.ClassName);
  CN:=D.Name;
  if D Is TIDLInterfaceDefinition then
    begin
    if not TIDLInterfaceDefinition(D).IsPartial then
      AddJSIdentifier(D);
    CN:=ClassPrefix+CN+ClassSuffix;
    Result:=CreatePasName(CN,D);
    D.Data:=Result;
    AllocatePasNames((D as TIDLInterfaceDefinition).Members,D.Name);
    end
  else if D Is TIDLDictionaryDefinition then
    begin
    if not TIDLDictionaryDefinition(D).IsPartial then
      AddJSIdentifier(D);
    if coDictionaryAsClass in BaseOptions then
      CN:=ClassPrefix+CN+ClassSuffix;
    Result:=CreatePasName(EscapeKeyWord(CN),D);
    D.Data:=Result;
    AllocatePasNames((D as TIDLDictionaryDefinition).Members,D.Name);
    end
  else
    begin
    if (D is TIDLTypeDefDefinition)
        or ((D Is TIDLFunctionDefinition) and (foCallBack in TIDLFunctionDefinition(D).Options)) then
      begin
      CN:=TypePrefix+CN;
      AddJSIdentifier(D);
      end;
    Result:=CreatePasName(CN,D);
    D.Data:=Result;
    if D Is TIDLFunctionDefinition then
      AllocatePasNames((D as TIDLFunctionDefinition).Arguments,D.Name);
    end;
  aData:=TPasData(D.Data);
  if Verbose and (aData.PasName<>D.Name) then
    begin
    if (ParentName<>'') then
      ParentName:=ParentName+'.';
    DoLog('Renamed %s to %s for %s',[ParentName+D.Name,aData.PasName,GetPasDataPos(aData)]);
    end;
end;

procedure TBaseWebIDLToPas.AddJSIdentifier(D: TIDLDefinition);
var
  Old: TIDLDefinition;
begin
  //writeln('TBaseWebIDLToPas.AddJSIdentifier ',D.Name,':',D.ClassName);
  if (D.Parent=nil)
      or ((D is TIDLInterfaceDefinition) and TIDLInterfaceDefinition(D).IsMixin) then
    begin
    Old:=FindGlobalDef(D.Name);
    if Old<>nil then
      raise EWebIDLParser.Create('Duplicate identifier '+D.Name+' at '+GetDefPos(D)+' and '+GetDefPos(Old));
    FGlobalDefs.Add(D.Name,D);
    end
  else
    writeln('TBaseWebIDLToPas.AddJSIdentifier SubIdentifier: '+D.Name+' at '+GetDefPos(D)+' Parent=',D.Parent.Name,':',D.Parent.ClassName,' at ',GetDefPos(D.Parent));
end;

procedure TBaseWebIDLToPas.ResolveTypeDefs(aList: TIDLDefinitionList);
var
  D: TIDLDefinition;
begin
  For D in aList do
    ResolveTypeDef(D);
end;

procedure TBaseWebIDLToPas.ResolveTypeDef(D: TIDLDefinition);

  procedure ResolveTypeName(const aTypeName: string);
  var
    Def: TIDLDefinition;
    Data: TPasData;
  begin
    Def:=FindGlobalDef(aTypeName);
    if Def=nil then
      begin
      if NameToWebIDLBaseType(aTypeName)=wibtNone then
        writeln('Type ',aTypeName,' not found at ',GetDefPos(D));
      end
    else
      begin
      Data:=TPasData(D.Data);
      if Data=nil then
        Data:=CreatePasName('',D);
      Data.Resolved:=Def;
      end;
  end;

var
  DMD: TIDLDictionaryMemberDefinition;
  IT: TIDLIterableDefinition;
  SerializerD: TIDLSerializerDefinition;
begin
  if D=nil then exit;
  //writeln('TBaseWebIDLToPas.ResolveTypeDef START ',D.Name,':',D.ClassName,' at ',GetDefPos(D));
  if D Is TIDLInterfaceDefinition then
    ResolveTypeDefs((D as TIDLInterfaceDefinition).Members)
  else if D Is TIDLDictionaryDefinition then
    ResolveTypeDefs((D as TIDLDictionaryDefinition).Members)
  else if D is TIDLIncludesDefinition then
  else if D Is TIDLFunctionDefinition then
    ResolveTypeDefs((D as TIDLFunctionDefinition).Arguments)
  else if D is TIDLAttributeDefinition then
    ResolveTypeDef(TIDLAttributeDefinition(D).AttributeType)
  else if D is TIDLArgumentDefinition then
    ResolveTypeDef(TIDLArgumentDefinition(D).ArgumentType)
  else if D is TIDLTypeDefDefinition then
    ResolveTypeName(TIDLTypeDefDefinition(D).TypeName)
  else if D is TIDLConstDefinition then
    ResolveTypeName(TIDLConstDefinition(D).TypeName)
  else if D is TIDLSerializerDefinition then
    begin
    SerializerD:=TIDLSerializerDefinition(D);
    ResolveTypeDef(SerializerD.SerializerFunction);
    end
  else if D is TIDLDictionaryMemberDefinition then
    begin
    DMD:=TIDLDictionaryMemberDefinition(D);
    ResolveTypeDef(DMD.MemberType);
    ResolveTypeDef(DMD.DefaultValue);
    end
  else if D is TIDLEnumDefinition then
  else if D is TIDLSetlikeDefinition then
    ResolveTypeDef(TIDLSetlikeDefinition(D).ElementType)
  else if D is TIDLImplementsOrIncludesDefinition then
  else if D is TIDLIterableDefinition then
    begin
    IT:=TIDLIterableDefinition(D);
    ResolveTypeDef(IT.ValueType);
    ResolveTypeDef(IT.KeyType);
    end
  else {if Verbose then}
    writeln('TBaseWebIDLToPas.ResolveTypeDef unknown ',D.Name,':',D.ClassName,' at ',GetDefPos(D));
end;

function TBaseWebIDLToPas.FindGlobalDef(const aName: UTF8String
  ): TIDLDefinition;
begin
  Result:=TIDLDefinition(FGlobalDefs.Find(aName));
end;

function TBaseWebIDLToPas.GetDefPos(Def: TIDLBaseObject; WithoutFile: boolean
  ): string;
begin
  Result:='('+IntToStr(Def.Line)+','+IntToStr(Def.Column)+')';
  if not WithoutFile then
    Result:=Def.SrcFile+Result;
end;

function TBaseWebIDLToPas.GetPasDataPos(D: TPasData; WithoutFile: boolean
  ): string;
begin
  Result:='('+IntToStr(D.Line)+','+IntToStr(D.Column)+')';
  if not WithoutFile then
    Result:=D.SrcFile+Result;
end;

procedure TBaseWebIDLToPas.SetTypeAliases(AValue: TStrings);
begin
  if FTypeAliases=AValue then Exit;
  FTypeAliases.Assign(AValue);
end;

procedure TBaseWebIDLToPas.SetIncludeInterfaceCode(AValue: TStrings);
begin
  if FIncludeInterfaceCode=AValue then Exit;
  FIncludeInterfaceCode.Assign(AValue);
end;

procedure TBaseWebIDLToPas.SetIncludeImplementationCode(AValue: TStrings);
begin
  if FIncludeImplementationCode=AValue then Exit;
  FIncludeImplementationCode.Assign(AValue);
end;

procedure TBaseWebIDLToPas.AllocatePasNames(aList: TIDLDefinitionList; ParentName: String = '');

var
  D: TIDLDefinition;

begin
  For D in aList do
    AllocatePasName(D,ParentName);
end;

procedure TBaseWebIDLToPas.ProcessDefinitions;

begin
  FContext.AppendPartials;
  FContext.AppendIncludes;
  AllocatePasNames(FContext.Definitions);
  ResolveTypeDefs(FContext.Definitions);
end;

procedure TBaseWebIDLToPas.Execute;

begin
  if Verbose then
    begin
    WriteOptions;
    DoLog('');
    end;

  FContext:=CreateContext;
  try
    FContext.Aliases:=Self.TypeAliases;
    Parse;
    if Verbose then
      DoLog('Parsed %d definitions.',[Context.Definitions.Count]);
    ProcessDefinitions;
    if Verbose then
      DoLog('Processed %d definitions.',[Context.Definitions.Count]);
    WritePascal;
  finally
    FreeAndNil(FContext);
  end;
end;

procedure TBaseWebIDLToPas.WriteOptions;
var
  i: Integer;
  L: TStringList;
begin
  L:=TStringList.Create;
  try
    GetOptions(L,true);
    for i:=0 to L.Count-1 do
      DoLog(L[i]);
  finally
    L.Free;
  end;
end;

end.