dws2unitutils.pas

script language

    SymPos := AProgram.SymbolDictionary.FindSymbolUsage(AProgram.Table[i], suDeclaration);
    if Assigned(SymPos) and (not TypeIsSupportedInUnit(AProgram.Table[i])) then
      AProgram.Msgs.AddCompilerWarning(SymPos.ScriptPos, Format('The type "%s" is not supported in a Tdws2Unit.', [AProgram.Table[i].ClassName]));
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: IndexOfName
  Author:    Mark Ericksen
  Date:      14-Oct-2002
  Arguments: Collection: Tdws2Collection; const AName: string
  Result:    Integer
  Purpose:   Return the index of the named item from the Tdws2Collection.
-----------------------------------------------------------------------------}
function IndexOfName(Collection: Tdws2Collection; const AName: string): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to Collection.Count - 1 do
    if CompareText(Collection.Items[i].Name, AName) = 0 then
    begin
      Result := i;
      Break;
    end;
end;

procedure UnitToScript(AUnit: Tdws2Unit; ScriptLines: TStrings; ClearLines: Boolean);
var
  CurrSection: string;

    procedure NewSection(SectName: string);
    begin
      if ScriptLines.Count > 0 then
        ScriptLines.Add('');    // create space between previous entry
      ScriptLines.Add('{ '+SectName+' }');
      CurrSection := SectName;   // store local value of current section
    end;
var
  i: Integer;
  ForwardedImpl: TStringList;   // implementations of forwarded declarations (functions and class methods)
begin
  if ClearLines then
    ScriptLines.Clear;

  ScriptLines.BeginUpdate;
  ForwardedImpl:= TStringList.Create;
  try
    { Process Forwards }
    with AUnit.Forwards do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Forward Declarations');
      for i := 0 to Count - 1 do
        GetUnitSymbolText(Items[i], ScriptLines, nil);
    end;
    { Process Constants }
    with AUnit.Constants do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Constants');
      for i := 0 to Count - 1 do
        GetUnitSymbolText(Items[i], ScriptLines, nil);
    end;
    { Process Enumerations }
    with AUnit.Enumerations do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Enumerations');
      for i := 0 to Count - 1 do
        GetUnitSymbolText(Items[i], ScriptLines, nil);
    end;
    { Process Synonyms (Aliases) }
    with AUnit.Synonyms do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Synonyms');
      for i := 0 to Count - 1 do
        GetUnitSymbolText(Items[i], ScriptLines, nil);
    end;
    { Process Arrays }
    with AUnit.Arrays do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Arrays');
      for i := 0 to Count - 1 do
        GetUnitSymbolText(Items[i], ScriptLines, nil);
    end;
    { Process Records }
    with AUnit.Records do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Records');
      for i := 0 to Count - 1 do
      begin
        if i > 0 then
          ScriptLines.Add('');      // add blank lines after first entry
        GetUnitSymbolText(Items[i], ScriptLines, nil);
      end;
    end;
    { Process Classes }
    with AUnit.Classes do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Classes');
      for i := 0 to Count - 1 do
      begin
        if i > 0 then
          ScriptLines.Add('');      // add blank lines after first entry
        GetUnitSymbolText(Items[i], ScriptLines, ForwardedImpl);
      end;
    end;
    { Process Functions }
    with AUnit.Functions do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Functions');
      for i := 0 to Count - 1 do
        GetUnitSymbolText(Items[i], ScriptLines, ForwardedImpl);
    end;
    { Process Variables }
    with AUnit.Variables do begin
      { Write out section header if there is something to display }
      if Count > 0 then
        NewSection('Variables');
      for i := 0 to Count - 1 do
        GetUnitSymbolText(Items[i], ScriptLines, nil);
    end;

    { Put class implementations down }
    if ForwardedImpl.Count > 0 then begin
      ScriptLines.Add('');
      ScriptLines.Add('{ ============================================== }');
      ScriptLines.Add('{ ========= Empty Implementation Stubs ========= }');
      ScriptLines.Add('{ ============================================== }');
      ScriptLines.AddStrings(ForwardedImpl);
    end;
  finally
    ForwardedImpl.Free;
    ScriptLines.EndUpdate;
  end;
end;

procedure ScriptToUnit(AUnit: Tdws2Unit; AProgram: TProgram; RemoveUndeclared: Boolean);
var
  i: Integer;
