{
    This file is part of the Web Service Toolkit
    Copyright (c) 2007 by Inoussa OUEDRAOGO

    This file is provide under modified LGPL licence
    ( the files COPYING.modifiedLGPL and COPYING.LGPL).


    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.
}
{$INCLUDE wst_global.inc}
unit pascal_parser_intf;

interface

uses
  Classes, SysUtils, Contnrs,
  pparser, pastree;

const
  sEXTERNAL_NAME = '_E_N_';
  sATTRIBUTE = '_ATTRIBUTE_';
  sARRAY_ITEM_NAME = 'ARRAY_ITEM_NAME';
  sARRAY_ITEM_EXT_NAME = 'ARRAY_ITEM_EXT_NAME';
  sARRAY_STYLE = 'ARRAY_STYLE';
    sARRAY_STYLE_SCOPED = 'ARRAY_STYLE_SCOPED';
    sARRAY_STYLE_EMBEDDED = 'ARRAY_STYLE_EMBEDDED';
  sARRAY_IS_COLLECTION = 'ARRAY_COLLECTION';
  
  sXSD_NS = 'http://www.w3.org/2001/XMLSchema';
  
type

  TElementNameKind = ( elkDeclaredName, elkName );
  TElementNameKinds = set of TElementNameKind;

  TBindingStyle = ( bsDocument, bsRPC, bsUnknown );
  
const
  BindingStyleNames : array[TBindingStyle] of string = ( 'Document', 'RPC', 'Unknown' );
  
type
  TArrayStyle = ( asScoped, asEmbeded );

  ESymbolException = class(Exception)
  end;
  { TwstBinding }

  TwstBinding = class(TPasElement)
  private
    FAddress: string;
    FBindingStyle: TBindingStyle;
    FIntf: TPasClassType;
  public
    constructor Create(
      const AName : string;
            AIntf : TPasClassType;
            AParent: TPasElement
    );reintroduce;
    destructor Destroy();override;
    property Intf : TPasClassType read FIntf;
    property Address : string read FAddress write FAddress;
    property BindingStyle : TBindingStyle read FBindingStyle write FBindingStyle;
  end;
  
  { TPropertyHolder }

  TPropertyHolder = class
  private
    FObjects : TObjectList;
    FProps : TObjectList;
  private
    procedure FreeList(AObject : TObject);
  public
    constructor Create();
    destructor Destroy();override;
    procedure SetValue(AOwner : TObject; const AName, AValue : string);
    function GetValue(AOwner : TObject; const AName : string) : string;
    function HasValue(AOwner : TObject; const AName : string) : Boolean;
    function FindList(AOwner : TObject) : TStrings;
    function GetList(AOwner : TObject) : TStrings;
  end;
  
  { TwstPasTreeContainer }

  TwstPasTreeContainer = class(TPasTreeContainer)
  private
    FCurrentModule: TPasModule;
    FBindingList : TObjectList;
    FProperties : TPropertyHolder;
  private
    function GetBinding(AIndex : Integer): TwstBinding;
    function GetBindingCount: Integer;
  public
    constructor Create();
    destructor Destroy();override;
    function CreateElement(
            AClass              : TPTreeElement;
      const AName               : String;
            AParent             : TPasElement;
            AVisibility         : TPasMemberVisibility;
      const ASourceFilename     : String;
            ASourceLinenumber   : Integer
    ): TPasElement;overload;override;
    function CreateArray(
      const AName              : string;
            AItemType          : TPasType;
      const AItemName,
            AItemExternalName  : string;
      const AStyle             : TArrayStyle
    ) : TPasArrayType;
    function GetArrayItemName(AArray : TPasArrayType) : string;
    function GetArrayItemExternalName(AArray : TPasArrayType) : string;
    function GetArrayStyle(AArray : TPasArrayType) : TArrayStyle;
    procedure SetArrayStyle(AArray : TPasArrayType; const AStyle : TArrayStyle);
    procedure SetArrayItemExternalName(AArray : TPasArrayType; const AExternalName : string);
    function IsCollection(AArray : TPasArrayType) : Boolean;
    procedure SetCollectionFlag(AArray : TPasArrayType; const AFlag : Boolean);
    function FindElement(const AName: String): TPasElement; overload; override;
    function FindElement(const AName: String; const ANameKinds : TElementNameKinds): TPasElement; overload;
    function FindElementNS(const AName, ANameSpace : string): TPasElement;
    function FindElementInModule(
        const AName: String;
            AModule: TPasModule;
      const ANameKinds : TElementNameKinds = [elkDeclaredName, elkName]
    ): TPasElement;
    function FindModule(const AName: String): TPasModule;override;
    function IsEnumItemNameUsed(const AName : string; AModule : TPasModule) : Boolean;overload;
    function IsEnumItemNameUsed(const AName : string) : Boolean;overload;
    procedure SetCurrentModule(AModule : TPasModule);
    property CurrentModule : TPasModule read FCurrentModule;
    
    function AddBinding(const AName : string; AIntf : TPasClassType):TwstBinding;
    procedure DeleteBinding(ABinding : TwstBinding);
    function FindBinding(const AName : string):TwstBinding;overload;
    function FindBinding(const AIntf : TPasClassType; const AOrder : Integer = 0):TwstBinding;overload;
    property BindingCount : Integer read GetBindingCount;
    property Binding[AIndex : Integer] : TwstBinding read GetBinding;
    property Properties : TPropertyHolder read FProperties;
    
    procedure FreeProperties(AObject : TPasElement);
    procedure RegisterExternalAlias(AObject : TPasElement; const AExternalName : String);
    function SameName(AObject : TPasElement; const AName : string) : Boolean;
    function HasExternalName(AObject : TPasElement) : Boolean;
    function GetExternalName(AObject : TPasElement) : string;overload;
    function GetExternalName(AObject : TPasElement; const AReturnNameIfEmpty : Boolean) : string;overload;
    function GetNameSpace(AType : TPasType) : string ;
    function IsAttributeProperty(AObject : TPasVariable) : Boolean;
    procedure SetPropertyAsAttribute(AObject : TPasVariable; const AValue : Boolean);

    function IsInitNeed(AType: TPasType): Boolean;
    function IsOfType(AType: TPasType; AClass: TClass): Boolean;
  end;

  TPasNativeModule = class(TPasModule)
  end;
  
  TPasClassTypeClass = class of TPasClassType;
  TPasNativeSimpleContentClassType = class;

  { TPasNativeClassType }

  TPasNativeClassType = class(TPasClassType)
  private
    FExtendableType : TPasNativeSimpleContentClassType;
  public
    destructor Destroy();override;
    procedure SetExtendableType(AExtendableType : TPasNativeSimpleContentClassType);
    property ExtendableType : TPasNativeSimpleContentClassType read FExtendableType;
  end;

  TPasNativeSimpleContentClassType = class(TPasNativeClassType) end;
  TPasNativeSpecialSimpleContentClassType = class(TPasNativeSimpleContentClassType) end;

  { TPasNativeSimpleType }

  TPasNativeSimpleType = class(TPasType)
  private
    FExtendableType: TPasNativeSimpleContentClassType;
  public
    destructor Destroy();override;
    procedure SetExtendableType(AExtendableType : TPasNativeSimpleContentClassType);
    property ExtendableType : TPasNativeSimpleContentClassType read FExtendableType;
  end;
  
  TPasNativeSpecialSimpleType = class(TPasNativeSimpleType) end;

  function GetParameterIndex(
          AProcType  : TPasProcedureType;
    const AParamName : string;
    const AStartPos  : Integer = 0
  ) : Integer;
  function FindParameter(
          AProcType  : TPasProcedureType;
    const AParamName : string;
    const AStartPos  : Integer = 0
  ) : TPasArgument;
  function FindMember(AClass : TPasClassType; const AName : string) : TPasElement ; overload;
  function FindMember(AClass : TPasRecordType; const AName : string) : TPasElement ; overload;
  function GetElementCount(AList : TList; AElementClass : TPTreeElement):Integer ;
  
  function GetUltimeType(AType : TPasType) : TPasType;
  function MakeInternalSymbolNameFrom(const AName : string) : string ;


  function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
  
