dws2comp.pas

script language

end;

function Tdws2Collection.GetUnit: Tdws2Unit;
begin
  Result := FUnit;
end;

function Tdws2Collection.GetItem(Index: Integer): Tdws2Symbol;
begin
  Result := Tdws2Symbol(inherited Items[Index]);
end;

procedure Tdws2Collection.Reset;
var
  x: Integer;
begin
  for x := 0 to Count - 1 do
    Items[x].Reset;
end;

procedure Tdws2Collection.SetItem(Index: Integer; Value: Tdws2Symbol);
begin
  Items[Index].Assign(Value);
end;

function Tdws2Collection.GetSymbols(const Name: String): Tdws2Symbol;
var
  x: Integer;
begin
  for x := 0 to Count - 1 do
  begin
    Result := Items[x];
    if SameText(Result.Name,Name) then
      Exit;
  end;
  Result := nil;
end;

class function Tdws2Collection.GetSymbolClass: Tdws2SymbolClass;
begin
  result := Tdws2Symbol;
end;

{ Tdws2Unit }

procedure Tdws2Unit.AddCollectionSymbols(Collection: Tdws2Collection;
  Table: TSymbolTable);
var
  y: Integer;
begin
  for y := 0 to Collection.Count - 1 do
  begin
    if not Tdws2Symbol(Collection.Items[y]).IsGenerating then
    try
      Tdws2Symbol(Collection.Items[y]).Generate(Table);
    except
      on e: Exception do
        raise EGenerationError.CreateFmt(UNT_UnitGenerationError, [UnitName,
          e.Message]);
    end;
  end;
end;

procedure Tdws2Unit.AddUnitSymbols(Table: TSymbolTable);
var
  x: Integer;
begin
  for x := Low(FCollections) to High(FCollections) do
    FCollections[x].Reset;

  for x := Low(FCollections) to High(FCollections) do
    AddCollectionSymbols(FCollections[x], Table);
end;

constructor Tdws2Unit.Create(AOwner: TComponent);
begin
  inherited;
  FArrays := GetArraysClass.Create(Self);
  FClasses := GetClassesClass.Create(Self);
  FConstants := GetConstantsClass.Create(Self);
  FEnumerations := GetEnumerationsClass.Create(Self);
  FForwards := GetForwardsClass.Create(Self);
  FFunctions := GetFunctionsClass.Create(Self);
  FRecords := GetRecordsClass.Create(Self);
  FVariables := GetVariablesClass.Create(Self);
  FInstances := GetInstancesClass.Create(Self);
  FSynonyms := GetSynonymsClass.Create(Self);
  FCollections[0] := FForwards;
  FCollections[1] := FArrays;
  FCollections[2] := FClasses;
  FCollections[3] := FRecords;
  FCollections[4] := FEnumerations;
  FCollections[5] := FSynonyms;
  FCollections[6] := FFunctions;
  FCollections[7] := FVariables;
  FCollections[8] := FConstants;
  FCollections[9] := FInstances;
  FStaticTable := nil;
  FStaticSymbols := False;
end;

destructor Tdws2Unit.Destroy;
begin
  ReleaseStaticSymbols;
  FArrays.Free;
  FClasses.Free;
  FConstants.Free;
  FEnumerations.Free;
  FForwards.Free;
  FRecords.Free;
  FFunctions.Free;
  FVariables.Free;
  FInstances.Free;
  FSynonyms.Free;
  inherited;
end;

procedure Tdws2Unit.GetClassTypes(List: TStrings);
var
  x: Integer;
begin
  if not Assigned(List) then
    Exit;

  if Assigned(FScript) then
    for x := 0 to FScript.Config.SystemTable.Count - 1 do
    begin
      if FScript.Config.SystemTable[x] is TClassSymbol then
        List.Add(Script.Config.SystemTable[x].Name);
    end;

  for x := 0 to FClasses.Count - 1 do
    List.Add(FClasses.Items[x].Name);
end;

procedure Tdws2Unit.GetDataTypes(List: TStrings);
var
  x, y: Integer;
  coll: Tdws2Collection;
