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

{
    This file is part of the Free Component Library

    WEBIDL source parser
    Copyright (c) 2018 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 webidlparser;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Contnrs, webidlscanner, webidldefs;

Type
  EWebIDLParser = Class(Exception);

  { TWebIDLContext }
  TWebIDLVersion = webidlscanner.TWebIDLVersion;

  TWebIDLContext = Class (TIDLBaseObject)
  private
    FAliases: TStrings;
    FDefinitions: TIDLDefinitionList;
    FHash : TFPObjectHashTable;
  Protected
    function FindDictionary(aName: UTF8String): TIDLDictionaryDefinition; virtual;
    function FindInterface(aName: UTF8String): TIDLInterfaceDefinition; virtual;
    procedure AppendDictionaryPartials; virtual;
    procedure AppendInterfacePartials; virtual;
    procedure AppendInterfaceIncludes; virtual;
    procedure ResolveParentTypes; virtual;
  Public
    Constructor Create(OwnsDefinitions : Boolean = True);
    Destructor Destroy; override;
    Procedure AppendPartials; virtual;
    Procedure AppendIncludes; virtual;
    Procedure ResolveTypes; virtual;
    function IndexOfDefinition(const AName: String): Integer;
    Function FindDefinition(const AName : String) : TIDLDefinition;
    Function AsString(Full: Boolean): UTF8String; override;
    Function Add(aClass : TIDLDefinitionClass; const AName : UTF8String) : TIDLDefinition; override;
    Function Add(aParent : TIDLBaseObject; aClass : TIDLDefinitionClass; const AName : UTF8String) : TIDLDefinition; virtual;
    Property Definitions : TIDLDefinitionList Read FDefinitions;
    Property Aliases : TStrings Read FAliases Write FAliases;
  end;

  { TWebIDLParser }

  TWebIDLParser = Class
  private
    FContext: TWebIDLContext;
    FScanner: TWebIDLScanner;
    FOwnsScanner : Boolean;
    FVersion: TWebIDLVersion;
    procedure SetVersion(AValue: TWebIDLVersion);
  Protected
    function GetErrorPos: String; virtual;
    // Error mechanism
    Procedure Error(Msg : String);
    Procedure Error(Fmt : String; Args : Array of const);
    // Scanner access. Only use this, do not use scanner directly.
    function CurrentToken: TIDLToken; virtual;
    function GetToken: TIDLToken; virtual;
    function CurrentTokenString: UTF8String;
    // Get next token, see if it is valid. Raise exception if not.
    procedure MaybeFree(Result: TIDLDefinition; aParent: TIDLBaseObject);
    Procedure CheckCurrentToken(aToken: TIDLToken);
    Procedure CheckCurrentTokens(aTokens: TIDLTokens);
    function ExpectToken(aToken: TIDLToken): TIDLToken;
    function ExpectTokens(aTokens: TIDLTokens): TIDLToken;
    // Attributes
    function ParseAttributes: TAttributeList;
    procedure ParseAttributes(aList: TAttributeList; aTerminator: TIDLToken; ForSerializer: Boolean=False); virtual;
    // Definitions
    // Type is a type without name of the type
    function ParseAttribute(aParent: TIDLBaseObject): TIDLAttributeDefinition; virtual;
    function ParseArgument(aParent: TIDLBaseObject): TIDLArgumentDefinition; virtual;
    procedure ParseArguments(aParent: TIDLBaseObject);virtual;
    function ParseFunction(aParent: TIDLBaseObject): TIDLFunctionDefinition; virtual;
    function ParseType(aParent: TIDLBaseObject; FetchFirst: Boolean=True; AllowExtraTypes : Boolean = False): TIDLTypeDefDefinition; virtual;
    function ParseDictionaryMember(aParent: TIDLBaseObject): TIDLDictionaryMemberDefinition; virtual;
    function CompleteSimpleType(tk: TIDLToken; Var S: UTF8String; out IsNull: Boolean): TIDLToken; virtual;
    function ParseMapLikeMember(aParent: TIDLBaseObject): TIDLMaplikeDefinition; virtual;
    function ParseSetLikeMember(aParent: TIDLBaseObject): TIDLSetlikeDefinition; virtual;
    function ParseRecordTypeDef(aParent: TIDLBaseObject): TIDLRecordDefinition; virtual;
    function ParsePromiseTypeDef(aParent: TIDLBaseObject): TIDLPromiseTypeDefDefinition; virtual;
    function ParseSequenceTypeDef(aParent : TIDLBaseObject): TIDLSequenceTypeDefDefinition; virtual;
    function ParseUnionTypeDef(aParent : TIDLBaseObject): TIDLUnionTypeDefDefinition; virtual;
    function ParseConstValue(out aValue: UTF8String; aExtended: Boolean): TConstType; virtual;
    function ParseConst(aParent: TIDLBaseObject ): TIDLConstDefinition; virtual;
    function ParseCallBack(aParent : TIDLBaseObject): TIDLDefinition; virtual;
    function ParseStringifier(aParent : TIDLBaseObject): TIDLDefinition; virtual;
    function ParseOperation(aParent: TIDLBaseObject): TIDLFunctionDefinition; virtual;
    function ParseSerializer(aParent: TIDLBaseObject): TIDLSerializerDefinition; virtual;
    function ParseStatic(aParent: TIDLBaseObject): TIDLDefinition;virtual;
    function ParseIterable(aParent : TIDLBaseObject): TIDLIterableDefinition; virtual;
    function ParseInterface(aParent : TIDLBaseObject): TIDLInterfaceDefinition; virtual;
    function ParseDictionary(aParent : TIDLBaseObject; AllowInheritance : Boolean = True): TIDLDictionaryDefinition; virtual;
    function ParseEnum(aParent : TIDLBaseObject): TIDLEnumDefinition; virtual;
    function ParseTypeDef(aParent : TIDLBaseObject): TIDLTypeDefDefinition; virtual;
    function ParsePartial(aParent : TIDLBaseObject): TIDLStructuredDefinition; virtual;
    function ParseImplementsOrIncludes(aParent: TIDLBaseObject): TIDLImplementsOrIncludesDefinition; virtual;
    function ParseImplements(Const aName : UTF8String; aParent : TIDLBaseObject): TIDLImplementsDefinition; virtual;
    function ParseIncludes(Const aName : UTF8String; aParent : TIDLBaseObject): TIDLIncludesDefinition; virtual;
    function ParseDefinition(aParent : TIDLBaseObject): TIDLDefinition; virtual;
    procedure ParseDefinitions(aParent : TIDLBaseObject); virtual;
  Public
    Constructor Create(aContext : TWEBIDLContext; aScanner : TWebIDLScanner); overload;
    Constructor Create(aContext : TWEBIDLContext; aSource : UTF8String);overload;
    Destructor Destroy; override;
    Procedure Parse;
    Property Scanner : TWebIDLScanner Read FScanner;
    Property Context : TWebIDLContext Read FContext;
    Property Version : TWebIDLVersion Read FVersion Write SetVersion;
  end;

implementation

Resourcestring
  SErrInvalidToken = 'Invalid token: expected "%s", got: "%s"';
  SErrInvalidTokenList = 'Invalid token: expected one of "%s", got: "%s"';
  // SExpectedOther = 'Unexpected token in attribute list: "%s".';
  SErrUnExpectedToken = 'Unexpected token : "%s"';
  SErrTypeNotAllowed = 'Type "%s" not allowed in "%s" type.';
  SErrDictionaryNotFound = 'Dictionary %s not found';
  SErrInterfaceNotFound = 'Interface %s not found';
  SErrInterfaceNotFoundfor = 'Included Interface %s not found for %s';

{ TWebIDLParser }

constructor TWebIDLParser.Create(aContext: TWEBIDLContext; aScanner: TWebIDLScanner);
begin
  FScanner:=aScanner;
  FContext:=aContext;
end;

constructor TWebIDLParser.Create(aContext: TWEBIDLContext; aSource: UTF8String);
begin
  FOwnsScanner:=True;
  Create(aContext,TWebIDLScanner.Create(aSource));
end;

destructor TWebIDLParser.Destroy;
begin
  if FOwnsScanner then
    FreeAndNil(FScanner);
  inherited Destroy;
end;

function TWebIDLParser.CurrentToken: TIDLToken;

begin
  Result:=FScanner.CurToken;
end;

function TWebIDLParser.GetToken: TIDLToken;

begin
  Repeat
    Result:=FScanner.FetchToken;
  until Not (Result in [tkWhitespace,tkComment]);
end;

procedure TWebIDLParser.SetVersion(AValue: TWebIDLVersion);
begin
  if FVersion=AValue then Exit;
  FVersion:=AValue;
  if Assigned(Scanner) then
    FScanner.Version:=FVersion;
end;

function TWebIDLParser.GetErrorPos: String;

begin
  Result:='';
  If Assigned(FScanner) then
    Result:=Format('Error in IDL at line %d, pos %d: ',[FScanner.CurRow,FScanner.CurColumn]);
end;

procedure TWebIDLParser.Error(Msg: String);

begin
  Raise EWebIDLParser.Create(GetErrorPos+Msg);
end;

procedure TWebIDLParser.Error(Fmt: String; Args: array of const);
begin
  Raise EWebIDLParser.Create(GetErrorPos+Format(Fmt,Args));
end;

function TWebIDLParser.CurrentTokenString: UTF8String;

begin
  Result:=Fscanner.CurTokenString;
end;

procedure TWebIDLParser.CheckCurrentToken(aToken: TIDLToken);
begin
  if (aToken<>CurrentToken) then
    Error(SErrInvalidToken,[GetTokenName(aToken),CurrenttokenString]);
end;

procedure TWebIDLParser.CheckCurrentTokens(aTokens: TIDLTokens);
begin
  if Not (CurrentToken in aTokens) then
    Error(SErrInvalidTokenList,[GetTokenNames(aTokens),CurrentTokenString]);
end;

function TWebIDLParser.ExpectToken(aToken: TIDLToken): TIDLToken;

begin
  Result:=GetToken;
  CheckCurrentToken(aToken);
end;

function TWebIDLParser.ExpectTokens(aTokens: TIDLTokens): TIDLToken;

begin
  Result:=GetToken;
  CheckCurrentTokens(aTokens);
end;

// We're at the [,{,( token when we enter here
// On exit, we're on the terminator token.

procedure TWebIDLParser.ParseAttributes(aList: TAttributeList; aTerminator: TIDLToken; ForSerializer : Boolean = False);

  Function AddSub(aTerm : TIDLTOken) : String;

  Var
    L : TAttributeList;

  begin
    Result:=CurrentTokenString;
    L:=TAttributeList.Create;
    try
      ParseAttributes(L,aTerm,ForSerializer);
      Result:=Trim(Result+L.ToLine(',')+CurrentTokenString);
    finally
      L.Free;
    end;
  end;

  Procedure AddToCurrent(Var Current : UTF8String; Const aTerm : String);

  begin
    if (Current<>'') then
      Current:=Current+' ';
    Current:=Current+aterm;
  end;

  Procedure AddToList(Var aTerm : UTF8String);

  begin
    ATerm:=Trim(ATerm);
    if (ATerm<>'') then
      begin
      AList.Add(aTerm);
      aTerm:='';
      end;
  end;

Const
  OtherTokens = [tkNumberInteger,tkNumberFloat,tkIdentifier,tkString, {tkOther, tkMinus,}tkNegInfinity,
                 tkDot,tkEllipsis,tkColon,tkSemicolon,tkLess,tkEqual,tkLarger,tkQuestionmark,tkByteString,
                 tkDOMString,tkInfinity,tkNan,tkUSVString,tkAny,tkboolean,tkbyte,tkDouble,tkFalse,tkFloat,tkComma,
                 tkLong,tkNull,tkObject,tkOctet,tkOr,tkOptional,tkSequence,tkShort,tkTrue,tkUnsigned,tkVoid];

Var
  tk : TIDLToken;
  ValidTokens : TIDLTokens;
  S : UTF8String;
  WasSub : Boolean;

begin
  ValidTokens:=OtherTokens;
  if ForSerializer then
    ValidTokens:=ValidTokens + [tkInherit,tkGetter];
  tk:=GetToken;
  S:='';
  While Not (tk=aTerminator) do
    begin
    WasSub:=True;
    Case tk of
      tkEOF :
        CheckCurrentToken(aTerminator);
      tkSquaredBraceOpen:
        S:=S+AddSub(tkSquaredBraceClose);
      tkBracketOpen:
        S:=S+AddSub(tkBracketClose);
      tkCurlyBraceOpen :
        S:=S+AddSub(tkCurlyBraceClose);
      else
        WasSub:=False;
        // Check
        While (tk in ValidTokens) do
          begin
          AddToCurrent(S,CurrentTokenString);
          if tk=tkComma then
            AddToList(S);
          tk:=GetToken;
          end;
      end;
    if WasSub then
      tk:=GetToken;
    end;
  AddToList(S);
end;

function TWebIDLParser.ParseAttributes: TAttributeList;


begin
  Result:=TAttributeList.Create;
  try
    ParseAttributes(Result,tkSquaredBraceClose);
  except
    FreeandNil(Result);
    Raise;
  end;
end;

function TWebIDLParser.ParseArgument(aParent : TIDLBaseObject): TIDLArgumentDefinition;

(* On Entry, we're on the argument start
  on exit, on the token after the argument definition i.e. a comma or )  *)