implementation
uses parserutils, wst_types;

const
    SIMPLE_TYPES_COUNT = 14;
      SIMPLE_TYPES : Array[0..Pred(SIMPLE_TYPES_COUNT)] Of array[0..2] of string = (
          ('integer', 'TComplexInt32SContentRemotable', 'int'),
          ('LongWord', 'TComplexInt32UContentRemotable', 'unsignedInt' ),
          ('SmallInt', 'TComplexInt16SContentRemotable', 'short'),
          ('ShortInt', 'TComplexInt8SContentRemotable', 'byte'),
          ('char', '', ''),
          ('boolean', 'TComplexBooleanContentRemotable', 'boolean'),
          ('Byte', 'TComplexInt8UContentRemotable', 'unsignedByte'),
          ('Word', 'TComplexInt16UContentRemotable', 'unsignedShort'),
          ('Longint', 'TComplexInt32SContentRemotable', 'int'),
          ('Int64', 'TComplexInt64SContentRemotable', 'long'),
          ('Qword', 'TComplexInt64UContentRemotable', 'unsignedLong'),
          ('Single', 'TComplexFloatSingleContentRemotable', 'single'),
          ('Double', 'TComplexFloatDoubleContentRemotable', 'double'),
          ('Extended', 'TComplexFloatExtendedContentRemotable', 'decimal')
        );
   BOXED_TYPES_COUNT = 2;
     BOXED_TYPES : Array[0..Pred(BOXED_TYPES_COUNT)] Of array[0..2] of string = (
        ('TBase64StringRemotable', 'TBase64StringExtRemotable', 'base64Binary'),
        ('TBase16StringRemotable', 'TBase16StringExtRemotable', 'hexBinary')
     );
   SPECIAL_SIMPLE_TYPES_COUNT = 4 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING};
     SPECIAL_SIMPLE_TYPES : Array[0..Pred(SPECIAL_SIMPLE_TYPES_COUNT)] Of array[0..2] of string = (
          ('string', 'TComplexStringContentRemotable', 'string'),
          ('WideString', 'TComplexWideStringContentRemotable', 'string'),
          ('AnsiChar', 'TComplexAnsiCharContentRemotable', 'string'),
          ('WideChar', 'TComplexWideCharContentRemotable', 'string')
{$IFDEF WST_UNICODESTRING}
         ,('UnicodeString', 'TComplexUnicodeStringContentRemotable', 'string')
{$ENDIF WST_UNICODESTRING}
     );