begin
  if not Assigned(List) then
    Exit;

  if Assigned(FScript) then
    // Add all type symbols from the systemtable
    for x := 0 to FScript.Config.SystemTable.Count - 1 do
    begin
      if FScript.Config.SystemTable[x] is TTypeSymbol then
        List.Add(FScript.Config.SystemTable[x].Name);
    end;

  // Only return array-, record- and class symbols, synonyms and enums
  for x := 1 to 5 do
  begin
    coll := FCollections[x];
    for y := 0 to coll.Count - 1 do
      List.Add(coll.Items[y].Name);
  end;
end;

function Tdws2Unit.GetSymbol(Table: TSymbolTable; const Name: string): TSymbol;
var
  x, y: Integer;
  item: Tdws2Symbol;
  coll: Tdws2Collection;
begin
  Result := FTable.FindSymbol(Name);
  if not Assigned(Result) then
    for x := Low(FCollections) to High(FCollections) do
    begin
      // Check if the symbol is defined but not yet generated
      coll := FCollections[x];
      for y := 0 to coll.Count - 1 do
        if SameText(coll.Items[y].Name, Name) then
        begin
          item := coll.Items[y];

          // Check for circular references
          if item.IsGenerating then
            raise Exception.CreateFmt(UNT_CircularReference, [Name]);

          // Generate the symbol now
          try
            Result := item.Generate(Table);
          except
            on e: Exception do
              raise EHandledGenerationError.Create(e.Message);
          end;

          Exit;
        end;
    end;
end;

function Tdws2Unit.InitStaticSymbols(SystemTable, UnitSyms: TSymbolTable): Boolean;
var
  staticParent: TStaticSymbolTable;
begin
  if not Assigned(FStaticTable) then
  begin
    if SystemTable is TStaticSymbolTable then
      staticParent := TStaticSymbolTable(SystemTable)
    else if SystemTable is TLinkedSymbolTable then
      staticParent := TLinkedSymbolTable(SystemTable).Parent
    else
      staticParent := nil;
      
    if Assigned(staticParent) then
    begin
      FStaticTable := CreateUnitTable(staticParent, sttStatic) as TStaticSymbolTable;
      try
        InitUnitTable(SystemTable, UnitSyms, FStaticTable);
      except
        ReleaseStaticSymbols;
        raise;
      end;
    end;
  end; // else check FSymbolTable = StaticTable
  Result := Assigned(FStaticTable);
end;

procedure Tdws2Unit.ReleaseStaticSymbols;
var
  s: TStaticSymbolTable;
begin
  if Assigned(FStaticTable) then
  begin
    s := FStaticTable;
    FStaticTable := nil;
    s._Release;
  end;
end;

function Tdws2Unit.GetUnitTable(SystemTable, UnitSyms: TSymbolTable): TSymbolTable;
begin
  if StaticSymbols and InitStaticSymbols(SystemTable, UnitSyms) then
    Result := CreateUnitTable(FStaticTable, sttLinked) as TLinkedSymbolTable // typecheck
  else
  begin
    Result := CreateUnitTable(SystemTable); // sttDefault
    try
      InitUnitTable(SystemTable, UnitSyms, Result);
    except
      Result.Free;
      raise;
    end;
  end;
end;

procedure Tdws2Unit.InitUnitTable(SystemTable, UnitSyms, UnitTable: TSymbolTable);
var
  x: Integer;
  sym: TSymbol;
begin
  FTable := UnitTable;
  try

    if UnitName = '' then
      raise Exception.CreateFmt(UNT_UnitNameNotDefined, [Name]);

    for x := 0 to FDependencies.Count - 1 do
    begin
      sym := UnitSyms.FindSymbol(FDependencies[x]);
      try
        UnitTable.AddParent(TUnitSymbol(sym).Table);
      except
        on e: Exception do
          raise Exception.CreateFmt(UNT_DependencyError,[UnitName, Sym.Name, e.Message]);
      end;
      UnitTable.AddSymbol(TUnitSymbol.Create(TUnitSymbol(sym).Name,
        TUnitSymbol(sym).Table));
    end;

    AddUnitSymbols(UnitTable);

  finally
    FTable := nil;
  end;
end;

procedure Tdws2Unit.SetArrays(const Value: Tdws2Arrays);
begin
  FArrays.Assign(Value);
end;

procedure Tdws2Unit.SetClasses(const Value: Tdws2Classes);
begin
  FClasses.Assign(Value);