begin
  { Don't synch if has syntax errors }
  if AProgram.Msgs.HasCompilerErrors or AProgram.Msgs.HasErrors then EXIT;

  { Examine only the symbols declared in the generated script }
  { Add symbols declared StartingTable - optionally include unit declarations }
  for i := 0 to AProgram.Table.Count - 1 do begin
    // This won't process unit declarations, only script declared symbols

    { Update Arrays }
    if AProgram.Table.Symbols[i] is TCustomArraySymbol then
      AddUpdateSymbolToCollection(AUnit.Arrays, AProgram.Table.Symbols[i]);

    { Update Forwards (Class forward) }
    if AProgram.Table.Symbols[i] is TClassSymbol then
      // if a class forward was found, add the symbol
      if Assigned(AProgram.SymbolDictionary.FindSymbolUsage(AProgram.Table.Symbols[i], suForward)) then
        AddUpdateSymbolToCollection(AUnit.Forwards, AProgram.Table.Symbols[i]);

    { Update Classes }
    if AProgram.Table.Symbols[i] is TClassSymbol then
      AddUpdateSymbolToCollection(AUnit.Classes, AProgram.Table.Symbols[i]);

    { Update Constants - A TElement is a TConstSymbol but is part of TEnumerationSymbol } 
    if AProgram.Table.Symbols[i].ClassType = TConstSymbol then  // exactly match class type
      AddUpdateSymbolToCollection(AUnit.Constants, AProgram.Table.Symbols[i]);

    { Update Enumerations }
    if AProgram.Table.Symbols[i] is TEnumerationSymbol then
      AddUpdateSymbolToCollection(AUnit.Enumerations, AProgram.Table.Symbols[i]);

    { Update Synonyms }
    if AProgram.Table.Symbols[i] is TAliasSymbol then
      AddUpdateSymbolToCollection(AUnit.Synonyms, AProgram.Table.Symbols[i]);

    { Update Functions }
    if AProgram.Table.Symbols[i] is TFuncSymbol then
      AddUpdateSymbolToCollection(AUnit.Functions, AProgram.Table.Symbols[i]);

    { Update Records }
    if AProgram.Table.Symbols[i] is TRecordSymbol then
      AddUpdateSymbolToCollection(AUnit.Records, AProgram.Table.Symbols[i]);

    { Update Variables }
    if AProgram.Table.Symbols[i] is TDataSymbol then
      AddUpdateSymbolToCollection(AUnit.Variables, AProgram.Table.Symbols[i]);
  end;

  { Remove from the unit was was removed from the script. }
  if RemoveUndeclared then
  begin
    { Remove from Arrays }
    PruneCollectionToTable(AUnit.Arrays, AProgram.Table);

    { Remove from Forwards (Class forward) }
    i := 0;
    while i <= AUnit.Forwards.Count - 1 do
    begin
      { This is done differently because we have to find if it was forwarded.
        The original forwarded symbol was already removed from the table. }
      if AProgram.SymbolDictionary.FindSymbolUsage(AUnit.Forwards.Items[i].Name, suForward) = nil then
        AUnit.Forwards.Delete(i)
      else
        Inc(i);
    end;

    { Remove from Classes }
    PruneCollectionToTable(AUnit.Classes, AProgram.Table);

    { Remove from Constants }
    PruneCollectionToTable(AUnit.Constants, AProgram.Table);

    { Remove from Enumerations }
    PruneCollectionToTable(AUnit.Enumerations, AProgram.Table);

    { Remove from Functions }
    PruneCollectionToTable(AUnit.Functions, AProgram.Table);

    { Remove from Records }
    PruneCollectionToTable(AUnit.Records, AProgram.Table);

    { Remove from Synonyms }
    PruneCollectionToTable(AUnit.Synonyms, AProgram.Table);

    { Remove from Variables }
    PruneCollectionToTable(AUnit.Variables, AProgram.Table);
  end;

  { Sort the declaration following the script }
  SortUnitToScript(AUnit, AProgram);

  { Warn about unsupported types. Types used in the script that are not
    supported in units. }
  AddWarningsForUnsupportedTypes(AProgram);
end;

function TypesAreEquivalents(ASym: Tdws2Symbol; BSym: TSymbol): Boolean;
begin
  if (ASym is Tdws2Array) and (BSym is TArraySymbol) then
    Result := True
  else if (ASym is Tdws2Constant) and (BSym is TConstSymbol) then
    Result := True
  else if (ASym is Tdws2Variable) and (BSym is TDataSymbol) then
    Result := True
  else if (ASym is Tdws2Class) and (BSym is TClassSymbol) then
    Result := True
  else if (ASym is Tdws2Method) and (BSym is TMethodSymbol) then   // compare Method before function (descendent)
    Result := True
  else if (ASym is Tdws2Forward) and (BSym is TClassSymbol) then   // !No direct comparison for forwards
    Result := True
  else if (ASym is Tdws2Field) and (BSym is TFieldSymbol) then
    Result := True
  else if (ASym is Tdws2Property) and (BSym is TPropertySymbol) then
    Result := True
  else if (ASym is Tdws2Record) and (BSym is TRecordSymbol) then
    Result := True
  else if (ASym is Tdws2Member) and (BSym is TMemberSymbol) then
    Result := True
  else if (ASym is Tdws2Function) and (BSym is TFuncSymbol) then
    Result := True
  else if (ASym is Tdws2Parameter) and (BSym is TParamSymbol) then
    Result := True
  else
    Result := False;
end;

{-----------------------------------------------------------------------------
  Procedure: TypeIsSupportedInUnit
  Author:    Mark Ericksen
  Date:      19-Oct-2002
  Arguments: Symbol: TSymbol
  Result:    Boolean
  Purpose:   Return if the symbol is supported for storage in a Tdws2Unit.
-----------------------------------------------------------------------------}
function TypeIsSupportedInUnit(Symbol: TSymbol): Boolean;
begin
  Result := (Symbol is TCustomArraySymbol) or
            (Symbol is TConstSymbol) or
            (Symbol is TEnumerationSymbol) or
            (Symbol is TAliasSymbol) or
            (Symbol is TClassSymbol) or
            (Symbol is TFieldSymbol) or
            (Symbol is TMethodSymbol) or
            (Symbol is TRecordSymbol) or
            (Symbol is TMemberSymbol) or
            (Symbol is TFuncSymbol) or
            (Symbol is TParamSymbol) or
            (Symbol.ClassType = TDataSymbol);    // not Symbol is TDataSymbol because there are unsupported descendants
end;

function MethodClassSymbol(Method: Tdws2Function): Tdws2Class;
var
  tmpOwner: TPersistent;
begin
  Result := nil;
  if Assigned(Method) then
  begin
    tmpOwner := Tdws2Collection(Method.Collection).GetOwner;
    if tmpOwner is Tdws2Class then
      Result := Tdws2Class(tmpOwner);
    //Result := Tdws2Class(Tdws2Collection(Method.Collection).GetOwner);
  end;
end;

function MethodClassSymbolName(Method: Tdws2Function): string;
var
  ClassSym: Tdws2Class;
begin
  Result := '';
  ClassSym := MethodClassSymbol(Method);
  if Assigned(ClassSym) then
    Result := ClassSym.Name;
end;

{-----------------------------------------------------------------------------
  Procedure: FindSymbolForUnitFunction
  Author:    Mark Ericksen
  Date:      20-Nov-2002
  Arguments: AProgram: TProgram; AUnitFunc: Tdws2Function
  Result:    TFuncSymbol
  Purpose:   Find the function symbol (TFuncSymbol) that matches the unit function symbol (Tdws2Function)
-----------------------------------------------------------------------------}
function FindSymbolForUnitFunction(AProgram: TProgram; AUnitFunc: Tdws2Function): TFuncSymbol;
var
  classSym: TClassSymbol;
begin
  Result := nil;
  // dealing with a method of a class
  if (AUnitFunc is Tdws2Method) or (AUnitFunc is Tdws2Constructor) then
  begin
    // find the owning class (compiled symbol)
    classSym := TClassSymbol(AProgram.Table.FindSymbol(Tdws2Class(Tdws2Collection(AUnitFunc.Collection).GetOwner).Name));
    if Assigned(classSym) then
      Result := TMethodSymbol(classSym.Members.FindLocal(AUnitFunc.Name)); // get symbol version of method
  end
  // regular function (not method of a class)
  else
    Result := TFuncSymbol(AProgram.Table.FindSymbol(AUnitFunc.Name));
end;

end.