procedure AddSystemSymbol(
  ADest : TPasModule;
  AContainer : TwstPasTreeContainer
);

  procedure RegisterSpecialSimpleTypes();
  var
    i : Integer;
    splTyp : TPasNativeSpecialSimpleType;
    syb : TPasNativeSpecialSimpleContentClassType;
    s : string;
    typlst : array[0..Pred(SPECIAL_SIMPLE_TYPES_COUNT)] of TPasNativeSpecialSimpleType;
  begin
    for i := Low(SPECIAL_SIMPLE_TYPES) to High(SPECIAL_SIMPLE_TYPES) do begin
      splTyp := TPasNativeSpecialSimpleType(AContainer.CreateElement(TPasNativeSpecialSimpleType,SPECIAL_SIMPLE_TYPES[i][0],ADest.InterfaceSection,visPublic,'',0));
      ADest.InterfaceSection.Declarations.Add(splTyp);
      ADest.InterfaceSection.Types.Add(splTyp);
      typlst[i] := splTyp;
      s := SPECIAL_SIMPLE_TYPES[i][1];
      if not IsStrEmpty(s) then begin
        syb := AContainer.FindElementInModule(SPECIAL_SIMPLE_TYPES[i][1],ADest) as TPasNativeSpecialSimpleContentClassType;
        if not Assigned(syb) then begin
          syb := TPasNativeSpecialSimpleContentClassType(AContainer.CreateElement(TPasNativeSpecialSimpleContentClassType,s,ADest.InterfaceSection,visDefault,'',0));
          ADest.InterfaceSection.Declarations.Add(syb);
          ADest.InterfaceSection.Types.Add(splTyp);
        end;
        splTyp.SetExtendableType(syb);
      end;
    end;
    for i := Low(SPECIAL_SIMPLE_TYPES) to High(SPECIAL_SIMPLE_TYPES) do begin
      splTyp := typlst[i];
      if not IsStrEmpty(SPECIAL_SIMPLE_TYPES[i][2]) then begin
        AContainer.RegisterExternalAlias(splTyp,SPECIAL_SIMPLE_TYPES[i][2]);
        if ( splTyp.ExtendableType <> nil ) then begin
          AContainer.RegisterExternalAlias(splTyp.ExtendableType,SPECIAL_SIMPLE_TYPES[i][2]);
        end;
      end;
    end;
  end;

  procedure RegisterSimpleTypes();
  var
    i : Integer;
    splTyp : TPasNativeSimpleType;
    syb : TPasNativeSimpleContentClassType;
    s : string;
    typlst : array[0..Pred(SIMPLE_TYPES_COUNT)] of TPasNativeSimpleType;
  begin
    for i := Low(SIMPLE_TYPES) to High(SIMPLE_TYPES) do begin
      splTyp := TPasNativeSimpleType(AContainer.CreateElement(TPasNativeSimpleType,SIMPLE_TYPES[i][0],ADest.InterfaceSection,visPublic,'',0));
      ADest.InterfaceSection.Declarations.Add(splTyp);
      ADest.InterfaceSection.Types.Add(splTyp);
      typlst[i] := splTyp;
      s := SIMPLE_TYPES[i][1];
      if not IsStrEmpty(s) then begin
        syb := AContainer.FindElementInModule(SIMPLE_TYPES[i][1],ADest) as TPasNativeSimpleContentClassType;
        if not Assigned(syb) then begin
          syb := TPasNativeSimpleContentClassType(AContainer.CreateElement(TPasNativeSimpleContentClassType,s,ADest.InterfaceSection,visDefault,'',0));
          ADest.InterfaceSection.Declarations.Add(syb);
          ADest.InterfaceSection.Types.Add(splTyp);
        end;
        splTyp.SetExtendableType(syb);
      end;
    end;
    for i := Low(SIMPLE_TYPES) to High(SIMPLE_TYPES) do begin
      splTyp := typlst[i];
      if not IsStrEmpty(SIMPLE_TYPES[i][2]) then begin
        AContainer.RegisterExternalAlias(splTyp,SIMPLE_TYPES[i][2]);
        if ( splTyp.ExtendableType <> nil ) then begin
          AContainer.RegisterExternalAlias(splTyp.ExtendableType,SIMPLE_TYPES[i][2]);
        end;
      end;
    end;
  end;
  
  procedure RegisterBoxedTypes();
  var
    i : Integer;
    nativeType : TPasNativeSimpleContentClassType;
    syb : TPasNativeSimpleContentClassType;
    s : string;
    typlst : array[0..Pred(BOXED_TYPES_COUNT)] of TPasNativeSimpleContentClassType;
  begin
    for i := Low(BOXED_TYPES) to High(BOXED_TYPES) do begin
      nativeType := TPasNativeSimpleContentClassType(AContainer.CreateElement(TPasNativeSimpleContentClassType,BOXED_TYPES[i][0],ADest.InterfaceSection,visPublic,'',0));
      ADest.InterfaceSection.Declarations.Add(nativeType);
      ADest.InterfaceSection.Types.Add(nativeType);
      typlst[i] := nativeType;
      s := BOXED_TYPES[i][1];
      if not IsStrEmpty(s) then begin
        syb := AContainer.FindElementInModule(BOXED_TYPES[i][1],ADest) as TPasNativeSimpleContentClassType;
        if not Assigned(syb) then begin
          syb := TPasNativeSimpleContentClassType(AContainer.CreateElement(TPasNativeSimpleContentClassType,s,ADest.InterfaceSection,visDefault,'',0));
          ADest.InterfaceSection.Declarations.Add(syb);
          ADest.InterfaceSection.Types.Add(syb);
        end;
        nativeType.SetExtendableType(syb);
      end;
    end;
    for i := Low(BOXED_TYPES) to High(BOXED_TYPES) do begin
      nativeType := typlst[i];
      if not IsStrEmpty(BOXED_TYPES[i][2]) then begin
        AContainer.RegisterExternalAlias(nativeType,BOXED_TYPES[i][2]);
        if ( nativeType.ExtendableType <> nil ) then begin
          AContainer.RegisterExternalAlias(nativeType.ExtendableType,BOXED_TYPES[i][2]);
        end;
      end;
    end;
  end;