begin
  Result:=TIDLArgumentDefinition(Context.Add(aParent,TIDLArgumentDefinition,''));
  try
    if (CurrentToken=tkSquaredBraceOpen) then
      begin
      Result.Attributes:=ParseAttributes;
      getToken;
      end;
    if CurrentToken=tkOptional then
      begin
      Result.isOptional:=True;
      GetToken;
      end;
    Result.ArgumentType:=ParseType(Result,False);
    if CurrentToken=tkEllipsis then
      begin
      Result.HasEllipsis:=True;
      GetToken;
      end;
    CheckCurrentToken(tkIdentifier);
    Result.Name:=CurrentTokenString;
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseFunction(aParent : TIDLBaseObject): TIDLFunctionDefinition;

(* On Entry, we're on the function identifier, on exit, on the final ) *)


begin
  Result:=TIDLFunctionDefinition(Context.Add(aParent,TIDLFunctionDefinition,CurrentTokenString));
  try
    ExpectToken(tkEqual);
    Result.ReturnType:=ParseType(Result,True,True);
    ParseArguments(Result.Arguments);
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseCallBack(aParent : TIDLBaseObject): TIDLDefinition;

var
  tk : TIDLToken;

begin
  tk:=GetToken;
  Case tk of
    tkInterface :
       begin
       Result:=ParseInterface(aParent);
       TIDLInterfaceDefinition(Result).IsCallBack:=True;
       end;
    tkIdentifier :
       begin
       Result:=ParseFunction(aParent);
       With TIDLFunctionDefinition(Result) do
         Options:=Options+[foCallBack];
       end;
  else
    Error(SErrInvalidTokenList,[GetTokenNames([tkInterface,tkIdentifier])]);
  end;
end;

procedure TWebIDLParser.ParseArguments(aParent: TIDLBaseObject);

Var
  A : TIDLArgumentDefinition;
  S : UTF8String;

begin
  CheckCurrentToken(tkBracketOpen);
  GetToken;
  While (CurrentToken<>tkBracketClose) do
    begin
    A:=ParseArgument(aParent);
    ExpectTokens([tkEqual,tkComma,tkBracketClose]);
    if (CurrentToken=tkEqual) then
      begin
      ParseConstValue(S,True);
      A.HasDefaultValue:=True;
      A.DefaultValue:=S;
      GetToken;
      end;
    if (CurrentToken=tkComma) then
      GetToken;
    end;
end;

function TWebIDLParser.ParseOperation(aParent: TIDLBaseObject): TIDLFunctionDefinition;
{ On entry, we're on the type definition or on one of getter,setter,deleter,legacycaller,
  on exit, we're on the final ) }

Const
  Specials = [tkGetter, tkSetter, tkDeleter, tkLegacyCaller, tkConstructor];

Var
  Opts : TFunctionOptions;
  FO : TFunctionOption;

begin
  Opts:=[];
  While CurrentToken in Specials do
    begin
    Case CurrentToken of
      tkGetter : FO:=foGetter;
      tkSetter : FO:=foSetter;
      tkDeleter : FO:=foDeleter;
      tkLegacyCaller : FO:=foLegacyCaller;
      tkConstructor : fo:=foConstructor;
    end;
    Include(Opts,FO);
    GetToken;
    end;
  Result:=TIDLFunctionDefinition(Context.Add(aParent,TIDLFunctionDefinition,''));
  try
    if (foConstructor in Opts) then
      Result.Name:='New'
    else
      begin
      Result.ReturnType:=ParseType(Result,False,True);
      CheckCurrentToken(tkIdentifier);
      Result.Name:=CurrentTokenString;
      GetToken;
      end;
    ParseArguments(Result.Arguments);
    Result.Options:=Result.Options+Opts;
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseStringifier(aParent: TIDLBaseObject): TIDLDefinition;

(* On entry we're on stringifier, on exit, we're on the end of the definition, before ; *)

Var
  tk : TIDLToken;

begin
  tk:=getToken;
  if tk in [tkReadOnly,tkAttribute] then
    begin
    Result:=ParseAttribute(aParent);
    With TIDLAttributeDefinition(result) do
      Options:=Options+[aoStringifier];
    end
  else
    begin
    Result:=ParseOperation(aParent);
    With TIDLFunctionDefinition(result) do
      Options:=Options+[foStringifier];
    end;
end;

function TWebIDLParser.ParseIterable(aParent: TIDLBaseObject): TIDLIterableDefinition;

Var
  T1,T2 : TIDLTypeDefDefinition;

begin
  ExpectToken(tkLess);
  T1:=Nil;
  T2:=nil;
  try
    Result:=TIDLIterableDefinition(Context.Add(aParent,TIDLIterableDefinition,''));
    T1:=ParseType(Result,True,True);
    if (CurrentToken=tkComma) then
      T2:=ParseType(Result,True,True);
    CheckCurrentToken(tkLarger);
    if T2=Nil then
      Result.ValueType:=T1
    else
      begin
      Result.ValueType:=T2;
      T2:=Nil;
      Result.KeyType:=T1;
      end;
    T1:=nil;
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.CompleteSimpleType(tk: TIDLToken; Var S: UTF8String; out
  IsNull: Boolean): TIDLToken;

begin
  Result:=tk;
  S:='';
  if (Result=tkUnsigned) then
    begin
    S:=CurrentTokenString+' ';
    Result:=GetToken;
    end
  else if (Result=tkUnrestricted) then
    begin
    S:=CurrentTokenString+' ';
    Result:=GetToken;
    end;
  // long
  S:=S+CurrentTokenString;
  if (Result<>tkLong) then
    Result:=GetToken
  else
    begin
    Result:=GetToken;
    // Long long
    if Result=tkLong then
      begin
      S:=S+' '+CurrentTokenString;
      Result:=GetToken;
      end;
    end;
  if Result=tkQuestionmark then
    begin
    IsNull:=True;
    Result:=GetToken;
    end;
end;

function TWebIDLParser.ParseMapLikeMember(aParent: TIDLBaseObject): TIDLMaplikeDefinition;
begin
  Result:=TIDLMaplikeDefinition(Context.Add(aParent,TIDLMaplikeDefinition,''));
  try
    Result.TypeName:='maplike';
    ExpectToken(tkLess);
    Result.KeyType:=ParseType(Result,True,true);
    CheckCurrentToken(tkComma);
    Result.ValueType:=ParseType(Result,True,true);
    CheckCurrentToken(tkLarger);
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseSetLikeMember(aParent: TIDLBaseObject): TIDLSetlikeDefinition;
(* On Entry we're on setlike. On exit, we're on the > token *)

begin
  Result:=TIDLSetlikeDefinition(Context.Add(aParent,TIDLSetlikeDefinition,''));
  try
    ExpectToken(tkLess);
    Result.ElementType:=ParseType(Result);
    Result.ElementType.Parent:=Result;
    CheckCurrentToken(tkLarger);
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseRecordTypeDef(aParent: TIDLBaseObject): TIDLRecordDefinition;

begin
  Result:=TIDLRecordDefinition(Context.Add(aParent,TIDLRecordDefinition,''));
  try
    Result.TypeName:='record';
    ExpectToken(tkLess);
    Result.KeyType:=ParseType(Result,True,true);
    CheckCurrentToken(tkComma);
    Result.ValueType:=ParseType(Result,True,true);
    CheckCurrentToken(tkLarger);
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseConstValue(out aValue: UTF8String;
  aExtended: Boolean): TConstType;

Const
  ValueTokens = [tkTrue,tkFalse,tkNumberFloat,tkNumberInteger,tkNull,tkInfinity,tkNegInfinity,tkNan];
  ExtendedTokens = [tkSquaredBraceOpen,tkString, tkCurlyBraceOpen];
  ExtendedValueTokens = ExtendedTokens + ValueTokens;
  AllowedTokens : Array[Boolean] of TIDLTokens = (ValueTokens,ExtendedValueTokens);

begin
  ExpectTokens(AllowedTokens[aExtended]);
  aValue:=CurrentTokenString;
  Case CurrentToken of
    tkTrue,tkFalse : Result:=ctBoolean;
    tkNumberFloat : Result:=ctFloat;
    tkNumberInteger : Result:=ctInteger;
    tkNull : Result:=ctNull;
    tkNan : Result:=ctNan;
    tkInfinity : Result:=ctInfinity;
    tkNegInfinity : Result:=ctNegInfinity;
    tkString :
      If aExtended then
        Result:=ctString
      else
        Error(SErrUnExpectedToken,[CurrentTokenString]);
    tkSquaredBraceOpen :
      If aExtended then
        begin
        ExpectToken(tkSquaredBraceClose);
        aValue:=AValue+CurrentTokenString;
        Result:=ctEmptyArray
        end
      else
        Error(SErrUnExpectedToken,[CurrentTokenString]);
    tkCurlyBraceOpen :
      If aExtended then
        begin
        ExpectToken(tkCurlyBraceClose);
        aValue:=AValue+CurrentTokenString;
        Result:=ctEmptyObject
        end
      else
        Error(SErrUnExpectedToken,[CurrentTokenString]);
  end;
end;

function TWebIDLParser.ParseConst(aParent : TIDLBaseObject): TIDLConstDefinition;

(*
  On Entry we're on const. On exit, we're before the ;
*)

Const
  PrefixTokens = [tkUnsigned,tkLong,tkUnrestricted];
  SingleTokens = [tkIdentifier,tkBoolean,tkByte,tkOctet,tkFloat,tkDouble,tkShort];
  TypeTokens = SingleTokens+PrefixTokens;

Var
  S : UTF8String;
  isNull : Boolean;
  tk : TIDLToken;

begin
  Result:=Nil;
  isNull:=False;
  S:='';
  tk:=ExpectTokens(TypeTokens);
  // Unsigned
  Tk:=CompleteSimpleType(tk,S,IsNull);
  CheckCurrentToken(tkIdentifier);
  Result:=TIDLConstDefinition(Context.Add(aParent,TIDLConstDefinition,CurrentTokenString));
  try
    Result.TypeName:=S;
    Result.AllowNull:=isNull;
    ExpectToken(tkEqual);
    Result.ConstType:=ParseConstValue(S,false);
    Result.Value:=S;
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

procedure TWebIDLParser.MaybeFree(Result: TIDLDefinition; aParent : TIDLBaseObject);

begin
  if (AParent=Nil)  then
    Result.Free
  else if (aParent is TIDLDefinitionList) and (Not TIDLDefinitionList(AParent).OwnsDefinitions) then
    Result.Free;
end;


function TWebIDLParser.ParseAttribute(aParent : TIDLBaseObject): TIDLAttributeDefinition;
(*
  On Entry we're on readonly, inherit or attribute.
  On Exit, we're on the last token of the attribute definition, the name
*)
Var
  Options : TAttributeOptions;

begin
  Options:=[];
  if CurrentToken=tkInherit then
    begin
    Include(Options,aoInherit);
    GetToken;
    end;
  if (CurrentToken=tkReadOnly) then
    begin
    Include(Options,aoReadOnly);
    GetToken;
    end;
  CheckCurrentToken(tkAttribute);
  Result:=TIDLAttributeDefinition(Context.Add(aParent,TIDLAttributeDefinition,''));
  try
    Result.AttributeType:=ParseType(Result,True,True);
    CheckCurrentToken(tkIdentifier);
    Result.Name:=CurrentTokenString;
    Result.Options:=Options;
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseStatic(aParent : TIDLBaseObject): TIDLDefinition;

(* On Entry we're on static. On exit, we're on the end of the definition, before the ; *)

Var
  A : TIDLAttributeDefinition;
  F : TIDLFunctionDefinition;
  tk : TIDLToken;

begin
  tk:=GetToken;
  if (Tk in [tkReadonly,tkAttribute]) then
    begin
    A:=ParseAttribute(aParent);
    A.Options:=A.Options+[aoStatic];
    Result:=A;
    end
  else
    begin
    F:=ParseOperation(aParent);
    F.Options:=F.Options+[foStatic];
    Result:=F;
    end;
end;

function TWebIDLParser.ParseSerializer(aParent : TIDLBaseObject): TIDLSerializerDefinition;

Var
  tk : TIDLToken;

begin
  Result:=Nil;
  tk:=GetToken;
  if tk=tkSemiColon then
    exit;
  Result:=TIDLSerializerDefinition(Context.Add(aParent,TIDLSerializerDefinition,''));
  try
    if tk<>tkEqual then
      begin
      Result.SerializerFunction:=ParseOperation(Result);
      Exit;
      end;
    ExpectTokens([tkSquaredBraceOpen,tkCurlyBraceOpen,tkIdentifier]);
    case CurrentToken of
      tkSquaredBraceOpen :
        begin
        ParseAttributes(Result.Identifiers,tkSquaredBraceClose,True);
        Result.Kind:=skArray;
        end;
      tkCurlyBraceOpen :
        begin
        ParseAttributes(Result.Identifiers,tkCurlyBraceClose,True);
        Result.Kind:=skObject;
        end;
      tkIdentifier :
        begin
        Result.Identifiers.Add(CurrentTokenString);
        Result.Kind:=skSingle;
        end;
      end;
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseInterface(aParent : TIDLBaseObject): TIDLInterfaceDefinition;
(*
  On Entry we're on interface. On exit, we're on the } character
*)

Var
  tk : TIDLToken;
  Attrs : TAttributeList;
  M : TIDLDefinition;
  isMixin,SemicolonSeen : Boolean;

begin
  Attrs:=nil;
  ExpectTokens([tkMixin,tkIdentifier]);
  isMixin:=CurrentToken=tkMixin;
  if CurrentToken=tkMixin then
    ExpectToken(tkIdentifier);
  Result:=TIDLInterfaceDefinition(Context.Add(aParent,TIDLInterfaceDefinition,CurrentTokenString));
  try
    Result.IsMixin:=IsMixin;
    tk:=GetToken;
    if tk=tkColon then
      begin
      ExpectToken(tkIdentifier);
      Result.ParentName:=CurrentTokenString;
      tk:=GetToken;
      end;
    CheckCurrentToken(tkCurlyBraceOpen);
    tk:=GetToken;
    While (tk<>tkCurlyBraceClose) do
      begin
      SemicolonSeen:=False;
      Attrs:=nil;
      M:=Nil;
      if tk=tkSquaredBraceOpen then
        begin
        Attrs:=ParseAttributes;
        tk:=GetToken;
        end;
      Case tk of
        tkConst : M:=ParseConst(Result.Members);
        tkSetLike : M:=ParseSetLikeMember(Result.Members);
        tkMapLike : M:=ParseMapLikeMember(Result.Members);
        tkReadOnly :
          begin
          Case GetToken of
            tkAttribute,tkInherit:
              begin
              M:=ParseAttribute(Result.Members);
              With TIDLAttributeDefinition(M) do
                Options:=Options+[aoReadOnly];
              end;
            tkMapLike:
              begin
              M:=ParseMapLikeMember (Result.Members);
              TIDLMapLikeDefinition(M).IsReadonly:=True;
              end;
            tkSetLike:
              begin
              M:=ParseSetLikeMember (Result.Members);
              TIDLSetLikeDefinition(M).IsReadonly:=True;
              end
          else
            CheckCurrentTokens([tkAttribute,tkInherit,tkMapLike,tkSetLike]);
          end;
          end;
        tkInherit,
        tkAttribute : M:=ParseAttribute(Result.Members);
        tkStatic : M:=ParseStatic(Result.Members);
        tkSerializer :
          begin
          M:=ParseSerializer(Result.Members);
          Result.HasSerializer:=True;
          SemicolonSeen:=M=Nil;
          end;
        tkStringifier : M:=ParseStringifier(Result.Members);
        tkIterable : ParseIterable(Result.Members);
      else
        {
        tkGetter, tkSetter, tkDeleter, tkLegacyCaller
        }
        M:=ParseOperation(Result.Members);
      end;
      IF Assigned(M) then
        begin
        M.Attributes:=Attrs;
        Attrs:=Nil; // So it does not get freed in except
        end;
      if not SemicolonSeen then
        GetToken;
      CheckCurrentToken(tkSemicolon);
      tk:=GetToken;
      end;
  except
    FreeAndNil(Attrs);
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParsePartial(aParent : TIDLBaseObject): TIDLStructuredDefinition;

(* On entry, we're on Partial. On exit, we're on the } character *)