end;

procedure Tdws2Unit.SetConstants(const Value: Tdws2Constants);
begin
  FConstants.Assign(Value);
end;

procedure Tdws2Unit.SetForwards(const Value: Tdws2Forwards);
begin
  FForwards.Assign(Value);
end;

procedure Tdws2Unit.SetFunctions(const Value: Tdws2Functions);
begin
  FFunctions.Assign(Value);
end;

procedure Tdws2Unit.SetRecords(const Value: Tdws2Records);
begin
  FRecords.Assign(Value);
end;

procedure Tdws2Unit.SetVariables(const Value: Tdws2Variables);
begin
  FVariables.Assign(Value);
end;

procedure Tdws2Unit.SetEnumerations(const Value: Tdws2Enumerations);
begin
  FEnumerations.Assign(Value);
end;

procedure Tdws2Unit.SetInstances(const Value: Tdws2Instances);
begin
  FInstances.Assign(Value);
end;

procedure Tdws2Unit.SetStaticSymbols(const Value: Boolean);
begin
  FStaticSymbols := Value;
  if not FStaticSymbols then
    ReleaseStaticSymbols;
end;

function Tdws2Unit.CreateUnitTable(Parent: TSymbolTable; Typ: TSymbolTableType): TSymbolTable;
begin
  case Typ of
    sttLinked: Result := TLinkedSymbolTable.Create(Parent as TStaticSymbolTable);
    sttStatic: Result := TStaticSymbolTable.Create(Parent as TStaticSymbolTable);
  else
    Result := TSymbolTable.Create(Parent);
  end;
end;

class function Tdws2Unit.GetFunctionsClass: Tdws2FunctionsClass;
begin
  result := Tdws2Functions;
end;

class function Tdws2Unit.GetArraysClass: Tdws2ArraysClass;
begin
  result := Tdws2Arrays;
end;

class function Tdws2Unit.GetClassesClass: Tdws2ClassesClass;
begin
  result := Tdws2Classes;
end;

class function Tdws2Unit.GetConstantsClass: Tdws2ConstantsClass;
begin
  result := Tdws2Constants;
end;

class function Tdws2Unit.GetEnumerationsClass: Tdws2EnumerationsClass;
begin
  result := Tdws2Enumerations;
end;

class function Tdws2Unit.GetForwardsClass: Tdws2ForwardsClass;
begin
  result := Tdws2Forwards;
end;

class function Tdws2Unit.GetInstancesClass: Tdws2InstancesClass;
begin
  result := Tdws2Instances;
end;

class function Tdws2Unit.GetRecordsClass: Tdws2RecordsClass;
begin
  result := Tdws2Records;
end;

class function Tdws2Unit.GetVariablesClass: Tdws2VariablesClass;
begin
  result := Tdws2Variables;
end;

class function Tdws2Unit.GetSynonymsClass: Tdws2SynonymsClass;
begin
  result := Tdws2Synonyms;
end;

procedure Tdws2Unit.SetSynonyms(const Value: Tdws2Synonyms);
begin
  FSynonyms.Assign(Value);
end;

{ Tdws2Constant }

procedure Tdws2Constant.Assign(Source: TPersistent);
begin
  inherited;
  if Source is Tdws2Constant then
    FValue := Tdws2Constant(Source).Value;
end;

function Tdws2Constant.DoGenerate(Table: TSymbolTable;
  ParentSym: TSymbol): TSymbol;
begin
  FIsGenerating := True;
  CheckName(Table, Name);

  Result := TConstSymbol.Create(Name, GetDataType(Table, DataType), Value);

  GetUnit.Table.AddSymbol(Result);
end;

function Tdws2Constant.GetDisplayName: string;
begin
  Result := Format('const %s: %s = %s', [Name, DataType, VarToStr(Value)]);
end;

{ Tdws2Variable }

procedure Tdws2Variable.Assign(Source: TPersistent);
begin
  inherited;
  if Source is Tdws2Variable then
    FDataType := Tdws2Variable(Source).DataType;
end;

function Tdws2Variable.GetDisplayName: string;
begin
  Result := Name + ' : ' + DataType;
end;

{ Tdws2Variables }

function Tdws2Variables.GetDisplayName: string;
var
  i: Integer;