begin
  RegisterSimpleTypes();
  RegisterSpecialSimpleTypes();
  RegisterBoxedTypes();
end;

function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
  function AddClassDef(
          ATable      : TPasModule;
    const AClassName,
          AParentName : string;
    const AClassType  : TPasClassTypeClass = nil
  ):TPasClassType;
  var
    locClassType : TPasClassTypeClass;
  begin
    if Assigned(AClassType) then begin
      locClassType := AClassType;
    end else begin
      locClassType := TPasClassType;
    end;
    Result := TPasClassType(AContainer.CreateElement(locClassType,AClassName,ATable.InterfaceSection,visDefault,'',0));
    if not IsStrEmpty(AParentName) then begin
      Result.AncestorType := AContainer.FindElementInModule(AParentName,ATable) as TPasType;
      if Assigned(Result.AncestorType) then
        Result.AncestorType.AddRef();
    end;
    ATable.InterfaceSection.Classes.Add(Result);
    ATable.InterfaceSection.Declarations.Add(Result);
    ATable.InterfaceSection.Types.Add(Result);
  end;

  function AddAlias(const AName, ABaseType : string; ATable : TPasModule) : TPasTypeAliasType;
  begin
    Result := TPasTypeAliasType(AContainer.CreateElement(TPasAliasType,AName,ATable.InterfaceSection,visPublic,'',0));
    Result.DestType := AContainer.FindElementInModule(ABaseType,ATable) as TPasType;
    if Assigned(Result.DestType) then
      Result.DestType.AddRef();
    ATable.InterfaceSection.Declarations.Add(Result);
    ATable.InterfaceSection.Classes.Add(Result);
    ATable.InterfaceSection.Types.Add(Result);
  end;
  
var
  loc_TBaseComplexSimpleContentRemotable : TPasClassType;
begin
  Result := TPasNativeModule(AContainer.CreateElement(TPasNativeModule,'base_service_intf',AContainer.Package,visPublic,'',0));
  try
    AContainer.Package.Modules.Add(Result);
    AContainer.RegisterExternalAlias(Result,sXSD_NS);
    Result.InterfaceSection := TPasSection(AContainer.CreateElement(TPasSection,'',Result,visDefault,'',0));
    AddSystemSymbol(Result,AContainer);
    AddClassDef(Result,'TBaseRemotable','',TPasNativeClassType);
      AddClassDef(Result,'TAbstractSimpleRemotable','TBaseRemotable',TPasNativeClassType);
        AContainer.RegisterExternalAlias(AddClassDef(Result,'TDateRemotable','TAbstractSimpleRemotable'),'dateTime');
{$IFDEF WST_HAS_TDURATIONREMOTABLE}
        AContainer.RegisterExternalAlias(AddClassDef(Result,'TDurationRemotable','TAbstractSimpleRemotable'),'duration');
{$ENDIF WST_HAS_TDURATIONREMOTABLE}
        AContainer.RegisterExternalAlias(AddClassDef(Result,'TTimeRemotable','TAbstractSimpleRemotable'),'time');

      AddClassDef(Result,'TAbstractComplexRemotable','TBaseRemotable',TPasNativeClassType);
        loc_TBaseComplexSimpleContentRemotable := AddClassDef(Result,'TBaseComplexSimpleContentRemotable','TAbstractComplexRemotable',TPasNativeClassType);
          (AContainer.FindElementInModule('TComplexInt16SContentRemotable',Result) as TPasClassType).AncestorType := loc_TBaseComplexSimpleContentRemotable;
          (AContainer.FindElementInModule('TComplexFloatDoubleContentRemotable',Result) as TPasClassType).AncestorType := loc_TBaseComplexSimpleContentRemotable;
            loc_TBaseComplexSimpleContentRemotable.AddRef();
            loc_TBaseComplexSimpleContentRemotable.AddRef();

        AddClassDef(Result,'TBaseComplexRemotable','TAbstractComplexRemotable',TPasNativeClassType);
          AddClassDef(Result,'THeaderBlock','TBaseComplexRemotable',TPasNativeClassType);
            AddClassDef(Result,'TSimpleContentHeaderBlock','THeaderBlock',TPasNativeClassType);
        AddClassDef(Result,'TBaseArrayRemotable','TAbstractComplexRemotable',TPasNativeClassType);
          AddClassDef(Result,'TBaseObjectArrayRemotable','TBaseArrayRemotable',TPasNativeClassType);
          AddClassDef(Result,'TBaseSimpleTypeArrayRemotable','TBaseArrayRemotable',TPasNativeClassType);
            AddClassDef(Result,'TArrayOfStringRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfBooleanRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfInt8URemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfInt8SRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfInt16SRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfInt16URemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfInt32URemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfInt32SRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfInt64SRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfInt64URemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfFloatSingleRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfFloatDoubleRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfFloatExtendedRemotable','TBaseSimpleTypeArrayRemotable');
            AddClassDef(Result,'TArrayOfFloatCurrencyRemotable','TBaseSimpleTypeArrayRemotable');

    AddAlias('token','string',Result);
    AddAlias('anyURI','string',Result);
    AddAlias('ID','string',Result);
    AddAlias('float','Single',Result);
    AddAlias('nonNegativeInteger','LongWord',Result);
    AddAlias('positiveInteger','nonNegativeInteger',Result);
{$IFNDEF WST_HAS_TDURATIONREMOTABLE}
    AddAlias('duration','string',Result);
{$ENDIF WST_HAS_TDURATIONREMOTABLE}
{$IFNDEF WST_HAS_TTIMEREMOTABLE}
    AddAlias('time','string',Result);
{$ENDIF WST_HAS_TTIMEREMOTABLE}
  except
    FreeAndNil(Result);
    raise;
  end;