begin
  Case GetToken of
    tkInterface : Result:=ParseInterface(aParent);
    tkDictionary : Result:=ParseDictionary(aParent);
  else
    Error(SErrInvalidTokenList,[GetTokenNames([tkInterface,tkDictionary]),CurrentTokenString]);
  end;
  Result.IsPartial:=True;
end;

function TWebIDLParser.ParseImplementsOrIncludes(aParent: TIDLBaseObject): TIDLImplementsOrIncludesDefinition;

Var
  aName : UTF8String;

begin
  aName:=CurrentTokenString;
  if version=v1 then
    begin
    ExpectToken(tkImplements);
    Result:=ParseImplements(aName,aParent)
    end
  else
    begin
    ExpectTokens([tkImplements,tkIncludes]);
    case CurrentToken of
     tkIncludes: Result:=ParseIncludes(aName,aParent);
     tkImplements: Result:=ParseImplements(aName,aParent);
    end;
    end;

end;

function TWebIDLParser.ParseEnum(aParent : TIDLBaseObject): TIDLEnumDefinition;
(* On entry, we're on enum. On exit, we're on the } character *)

Var
  tk : TIDLToken;

begin
  ExpectToken(tkIdentifier);
  Result:=TIDLEnumDefinition(Context.Add(aParent,TIDLEnumDefinition,CurrentTokenString));
  ExpectToken(tkCurlyBraceOpen);
  Repeat
    tk:=ExpectTokens([tkCurlyBraceClose,tkString]);
    if tk=tkString then
      begin
      Result.AddValue(CurrentTokenString);
      tk:=ExpectTokens([tkCurlyBraceClose,tkComma]);
      end;
  Until (tk=tkCurlyBraceClose);
