dws2unitutils.pas

script language

            else
              AddUpdateSymbolToCollection(Methods, TClassSymbol(Symbol).Members[i]);
          end;
          { Synch Properties }
          if TClassSymbol(Symbol).Members[i] is TPropertySymbol then
            AddUpdateSymbolToCollection(Properties, TClassSymbol(Symbol).Members[i]);
        end;
      end; {with Class}
    end; {if Collection is Classes}
  end;

  { Symbol is Enumeration }
  if Symbol is TEnumerationSymbol then begin
    { Synch Enumeration Elements (Recursive) }
    for i := 0 to TEnumerationSymbol(Symbol).Elements.Count - 1 do
      AddUpdateSymbolToCollection(Tdws2Enumeration(UseSym).Elements, TEnumerationSymbol(Symbol).Elements[i]);
  end;

  { Symbol is Element (of Enumeration) - type of Constant, process first }
  if Symbol is TElementSymbol then begin
  // Symbol is Tdws2Element then begin
    with Tdws2Element(UseSym) do begin
      IsUserDef := TElementSymbol(Symbol).IsUserDef;
      if TElementSymbol(Symbol).IsUserDef then
        UserDefValue := TElementSymbol(Symbol).UserDefValue;
    end;
  end
  { Symbol is Constant }
  else if Symbol is TConstSymbol then begin
    with Tdws2Constant(UseSym) do begin
      DataType  := TConstSymbol(Symbol).Typ.Name;
      Value     := TConstSymbol(Symbol).Data[0];
    end;
  end;

  { Symbol is Synonym (Alias) }
  if Symbol is TAliasSymbol then begin
    with Tdws2Synonym(UseSym) do
      DataType  := TAliasSymbol(Symbol).Typ.Name;
  end;

  { Symbol is Record }
  if Symbol is TRecordSymbol then begin
    { Synch Record Members (Recursive) }
    for i := 0 to TRecordSymbol(Symbol).Members.Count - 1 do
      AddUpdateSymbolToCollection(Tdws2Record(UseSym).Members, TRecordSymbol(Symbol).Members[i]);
  end;

  { Symbol is Variable (DataSymbol) }
  if Symbol is TDataSymbol then begin
    with Tdws2Variable(UseSym) do begin
      DataType := TDataSymbol(Symbol).Typ.Name;
    end;
  end;

  { Symbol is Function }
  if Symbol is TFuncSymbol then begin
    with Tdws2Function(UseSym) do begin   // this is shared for Functions and Methods
      { Result type }
      if TFuncSymbol(Symbol).Result <> nil then
        ResultType := TFuncSymbol(Symbol).Result.Typ.Name
      else
        ResultType := '';
      { Synch Parameters }
      for i := 0 to TFuncSymbol(Symbol).Params.Count - 1 do
        AddUpdateSymbolToCollection(Parameters, TFuncSymbol(Symbol).Params[i]);
    end;
    { If function is a Method (Class) }
    if Symbol is TMethodSymbol then begin
      with Tdws2Method(UseSym) do begin
        { Result type - Methods internally store ancestor FFuncType and a
          new FResultType. FResultType must be set for it to stick. }
        if TMethodSymbol(Symbol).Result <> nil then
          ResultType := TMethodSymbol(Symbol).Result.Typ.Name
        else
          ResultType := '';
        { Method Attributes }
        Attributes := [];
        if TMethodSymbol(Symbol).IsOverride then     // Override (cannot be set as virtual; override;)
          Attributes := Attributes + [maOverride]
        else if TMethodSymbol(Symbol).IsVirtual then // Virtual
          Attributes := Attributes + [maVirtual];
        if TMethodSymbol(Symbol).IsAbstract then     // Abstract
          Attributes := Attributes + [maAbstract];
        { Method name is declared in class and ancestor }
        if TMethodSymbol(Symbol).IsOverlap then begin // Reintrodue
          { If parent method is virtual, it is reintroduced  }
          if TMethodSymbol(Symbol).ParentMeth.IsVirtual then
            Attributes := Attributes + [maReintroduce];
            { If parent method is NOT virtual, it is static, no special attribute }
        end;
        { Method Kind }
        { If a Class Method }
        if TMethodSymbol(Symbol).IsClassMethod then begin
          if TMethodSymbol(Symbol).Kind = fkFunction then         // class function
            Kind := mkClassFunction
          else if TMethodSymbol(Symbol).Kind = fkProcedure then   // class procedure
            Kind := mkClassProcedure
          else
            Assert(False);   // unexptected
        end
        { Not a Class Method }
        else begin
          if TMethodSymbol(Symbol).Kind = fkFunction then         // function
            Kind := mkFunction
          else if TMethodSymbol(Symbol).Kind = fkProcedure then   // procedure
            Kind := mkProcedure
          else if TMethodSymbol(Symbol).Kind = fkConstructor then // constructor
            Kind := mkConstructor
          else if TMethodSymbol(Symbol).Kind = fkDestructor then  // destructor
            Kind := mkDestructor
          else
            Assert(False);   // unexptected
        end;
      end; {with}
    end; {End Method}
  end; {End function}

  { Symbol is Parameter (Function/Method) }
  if Symbol is TParamSymbol then begin
    with UseSym as Tdws2Parameter do begin
      if Symbol is TVarParamSymbol then begin
        IsVarParam := True;
        IsWritable := TVarParamSymbol(Symbol).IsWritable;
      end
      // not a Var param, remove any settings
      else begin
        IsVarParam := False;
        IsWritable := False;
      end;
      DataType  := TParamSymbol(Symbol).Typ.Name;
    end;
  end;

  { Symbol is Member (Records) }
  if Symbol is TMemberSymbol then begin
    with UseSym as Tdws2Member do
      DataType  := TMemberSymbol(Symbol).Typ.Name;
  end;

  { Symbol is Field (Class) }
  if Symbol is TFieldSymbol then begin
    with UseSym as Tdws2Field do
      DataType := TFieldSymbol(Symbol).Typ.Name;
  end;

  { Symbol is Property (Class) }
  if Symbol is TPropertySymbol then begin
    with UseSym as Tdws2Property do begin
      DataType    := TPropertySymbol(Symbol).Typ.Name;
      { ReadAccess setting }
      if TPropertySymbol(Symbol).ReadSym <> nil then
        ReadAccess  := TPropertySymbol(Symbol).ReadSym.Name
      else
        ReadAccess  := '';
      { WriteAccess setting }
      if TPropertySymbol(Symbol).WriteSym <> nil then
        WriteAccess := TPropertySymbol(Symbol).WriteSym.Name
      else
        WriteAccess := '';
      { Synch property default status }
      IsDefault   := TPropertySymbol(Symbol).IsDefault;
      if Assigned(TPropertySymbol(Symbol).IndexSym) then
        IndexType   := TPropertySymbol(Symbol).IndexSym.Name;
      if Length(TPropertySymbol(Symbol).IndexValue) > 0 then
        IndexValue  := TPropertySymbol(Symbol).IndexValue[0]; 
      { Get property parameters (array parameter) - only if the property's 'read'
        symbol is a function }
      for i := 0 to TPropertySymbol(Symbol).ArrayIndices.Count - 1 do
        AddUpdateSymbolToCollection(Parameters, TPropertySymbol(Symbol).ArrayIndices[i]);
    end;
  end;