end;

function GetUltimeType(AType : TPasType) : TPasType;
begin
  Result := AType;
  if ( Result <> nil ) then begin
    while Result.InheritsFrom(TPasAliasType) and
          ( TPasAliasType(Result).DestType <> nil )
    do begin
      Result := TPasAliasType(Result).DestType;
    end;
  end;
end;

function GetElementCount(AList : TList; AElementClass : TPTreeElement):Integer ;
var
  i : Integer;
begin
  Result := 0;
  if Assigned(AList) then begin
    for i := 0 to Pred(AList.Count) do begin
      if TObject(AList[i]).InheritsFrom(AElementClass) then begin
        Inc(Result);
      end;
    end;
  end;
end;

function GetParameterIndex(
        AProcType  : TPasProcedureType;
  const AParamName : string;
  const AStartPos  : Integer
) : Integer;
var
  pl : TList;
  i : Integer;
begin
  pl := AProcType.Args;
  if ( AStartPos >= 0 ) then
    i := AStartPos
  else
    i := 0;
  for i := i to Pred(pl.Count) do begin
    if AnsiSameText(AParamName,TPasArgument(pl[i]).Name) then begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end;

function FindParameter(
        AProcType  : TPasProcedureType;
  const AParamName : string;
  const AStartPos  : Integer
) : TPasArgument;
var
  i : Integer;
begin
  i := GetParameterIndex(AProcType,AParamName,AStartPos);
  if ( i >= 0 ) then begin
    Result := TPasArgument(AProcType.Args[i]);
  end else begin
    Result := nil;
  end;
end;

function InternalFindMember(AMemberList : TList; const AName : string) : TPasElement ;
var
  i : Integer;
begin
  Result := nil;
  if ( AMemberList <> nil ) then begin
    for i := 0 to Pred(AMemberList.Count) do begin
      if AnsiSameText(AName,TPasElement(AMemberList[i]).Name) then begin
        Result := TPasElement(AMemberList[i]);
      end;
    end;
  end;
end;

function FindMember(AClass : TPasClassType; const AName : string) : TPasElement ;
begin
  Result := nil;
  if ( AClass <> nil ) then begin
    Result := InternalFindMember(AClass.Members,AName);
  end;
end;

function FindMember(AClass : TPasRecordType; const AName : string) : TPasElement ;
begin
  Result := nil;
  if ( AClass <> nil ) then begin
    Result := InternalFindMember(AClass.Members,AName);
  end;
end;

function MakeInternalSymbolNameFrom(const AName : string) : string ;
begin
  Result := ExtractIdentifier(AName);
  if IsStrEmpty(AName) then begin
    raise ESymbolException.CreateFmt('Unable to make an internal symbol Name from "%s".',[AName]);
  end;
  if IsReservedKeyWord(Result) then begin
    Result := '_' + Result;
  end;
end;


{ TwstPasTreeContainer }

function TwstPasTreeContainer.GetBinding(AIndex : Integer): TwstBinding;
begin
  Result := TwstBinding(FBindingList[AIndex]);
end;

function TwstPasTreeContainer.GetBindingCount: Integer;
begin
  Result := FBindingList.Count;
end;

constructor TwstPasTreeContainer.Create();
begin
  FPackage := TPasPackage.Create('sample',nil);
  FBindingList := TObjectList.Create(True);
  FProperties := TPropertyHolder.Create();
end;

destructor TwstPasTreeContainer.Destroy();
begin
  FreeAndNil(FProperties);
  FreeAndNil(FBindingList);
  FreeAndNil(FPackage);
  inherited Destroy();
end;