end;

function TWebIDLParser.ParseDictionaryMember(aParent : TIDLBaseObject): TIDLDictionaryMemberDefinition;

{ On Entry, we're at the start of the member. This may be required, attributes or the type.
  On Exit, we're on the ; }

Var
  Attrs : TAttributeList;
  tk : TIDLToken;
  isReq : Boolean;
  S : UTF8String;

begin
  Attrs:=Nil;
  tk:=CurrentToken;
  isReq:=(tk=tkRequired);
  if IsReq then
    tk:=GetToken;
  if tk=tkSquaredBraceOpen then
    begin
    Attrs:=ParseAttributes;
    tk:=GetToken;
    isReq:=(tk=tkRequired);
    if IsReq then
      tk:=GetToken;
    end;
  Result:=TIDLDictionaryMemberDefinition(Context.Add(aParent,TIDLDictionaryMemberDefinition,''));
  try
    Result.Attributes:=Attrs;
    Result.IsRequired:=isReq;
    Result.MemberType:=ParseType(Result,False,True);
    CheckCurrentToken(tkIdentifier);
    Result.Name:=CurrentTokenString;
    tk:=GetToken;
    if tk=tkEqual then
      begin
      Result.DefaultValue:=TIDLConstDefinition(Context.Add(Result,TIDLConstDefinition,''));
      Result.DefaultValue.ConstType:=ParseConstValue(S,True);
      Result.DefaultValue.Value:=S;
      tk:=GetToken;
      end;
    CheckCurrentToken(tkSemicolon);
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseDictionary(aParent : TIDLBaseObject; AllowInheritance : Boolean = True): TIDLDictionaryDefinition;
(* On entry, we're on dictionary, on eexit, we're on { *)

Var
  Name,ParentName : UTF8String;
  tk : TIDLToken;

begin
  ExpectToken(tkIdentifier);
  Name:=CurrentTokenString;
  tk:=GetToken;
  if (tk=tkColon) then
    begin
    If Not AllowInheritance then
      Error(SErrUnExpectedToken,[CurrentTokenString]);
    ExpectToken(tkIdentifier);
    ParentName:=CurrentTokenString;
    tk:=GetToken;
    end;
  CheckCurrentToken(tkCurlyBraceOpen);
  Result:=TIDLDictionaryDefinition(Context.Add(aParent,TIDLDictionaryDefinition,Name));
  Result.ParentName:=ParentName;
  GetToken;
  While (CurrentToken<>tkCurlyBraceClose) do
     begin
     ParseDictionaryMember(Result.Members);
     CheckCurrentTokens([tkSemicolon,tkCurlyBraceClose]);
     if (CurrentToken=tkSemicolon) then
       GetToken;
     end;
end;

function TWebIDLParser.ParseSequenceTypeDef(aParent : TIDLBaseObject): TIDLSequenceTypeDefDefinition;
(* On Entry we're on sequence. On exit, we're on the > token *)

begin
  Result:=TIDLSequenceTypeDefDefinition(Context.Add(aParent,TIDLSequenceTypeDefDefinition,''));
  try
    Result.TypeName:='sequence';
    ExpectToken(tkLess);
    Result.ElementType:=ParseType(Result);
    Result.ElementType.Parent:=Result;
    CheckCurrentToken(tkLarger);
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseUnionTypeDef(aParent : TIDLBaseObject): TIDLUnionTypeDefDefinition;

(* On Entry we're on (. On exit, we're on the ) token *)

Var
  D : TIDLTypeDefDefinition;
  tk : TIDLToken;
  Attr : TAttributeList;

begin
  Attr:=Nil;
  Result:=TIDLUnionTypeDefDefinition(Context.Add(aParent,TIDLUnionTypeDefDefinition,''));
  try
    Result.TypeName:='union';
    Repeat
      Attr:=Nil;
      tk:=GetToken;
      if Tk=tkSquaredBraceOpen then
        begin
        Attr:=ParseAttributes;
        tk:=getToken;
        end;
      D:=ParseType(Result.Union,False);
      D.Attributes:=Attr;
      Attr:=Nil;
      if (D.TypeName='any') then
        Error(SErrTypeNotAllowed,['any','union']);
      CheckCurrentTokens([tkOr,tkBracketClose]);
      tk:=CurrentToken;
    until (tk=tkBracketClose);
  except
    FreeAndNil(Attr);
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParsePromiseTypeDef(aParent: TIDLBaseObject): TIDLPromiseTypeDefDefinition;
(* On Entry we're on promise. On exit, we're on the > token *)

begin
  Result:=TIDLPromiseTypeDefDefinition(Context.Add(aParent,TIDLPromiseTypeDefDefinition,''));
  try
    Result.TypeName:='Promise';
    ExpectToken(tkLess);
    Result.ReturnType:=ParseType(Result,True,true);
    CheckCurrentToken(tkLarger);
  except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseType(aParent : TIDLBaseObject; FetchFirst : Boolean = True; AllowExtraTypes : Boolean = False): TIDLTypeDefDefinition;

(* On Entry
   if FetchFirst = true we're on "typedef", "(", "or" or "<" tokens.
   if FetchFirst = true we're on the first actual token
   On exit, we're on the first token after the type

   *)

Const
  SimplePrefixTokens = [tkUnsigned,tkLong,tkUnrestricted];
  ComplexPrefixTokens = [tkSequence,tkPromise,tkBracketOpen,tkRecord,tkFrozenArray];
  PrefixTokens  = ComplexPrefixTokens+SimplePrefixTokens;
  PrimitiveTokens = [tkBoolean,tkByte,tkOctet,tkFloat,tkDouble,tkShort,tkAny,tkObject];
  IdentifierTokens = [tkIdentifier,tkByteString,tkUSVString,tkDOMString];
  SimpleTypeTokens = PrimitiveTokens+IdentifierTokens;
  TypeTokens = PrefixTokens+SimpleTypeTokens;
  ExtraTypeTokens = TypeTokens +[tkStringToken,tkVoid];

Var
  isNull : Boolean;
  typeName: UTF8String;
  Allowed : TIDLTokens;
  tk : TIDLToken;

begin
  if AllowExtraTypes then
    Allowed:=ExtraTypeTokens
  else
    Allowed:=TypeTokens;
  Result:=Nil;
  try
    isNull:=False;
    if FetchFirst then
      tk:=GetToken
    else
      tk:=CurrentToken;
    CheckCurrentTokens(Allowed);
    TypeName:=CurrentTokenString;
    if (tk in SimplePrefixTokens) then
      begin
      tk:=CompleteSimpleType(tk,TypeName,isNull);
      Result:=TIDLTypeDefDefinition(Context.Add(aParent,TIDLTypeDefDefinition,''));
      end
    else
      begin
      Case tk of
        tkRecord : Result:=ParseRecordTypeDef(aParent);
        tkFrozenArray,
        tkSequence : Result:=ParseSequenceTypeDef(aParent);
        tkPromise : Result:=ParsePromiseTypeDef(aParent);
        tkBracketOpen : Result:=ParseUnionTypeDef(aParent);
      else
        Result:=TIDLTypeDefDefinition(Context.Add(aParent,TIDLTypeDefDefinition,''));
      end;
      tk:=GetToken;
      end;
    if Result.TypeName='' then
      Result.TypeName:=TypeName;
    // Null ?
    if tk=tkQuestionmark then
      begin
      tk:=GetToken;
      isNull:=True;
      end;
    if Assigned(Result) then
      Result.AllowNull:=isNull;
  Except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseTypeDef(aParent : TIDLBaseObject): TIDLTypeDefDefinition;
(* On Entry we're on "typedef", "or" or "<" tokens. On exit, we're on the identifier *)


begin
  Result:=ParseType(aParent);
  try
    CheckCurrentToken(tkIdentifier);
    Result.Name:=CurrentTokenString;
  Except
    MaybeFree(Result,aParent);
    Raise;
  end;
end;

function TWebIDLParser.ParseImplements(const aName: UTF8String;
  aParent: TIDLBaseObject): TIDLImplementsDefinition;
(* On entry, we're on the identifier for V1, we're. On Exit, we're on the last identifier *)

Var
  N : UTF8String;

begin
  if Version=V1 then
    begin
    N:=aName
    end
  else
    N:=aName;
  Result:=TIDLImplementsDefinition(Context.Add(aParent,TIDLImplementsDefinition,N));
  try
    ExpectToken(tkIdentifier);
    Result.ImplementedInterface:=CurrentTokenString;
  except
    MaybeFree(Result,aParent);
  end;
end;

function TWebIDLParser.ParseIncludes(const aName: UTF8String;
  aParent: TIDLBaseObject): TIDLIncludesDefinition;

(* On entry, we're on the identifier. On Exit, we're on the last identifier *)

begin
  Result:=TIDLIncludesDefinition(Context.Add(aParent,TIDLIncludesDefinition,aName));
  try
    ExpectToken(tkIdentifier);
    Result.IncludedInterface:=CurrentTokenString;
  except
    MaybeFree(Result,aParent);
  end;
end;


function TWebIDLParser.ParseDefinition(aParent : TIDLBaseObject): TIDLDefinition;

Var
  tk : TIDLToken;
  Attrs : TAttributeList;

begin
  Result:=Nil;
  Attrs:=Nil;
  tk:=GetToken;
  if tk=tkSquaredBraceOpen then
    begin
    Attrs:=ParseAttributes;
    tk:=GetToken;
    end;
  Try
    Case tk of
      tkCallback : Result:=ParseCallBack(aParent);
      tkInterface : Result:=ParseInterface(aParent);
      tkDictionary : Result:=ParseDictionary(aParent);
      tkPartial : Result:=ParsePartial(aParent);
      tkEnum : Result:=ParseEnum(aParent);
      tkTypeDef : Result:=ParseTypeDef(aParent);
      tkIdentifier :
        Result:=ParseImplementsOrIncludes(aParent);
      tkEOF : exit;
    else
      Error(SErrUnExpectedToken,[CurrentTokenString]);
    end;
    if Assigned(Result) then
      begin
      Result.Attributes:=Attrs;
      Attrs:=nil;
      end;
  except
    FreeAndNil(Attrs);
    Raise;
  end;
  ExpectToken(tkSemicolon);
end;

procedure TWebIDLParser.ParseDefinitions(aParent : TIDLBaseObject);

begin
  Repeat
    ParseDefinition(aParent);
  Until (CurrentToken=tkEOF)
end;

procedure TWebIDLParser.Parse;
begin
  ParseDefinitions(Context.Definitions);
end;

{ TWebIDLContext }

constructor TWebIDLContext.Create(OwnsDefinitions : Boolean = True);
begin
  FDefinitions:=TIDLDefinitionList.Create(Nil,OwnsDefinitions);
end;

destructor TWebIDLContext.Destroy;
begin
  FreeAndNil(FDefinitions);
  FreeAndNil(FHash);
  inherited Destroy;
end;

function TWebIDLContext.FindDictionary(aName: UTF8String
  ): TIDLDictionaryDefinition;

Var
  I : Integer;

begin
  I:=0;
  Result:=Nil;
  While (Result=Nil) and (I<FDefinitions.Count) do
    begin
    if (FDefinitions[i] is TIDLDictionaryDefinition) then
      begin
      Result:=TIDLDictionaryDefinition(FDefinitions[i]);
      if (Result.Name<>aName) or (Result.IsPartial) then
        Result:=nil;
      end;
    Inc(I);
    end;
end;
function TWebIDLContext.FindInterface(aName: UTF8String
  ): TIDLInterfaceDefinition;

Var
  I : Integer;

begin
  I:=0;
  Result:=Nil;
  While (Result=Nil) and (I<FDefinitions.Count) do
    begin
    if (FDefinitions[i] is TIDLInterfaceDefinition) then
      begin
      Result:=TIDLInterfaceDefinition(FDefinitions[i]);
      if (Result.Name<>aName) or (Result.IsPartial) then
        Result:=nil;
      end;
    Inc(I);
    end;
end;

procedure TWebIDLContext.AppendDictionaryPartials;

Var
  D : TIDLDefinition;
  DD : TIDLDictionaryDefinition absolute D;
  OD : TIDLDictionaryDefinition;

begin
  For D in FDefinitions do
    if (D is TIDLDictionaryDefinition) and (DD.IsPartial) then
      begin
      OD:=FindDictionary(DD.Name);
      If (OD=Nil) then
        Raise EWebIDLParser.CreateFmt(SErrDictionaryNotFound,[DD.Name]);
      OD.Partials.Add(DD);
      end;
end;

procedure TWebIDLContext.AppendInterfacePartials;

Var
  D : TIDLDefinition;
  ID : TIDLInterfaceDefinition absolute D;
  OD : TIDLInterfaceDefinition;

begin
  For D in FDefinitions do
    if (D is TIDLInterfaceDefinition) and (ID.IsPartial) then
      begin
      OD:=FindInterface(ID.Name);
      If (OD<>Nil) then
        OD.Partials.Add(ID);
      end;
end;

procedure TWebIDLContext.AppendInterfaceIncludes;
Var
  D : TIDLDefinition;
  ID : TIDLIncludesDefinition absolute D;
  II,OI : TIDLInterfaceDefinition; // Includes and original

begin
  For D in FDefinitions do
    if (D is TIDLIncludesDefinition)  then
      begin
      OI:=FindInterface(ID.Name);
      If (OI=Nil) then
        Raise EWebIDLParser.CreateFmt(SErrInterfaceNotFound,[ID.Name]);
      II:=FindInterface(ID.IncludedInterface);
      If (II=Nil) then
        begin
        if Assigned(Aliases) and (Aliases.IndexOfName(ID.IncludedInterface)<>-1) then
          OI.ParentName:=Aliases.Values[ID.IncludedInterface]
        else
          Raise EWebIDLParser.CreateFmt(SErrInterfaceNotFoundFor,[ID.IncludedInterface,ID.Name]);
       end
      else
        begin
        II.IsInclude:=True;
        OI.Partials.Add(II);
        end
      end;
  // if there is a single include, no members and no parent, make it a descendent
  For D in FDefinitions do
    if (D is TIDLInterfaceDefinition)  then
      begin
      OI:=D as TIDLInterfaceDefinition;
      if (OI.ParentName='') and (OI.Partials.Count=1) then
        if (OI.Partial[0] is TIDLInterfaceDefinition) then
          begin
          II:=OI.Partial[0] as TIDLInterfaceDefinition;
          if II.IsInclude then
            begin
            // DoLog('Converting single include %s to parent class for %s',[II.Name,OI.Name]);
            OI.ParentName:=II.Name;
            OI.ParentInterface:=II;
            OI.Partials.Clear;
            end;
          end;
      end;
end;

procedure TWebIDLContext.AppendPartials;

begin
  AppendDictionaryPartials;
  AppendInterfacePartials;
end;

procedure TWebIDLContext.AppendIncludes;
begin
  AppendInterfaceIncludes;
end;

procedure TWebIDLContext.ResolveParentTypes;

Var
  D : TIDLDefinition;
  ID : TIDLInterfaceDefinition absolute D;
  DD : TIDLDictionaryDefinition absolute D;

begin
  For D in FDefinitions do
    if D is TIDLInterfaceDefinition then
      begin
      if (ID.ParentName<>'') then
        ID.ParentInterface:=FindInterface(ID.ParentName);
      end
    else if D is TIDLDictionaryDefinition then
      if (DD.ParentName<>'') then
        DD.ParentDictionary:=FindDictionary(DD.ParentName);
end;

procedure TWebIDLContext.ResolveTypes;
begin
  ResolveParentTypes;
end;

function TWebIDLContext.IndexOfDefinition(const AName: String): Integer;
begin
  Result:=Definitions.Count-1;
  While (Result>=0) and (Definitions[Result].Name<>AName) do
    Dec(Result);
end;


function TWebIDLContext.FindDefinition(const AName: String): TIDLDefinition;

Var
  D : TIDLDefinition;

begin
  if (FHash=Nil) then
    begin
    FHash:=TFPObjectHashTable.Create(False);
    For D in Definitions do
      if not D.IsExtension then
        FHash.Add(D.Name,D);
    end;
  Result:=TIDLDefinition(FHash.Items[AName]);
end;

function TWebIDLContext.AsString(Full: Boolean): UTF8String;
begin
  Result:=Definitions.AsString(';'+sLineBreak,'','','',True,True);
end;

function TWebIDLContext.Add(aClass: TIDLDefinitionClass; const AName: UTF8String): TIDLDefinition;
begin
  Result:=Add(FDefinitions,aClass,AName);
end;


function TWebIDLContext.Add(aParent: TIDLBaseObject; aClass: TIDLDefinitionClass; const AName: UTF8String): TIDLDefinition;
begin
  if Assigned(aParent) then
    Result:=aParent.Add(aClass,aName)
  else
    Result:=aClass.Create(Nil,aName)
end;

end.