end;

function GetOrCreateSymbolInCollection(Collection: Tdws2Collection; const SymbolName: string): Tdws2Symbol;
var
  idx: Integer;
begin
  idx := IndexOfName(Collection, SymbolName);
  // if not found, create it, set properties
  if idx = -1 then
    Result := Tdws2Symbol(Collection.Add)
  else
    Result := Tdws2Symbol(Collection.Items[idx]);

  Result.Name := SymbolName;      // set the name if created, reset if exists (change case, etc)
end;

procedure PruneCollectionToTable(Collection: Tdws2Collection; SymbolTable: TSymbolTable);
var
  i: Integer;
  Sym: TSymbol;
begin
  { Remove items from collection that are not in the comperable SymbolTable.
   (This won't remove Delphi event code, just the event link) }
  i := 0;
  while i <= Collection.Count - 1 do
  begin
    Sym := SymbolTable.FindLocal(Collection.Items[i].Name);
    { If Collection item is not in Table, remove from collection }
    if not Assigned(Sym) then
      Collection.Delete(i)
    else
    { Item is in Table, check for applicable sub-types }
    begin
      { Class - Prune fields, methods, and properties }
      if (Collection.Items[i] is Tdws2Class) and (Sym is TClassSymbol) then
      begin
        // Prune fields
        PruneCollectionToTable(Tdws2Class(Collection.Items[i]).Fields, TClassSymbol(Sym).Members);
        // Prune constructors
        PruneCollectionToTable(Tdws2Class(Collection.Items[i]).Constructors, TClassSymbol(Sym).Members);
        // Prune methods
        PruneCollectionToTable(Tdws2Class(Collection.Items[i]).Methods, TClassSymbol(Sym).Members);
        // Prune Properties
        PruneCollectionToTable(Tdws2Class(Collection.Items[i]).Properties, TClassSymbol(Sym).Members);
      end
      { Method - Prune parameters }
      else if (Collection.Items[i] is Tdws2Method) and (Sym is TMethodSymbol) then
        PruneCollectionToTable(Tdws2Method(Collection.Items[i]).Parameters, TMethodSymbol(Sym).Params)
      { Functions - Prune parameters (works for Constructors too) }
      else if (Collection.Items[i] is Tdws2Function) and (Sym is TFuncSymbol) then
        PruneCollectionToTable(Tdws2Function(Collection.Items[i]).Parameters, TFuncSymbol(Sym).Params)
      { Property - Prune paramecters }
      else if (Collection.Items[i] is Tdws2Property) and (Sym is TPropertySymbol) then
        PruneCollectionToTable(Tdws2Property(Collection.Items[i]).Parameters, TPropertySymbol(Sym).ArrayIndices) 
      { Record - Prune members }
      else if (Collection.Items[i] is Tdws2Record) and (Sym is TRecordSymbol) then // Method (get parameters)
        PruneCollectionToTable(Tdws2Record(Collection.Items[i]).Members, TRecordSymbol(Sym).Members);
      //
      // Up the counter to check the next item in collection
      Inc(i);
    end; {begin - Check sub types}
  end; {while}
end;

procedure SortUnitToScript(AUnit: Tdws2Unit; AProgram: TProgram);
begin
  { Sort the items within each collection according to the order declared in the
    script. (Will recursively sort for Class members, etc.) }

  { Array Symbols }
  SortCollectionToScript(AUnit.Arrays, AProgram.Table, suDeclaration, AProgram.SymbolDictionary);

  // forwards are not significant for order, still - order them as classes declared
  SortCollectionToScript(AUnit.Forwards, AProgram.Table, suForward, AProgram.SymbolDictionary);

  { Class Symbols }
  SortCollectionToScript(AUnit.Classes, AProgram.Table, suDeclaration, AProgram.SymbolDictionary);

  { Constant Symbols }
  SortCollectionToScript(AUnit.Constants, AProgram.Table, suDeclaration, AProgram.SymbolDictionary);

  { Enumeration Symbols }
  SortCollectionToScript(AUnit.Enumerations, AProgram.Table, suDeclaration, AProgram.SymbolDictionary);

  { Function Symbol }
  SortCollectionToScript(AUnit.Functions, AProgram.Table, suDeclaration, AProgram.SymbolDictionary);

  { Record Symbol }
  SortCollectionToScript(AUnit.Records, AProgram.Table, suDeclaration, AProgram.SymbolDictionary);

  { Synonym Symbol }
  SortCollectionToScript(AUnit.Synonyms, AProgram.Table, suDeclaration, AProgram.SymbolDictionary);

  { Variable Symbol }
  SortCollectionToScript(AUnit.Variables, AProgram.Table, suDeclaration, AProgram.SymbolDictionary);
end;

procedure SortCollectionToScript(Collection: Tdws2Collection; 
                                 ATable: TSymbolTable; UsageType: TSymbolUsage;
                                 Dictionary: TSymbolDictionary);
var
  i: Integer;
  changed: Boolean;
  CurrPos, NextPos: TSymbolPosition;
  Symbol: TSymbol;
begin
  { Uses the BubbleSort algorithm. I did not care to further optimize the sort
    because it is the final step of a design-time only process. }

  { BubbleSort method }
  Changed := True;
  while Changed do
  begin
    Changed := False;
    for i := 0 to Collection.Count - 2 do
    begin
      // Don't use CollectionItem.Name on Dictionary. Same name may be used
      // within different table scopes.
      CurrPos := Dictionary.FindSymbolUsage(ATable.FindLocal(Collection.Items[i].Name), UsageType);
      NextPos := Dictionary.FindSymbolUsage(ATable.FindLocal(Collection.Items[i+1].Name), UsageType);
      { Compare positions in script }
      if Assigned(CurrPos) and Assigned(NextPos) then
        if CurrPos.ScriptPos.Pos > NextPos.ScriptPos.Pos then  // if current goes after the next, move next up one
        begin
          Collection.Items[i+1].Index := Collection.Items[i+1].Index - 1;
          Changed := True; 
        end;
    end;
  end;

  { Cycle Collection to see if it has sub-types to sort }
  for i := 0 to Collection.Count - 1 do
  begin
    Symbol := ATable.FindLocal(Collection.Items[i].Name);
    { Class - sort Fields, Methods, Properties }
    if (Collection.Items[i] is Tdws2Class) and (Symbol is TClassSymbol) then
    begin
      SortCollectionToScript(Tdws2Class(Collection.Items[i]).Fields, TClassSymbol(Symbol).Members, suDeclaration, Dictionary);
      SortCollectionToScript(Tdws2Class(Collection.Items[i]).Constructors, TClassSymbol(Symbol).Members, suDeclaration, Dictionary);
      SortCollectionToScript(Tdws2Class(Collection.Items[i]).Methods, TClassSymbol(Symbol).Members, suDeclaration, Dictionary);
      SortCollectionToScript(Tdws2Class(Collection.Items[i]).Properties, TClassSymbol(Symbol).Members, suDeclaration, Dictionary);
    end;

    { Record - sort Members }
    if (Collection.Items[i] is Tdws2Record) and (Symbol is TRecordSymbol) then
      SortCollectionToScript(Tdws2Record(Collection.Items[i]).Members, TRecordSymbol(Symbol).Members, suDeclaration, Dictionary);

    { Property - sort parameters }
    if (Collection.Items[i] is Tdws2Property) and (Symbol is TPropertySymbol) then
      SortCollectionToScript(Tdws2Property(Collection.Items[i]).Parameters, TPropertySymbol(Symbol).ArrayIndices, suDeclaration, Dictionary);

    { Enumerations - sort elements }
    if (Collection.Items[i] is Tdws2Enumeration) and (Symbol is TEnumerationSymbol) then
      SortCollectionToScript(Tdws2Enumeration(Collection.Items[i]).Elements, TEnumerationSymbol(Symbol).Elements, suDeclaration, Dictionary);

    { Function - (methods too), sort parameters }
    if (Collection.Items[i] is Tdws2Function) and (Symbol is TFuncSymbol) then
      SortCollectionToScript(Tdws2Function(Collection.Items[i]).Parameters, TFuncSymbol(Symbol).Params, suDeclaration, Dictionary);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: AddWarningsForUnsupportedTypes
  Author:    Mark Ericksen
  Date:      19-Oct-2002
  Arguments: AProgram: TProgram
  Result:    None
  Purpose:   Add program warning messages for types that are not supported in Units.
-----------------------------------------------------------------------------}
procedure AddWarningsForUnsupportedTypes(AProgram: TProgram);
var
  i: Integer;
  SymPos: TSymbolPosition;
begin
  if not Assigned(AProgram) then Exit;

  for i := 0 to AProgram.Table.Count - 1 do
  begin