function TwstPasTreeContainer.CreateElement(
            AClass              : TPTreeElement;
      const AName               : String;
            AParent             : TPasElement;
            AVisibility         : TPasMemberVisibility;
      const ASourceFilename     : String;
            ASourceLinenumber   : Integer
) : TPasElement;
begin
  Result := AClass.Create(AName,AParent);
  RegisterExternalAlias(Result,AName);
  Result.Visibility := AVisibility;
  Result.SourceFilename := ASourceFilename;
  Result.SourceLinenumber := ASourceLinenumber;
  if Result.InheritsFrom(TPasModule) then begin
    FCurrentModule := Result as TPasModule;
    //Package.Modules.Add(Result);
  end;
end;

function TwstPasTreeContainer.CreateArray(
  const AName              : string;
        AItemType          : TPasType;
  const AItemName,
        AItemExternalName  : string;
  const AStyle             : TArrayStyle
) : TPasArrayType;
var
  s : string;
begin
  Result := TPasArrayType(CreateElement(TPasArrayType,AName,CurrentModule.InterfaceSection,visDefault,'',0));
  Result.ElType := AItemType;
  AItemType.AddRef();
  Properties.SetValue(Result,sARRAY_ITEM_NAME,AItemName);
  Properties.SetValue(Result,sARRAY_ITEM_EXT_NAME,AItemExternalName);
  if ( AStyle = asEmbeded ) then
    s := sARRAY_STYLE_EMBEDDED
  else
    s := sARRAY_STYLE_SCOPED;
  Properties.SetValue(Result,sARRAY_STYLE,s);
end;

function TwstPasTreeContainer.GetArrayItemName(AArray: TPasArrayType): string;
begin
  Result := Properties.GetValue(AArray,sARRAY_ITEM_NAME);
end;

function TwstPasTreeContainer.GetArrayItemExternalName(AArray: TPasArrayType): string;
begin
  Result := Properties.GetValue(AArray,sARRAY_ITEM_EXT_NAME);
end;

function TwstPasTreeContainer.GetArrayStyle(AArray: TPasArrayType): TArrayStyle;
begin
  if AnsiSameText(sARRAY_STYLE_EMBEDDED,Properties.GetValue(AArray,sARRAY_STYLE)) then
    Result := asEmbeded
  else
    Result := asScoped;
end;

procedure TwstPasTreeContainer.SetArrayStyle(
        AArray : TPasArrayType;
  const AStyle : TArrayStyle
);
begin
  if ( AStyle = asEmbeded ) then
    Properties.SetValue(AArray,sARRAY_STYLE,sARRAY_STYLE_EMBEDDED)
  else
    Properties.SetValue(AArray,sARRAY_STYLE,sARRAY_STYLE_SCOPED);
end;

procedure TwstPasTreeContainer.SetArrayItemExternalName(
        AArray : TPasArrayType;
  const AExternalName : string
);
begin
  Properties.SetValue(AArray,sARRAY_ITEM_EXT_NAME,AExternalName);
end;

function TwstPasTreeContainer.IsCollection(AArray : TPasArrayType) : Boolean;
begin
  Result := AnsiSameText('true',Properties.GetValue(AArray,sARRAY_IS_COLLECTION));
end;

procedure TwstPasTreeContainer.SetCollectionFlag(
        AArray : TPasArrayType;
  const AFlag : Boolean
);
begin
  if AFlag then
    Properties.SetValue(AArray,sARRAY_IS_COLLECTION,'true')
  else
    Properties.SetValue(AArray,sARRAY_IS_COLLECTION,'false');
end;

function TwstPasTreeContainer.FindElementInModule(
  const AName: String;
        AModule : TPasModule;
  const ANameKinds : TElementNameKinds
): TPasElement;
var
  decs : TList;
  i, c : Integer;
begin
  Result := nil;
  if Assigned(AModule) and Assigned(AModule.InterfaceSection.Declarations) then begin
    decs := AModule.InterfaceSection.Declarations;
    c := decs.Count;
    if ( elkDeclaredName in ANameKinds ) then begin
      for i := 0 to Pred(c) do begin
        if AnsiSameText(AName, GetExternalName(TPasElement(decs[i]))) then begin
          Result := TPasElement(decs[i]);
          Exit;
        end;
      end;
    end;
    if ( Result = nil ) and ( elkName in ANameKinds ) then begin
      for i := 0 to Pred(c) do begin
        if AnsiSameText(AName, TPasElement(decs[i]).Name) then begin
          Result := TPasElement(decs[i]);
          Exit;
        end;
      end;
    end;
  end;
end;

function TwstPasTreeContainer.FindElement(const AName: String): TPasElement;
begin
  Result := FindElement(AName,[elkDeclaredName,elkName]);
end;

function TwstPasTreeContainer.FindElement(
  const AName: String;
  const ANameKinds: TElementNameKinds
): TPasElement;
var
  i : Integer;
  mls : TList;
  mdl : TPasModule;
begin
  Result := FindElementInModule(AName,CurrentModule,ANameKinds);
  if ( Result = nil ) then begin
    mls := Package.Modules;
    for i := 0 to Pred(mls.Count) do begin
      mdl := TPasModule(mls[i]);
      if ( CurrentModule <> mdl ) then begin
        Result := FindElementInModule(AName,mdl,ANameKinds);
        if ( Result <> nil ) then begin
          Break;
        end;
      end;
    end;
  end;
end;

function TwstPasTreeContainer.FindModule(const AName: String): TPasModule;
var
  i , c : Integer;
  mdl : TList;
begin
  Result := nil;
  mdl := Package.Modules;
  c := mdl.Count;
  for i := 0 to Pred(c) do begin
    if SameName(TPasModule(mdl[i]),AName) then begin
      Result := TPasModule(mdl[i]);
    end;
  end;
end;

function TwstPasTreeContainer.IsEnumItemNameUsed(const AName: string;AModule: TPasModule): Boolean;
var
  i, c, j : Integer;
  elt : TPasElement;
  enumList : TList;
  typeList : TList;
begin
  Result := False;
  typeList := AModule.InterfaceSection.Declarations;
  c := typeList.Count;
  for i := 0 to Pred(c) do begin
    elt := TPasElement(typeList[i]);
    if elt.InheritsFrom(TPasEnumType) then begin
      enumList := TPasEnumType(elt).Values;
      for j := 0 to Pred(enumList.Count) do begin
        if AnsiSameText(AName,TPasEnumValue(enumList[j]).Name) then begin
          Result := True;
          Exit;
        end;
      end;
    end;
  end;
end;

function TwstPasTreeContainer.IsEnumItemNameUsed(const AName: string): Boolean;
begin
  Result := IsEnumItemNameUsed(AName,CurrentModule);
end;

function TwstPasTreeContainer.IsOfType(AType : TPasType; AClass : TClass) : Boolean;
var
  ut : TPasType;
begin
  Result := False;
  if Assigned(AType) then begin
    ut := AType;
    if ut.InheritsFrom(TPasUnresolvedTypeRef) then begin
      ut := FindElement(GetExternalName(ut)) as TPasType;
      if ( ut = nil ) then
        ut := AType;
    end;
    ut := GetUltimeType(ut);
    if ut.InheritsFrom(AClass) then begin
      Result := True;
    end;
  end;
end;

function TwstPasTreeContainer.IsInitNeed(AType : TPasType) : Boolean;
begin
  Result := IsOfType(AType,TPasClassType) or
            IsOfType(AType,TPasPointerType) or
            IsOfType(AType,TPasArrayType) or
            IsOfType(AType,TPasRecordType);
end;

procedure TwstPasTreeContainer.SetCurrentModule(AModule: TPasModule);
begin
  FCurrentModule := AModule;
end;

function TwstPasTreeContainer.AddBinding(const AName : string; AIntf : TPasClassType):TwstBinding;
begin
  Result := FindBinding(AName);
  if Assigned(Result) then begin
    raise Exception.CreateFmt('Duplicated binding : "%s"',[AName]);
  end;
  Result := TwstBinding.Create(AName, AIntf, AIntf.Parent);
  FBindingList.Add(Result);
end;

procedure TwstPasTreeContainer.DeleteBinding(ABinding: TwstBinding);
begin
  FBindingList.Extract(ABinding);
  ABinding.Release();
end;

function TwstPasTreeContainer.FindBinding(const AName: string): TwstBinding;
var
  i : Integer;
begin
  for i := 0 to Pred(BindingCount) do begin
    if AnsiSameText(AName,Binding[i].Name) then begin
      Result := Binding[i];
      Exit;
    end;
  end;
  Result := nil;
end;

function TwstPasTreeContainer.FindBinding(const AIntf: TPasClassType; const AOrder : Integer): TwstBinding;
var
  i, c, ordr : Integer;
begin
  ordr := AOrder;
  c := BindingCount;
  for i := 0 to Pred(c) do begin
    Result := Binding[i];
    if ( Result.Intf = AIntf ) then begin
      if ( ordr <= 0 ) then
        Exit
      else
        Dec(ordr);
    end;
  end;
  Result := nil;
end;

procedure TwstPasTreeContainer.FreeProperties(AObject: TPasElement);

  procedure FreeClassProps(AObj : TPasClassType);
  var
    ls : TList;
    k : PtrInt;
  begin
    ls := AObj.Members;
    for k := 0 to Pred(ls.Count) do begin
      FProperties.FreeList(TPasElement(ls[k]));
    end;
  end;
  
  procedure FreeRecordFields(AObj : TPasRecordType);
  var
    ls : TList;
    k : PtrInt;
  begin
    ls := AObj.Members;
    for k := 0 to Pred(ls.Count) do begin
      FProperties.FreeList(TPasElement(ls[k]));
    end;
  end;
  
begin
  if Assigned(AObject) then begin
    FProperties.FreeList(AObject);
    if AObject.InheritsFrom(TPasClassType) then
      FreeClassProps(AObject as TPasClassType)
    else if AObject.InheritsFrom(TPasRecordType) then
      FreeRecordFields(AObject as TPasRecordType);
  end;
end;

procedure TwstPasTreeContainer.RegisterExternalAlias(
        AObject : TPasElement;
  const AExternalName : String
);
begin
  Properties.SetValue(AObject,sEXTERNAL_NAME,AExternalName);
end;

function TwstPasTreeContainer.SameName(
        AObject : TPasElement;
  const AName   : string
): Boolean;
begin
  Result := AnsiSameText(AName,AObject.Name) or AnsiSameText(AName,GetExternalName(AObject)) ;
end;

function TwstPasTreeContainer.HasExternalName(AObject : TPasElement) : Boolean;
begin
  Result := Properties.HasValue(AObject,sEXTERNAL_NAME);
end;

function TwstPasTreeContainer.GetExternalName(AObject: TPasElement): string;
begin
  Result := GetExternalName(AObject,True);
end;

function TwstPasTreeContainer.GetExternalName(
        AObject : TPasElement;
  const AReturnNameIfEmpty : Boolean
) : string;
begin
  Result := Properties.GetValue(AObject,sEXTERNAL_NAME);
  if IsStrEmpty(Result) and AReturnNameIfEmpty then begin
    Result := AObject.Name;
  end;
end;

function TwstPasTreeContainer.IsAttributeProperty(AObject: TPasVariable): Boolean;
begin
  Result := AnsiSameText(Properties.GetValue(AObject,sATTRIBUTE),'True');
end;

procedure TwstPasTreeContainer.SetPropertyAsAttribute(AObject: TPasVariable; const AValue: Boolean);
var
  s : string;
begin
  if AValue then
    s := 'True'
  else
    s := 'False';
  Properties.SetValue(AObject,sATTRIBUTE,s);
end;

function TwstPasTreeContainer.FindElementNS(const AName, ANameSpace: string): TPasElement;
var
  mdl : TPasModule;
begin
  Result := nil;
  mdl := FindModule(ANameSpace);
  if Assigned(mdl) then begin
    Result := FindElementInModule(AName,mdl);
  end;
end;

function TwstPasTreeContainer.GetNameSpace(AType: TPasType): string;
begin
  if Assigned(AType) and
     Assigned(AType.Parent{Section}) and
     Assigned(AType.Parent.Parent{Module})
  then begin
    Result := GetExternalName(AType.Parent.Parent);
  end else begin
    Result := '';
  end;
end;

{ TwstBinding }

constructor TwstBinding.Create(
  const AName : string;
        AIntf : TPasClassType;
        AParent: TPasElement
);
begin
  Assert((not IsStrEmpty(AName)) and Assigned(AIntf) and ( AIntf.ObjKind = okInterface ));
  inherited Create(AName,AParent);
  FIntf := AIntf;
  FIntf.AddRef();
end;

destructor TwstBinding.Destroy();
begin
  if Assigned(FIntf) then begin
    FIntf.Release();
    FIntf := nil;
  end;
  inherited Destroy();
end;

{ TPropertyHolder }

function TPropertyHolder.FindList(AOwner: TObject): TStrings;
var
  i : Integer;
begin
  i := FObjects.IndexOf(AOwner);
  if ( i >= 0 ) then begin
    Result := FProps[i] as TStrings;
  end else begin
    Result := nil ;
  end;
end;

function TPropertyHolder.GetList(AOwner: TObject): TStrings;
begin
  Result := FindList(AOwner);
  if ( Result = nil ) then begin
    FObjects.Add(AOwner);
    Result := TStringList.Create();
    FProps.Add(Result);
  end;
end;

procedure TPropertyHolder.FreeList(AObject: TObject);
var
  i : PtrInt;
begin
  i := FObjects.IndexOf(AObject);
  if ( i >= 0 ) then begin
    FObjects.Delete(i);
    FProps.Delete(i);
  end;
end;

constructor TPropertyHolder.Create();
begin
  FObjects := TObjectList.Create(False);
  FProps := TObjectList.Create(True);
end;

destructor TPropertyHolder.Destroy();
begin
  FreeAndNil(FProps);
  FreeAndNil(FObjects);
  inherited Destroy();
end;

procedure TPropertyHolder.SetValue(AOwner: TObject; const AName, AValue: string);
begin
  GetList(AOwner).Values[AName] := AValue;
end;

function TPropertyHolder.GetValue(AOwner: TObject; const AName: string): string;
var
  ls : TStrings;
begin
  ls := FindList(AOwner);
  if ( ls = nil ) then begin
    Result := '';
  end else begin
    Result := ls.Values[AName];
  end;
end;

function TPropertyHolder.HasValue(AOwner : TObject; const AName : string) : Boolean;
var
  ls : TStrings;
begin
  ls := FindList(AOwner);
  if ( ls <> nil ) and ( ls.IndexOfName(AName) > -1 ) then
    Result := True
  else
    Result := False;
end;

{ TPasNativeSimpleTypeDefinition }

destructor TPasNativeSimpleType.Destroy();
begin
  if Assigned(FExtendableType) then begin
    FExtendableType.Release();
    FExtendableType := nil
  end;
  inherited Destroy();
end;

procedure TPasNativeSimpleType.SetExtendableType(
  AExtendableType : TPasNativeSimpleContentClassType
);
begin
  if ( FExtendableType <> AExtendableType ) then begin
    if ( FExtendableType <> nil ) then begin
      FExtendableType.Release();
    end;
    FExtendableType := AExtendableType;
    if ( FExtendableType <> nil ) then
      FExtendableType.AddRef();
  end;
end;

{ TPasNativeClassType }

destructor TPasNativeClassType.Destroy();
begin
  if Assigned(FExtendableType) then begin
    FExtendableType.Release();
    FExtendableType := nil
  end;
  inherited Destroy();
end;

procedure TPasNativeClassType.SetExtendableType(AExtendableType : TPasNativeSimpleContentClassType);
begin
  if ( FExtendableType <> AExtendableType ) then begin
    if ( FExtendableType <> nil ) then begin
      FExtendableType.Release();
    end;
    FExtendableType := AExtendableType;
    if ( FExtendableType <> nil ) then
      FExtendableType.AddRef();
  end;
end;

end.