ASStructs.pas

unit ASStructs;

{ **************************************************************************** }
{ Rejbrand AlgoSim structure types and functions                               }
{ Copyright © 2017-2022 Andreas Rejbrand                                       }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  SysUtils, Types, Classes, ASNum, Generics.Defaults, Generics.Collections,
  ASObjects, ASColors, Graphics, ASKernelDefs, Math;

type
  TStructType = (stDate, stTime, stDateTime, stRGB, stHSV, stHSL,
    stStructMember, stVariable, stVariableMetadata, stRationalNumber,
    stMatrixSize, stNamedColor, stIntRect, stIntPoint, stIntRange, stErrorInfo,
    stOpData, stVersionData, stCmdHistItem, stVisObj);

  TStructTypeHelper = record helper for TStructType
    function Name: string;
    function New(const AValues: array of TAlgosimObject): TAlgosimTypedStructure; overload;
    function New(const AMembers: array of TAlgosimStructure.TMemberRef): TAlgosimTypedStructure; overload;
    function New: TAlgosimTypedStructure; overload;
    function ValidateAgainst(AStruct: TAlgosimStructure): Boolean; overload;
    function ValidateAgainst(AObject: TAlgosimObject): Boolean; overload;
    function MatchingName(AStruct: TAlgosimStructure): Boolean; overload; inline;
    function MatchingName(AObject: TAlgosimObject): Boolean; overload; inline;
    function CreateTypeObject: TAlgosimStructureType;
    class function FromString(const AName: string): TStructType; static;
  end;

function CreateStructTypeByName(const AName: string): TAlgosimStructureType;
procedure RegisterStructType(AStructType: TAlgosimStructureType);
procedure UnregisterStructType(const AName: string);

function IsTypedStructure(AObject: TAlgosimObject;
  AType: TStructType): Boolean; overload; inline;

function IsTypedStructure(AObject: TAlgosimObject;
  const ATypes: array of TStructType): Boolean; overload;

function ASOVariable(const AName, ADescription: string;
  const ACreated: TDateTime; AValue: TAlgosimObject; AProtected: Boolean): TAlgosimTypedStructure;
function ASOVariableMetadata(const AName, ADescription: string;
  const ACreated: TDateTime; AProtected: Boolean): TAlgosimTypedStructure;
function ASOMember(const AMember: TAlgosimStructure.TMemberRef): TAlgosimTypedStructure;
function ASODate(const ADate: TDate): TAlgosimTypedStructure; overload;
function ASODate(const AYear, AMonth, ADay: Integer): TAlgosimTypedStructure; overload;
function ASOTime(const ATime: TTime): TAlgosimTypedStructure; overload;
function ASOTime(const AHour, AMinute, ASecond, AMillisecond: Integer): TAlgosimTypedStructure; overload;
function ASODateTime(const ADateTime: TDateTime): TAlgosimTypedStructure; overload;
function ASODateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
  AMillisecond: Integer): TAlgosimTypedStructure; overload;
function ASORationalNumber(const ARationalNumber: TRationalNumber): TAlgosimTypedStructure;
function ASOMatrixSize(const AMatrixSize: TMatrixSize): TAlgosimTypedStructure;
function ASOSize(const ASize: TSize): TAlgosimTypedStructure; overload;
function ASOSize(ARows, ACols: Integer): TAlgosimTypedStructure; overload;
function ASORGB(const ARGB: TRGB): TAlgosimTypedStructure;
function ASOHSV(const AHSV: THSV): TAlgosimTypedStructure;
function ASOHSL(const AHSL: THSL): TAlgosimTypedStructure;
function ASONamedColor(const AName: string;
  const AColor: TColor): TAlgosimTypedStructure;
function ASOIntRect(ALeft, ATop, AWidth, AHeight: Integer): TAlgosimTypedStructure; overload;
function ASOIntRect(const ARect: TRect): TAlgosimTypedStructure; overload;
function ASOIntPoint(X, Y: Integer): TAlgosimTypedStructure; overload;
function ASOIntPoint(const APoint: TPoint): TAlgosimTypedStructure; overload;
function ASOIntRange(AFrom, ATo: integer; AStep: Integer = 1): TAlgosimTypedStructure;
function ASOErrorInfo(const AReason: string;
  const ACallStack: array of TClass): TAlgosimTypedStructure;
function ASOOpData(ASymbol: Char; const AKind: string; APrecedence: Integer;
  const AAssociativity: string; AFunction: TClass;
  AListLeft, AListRight, ACollapse: Boolean): TAlgosimTypedStructure;
function ASOVersionData(const AVersionData: TVersionData): TAlgosimTypedStructure;
function ASOCmdHistItem(const ACmd: string; const ATime: TDateTime;
  const AEvalTime: Double; AResult: TAlgosimObject): TAlgosimTypedStructure;
function ASOVisObject(const ID: TGUID; const AName, AType, ARealm, ATitle,
  ADescription: string): TAlgosimTypedStructure;

function ASOToRationalNumber(AObject: TAlgosimObject): TRationalNumber;
function ASOToDateTime(AObject: TAlgosimObject): TDateTime;
function ASOToDateTimeFree(AObject: TAlgosimObject): TDateTime;
function ASOToIntRange(AObject: TAlgosimObject): TRange;
function ASOToColor(AObject: TAlgosimObject): TRGB;

function FPCWStructure(AFPCW: Word): TAlgosimStructure;

implementation

uses
  ASExpression, DateUtils;

type
  TAlgosimKernelStructureType = class(TAlgosimStructureType);

  TStructTypeManager = record
  strict private
    class function def(const AName: string;
      const AMembers: array of TAlgosimStructure.TMemberRef): TAlgosimStructureType; static;
    class constructor Create;
    class destructor Destroy;
  private
    class var StructTypes: array[TStructType] of TAlgosimStructureType;
    class var StructDict: TObjectDictionary<string, TAlgosimStructureType>;
  end;

function CreateStructTypeByName(const AName: string): TAlgosimStructureType;
begin
  if TStructTypeManager.StructDict.TryGetValue(AName, Result) then
    Result := TAlgosimStructureType.Create(Result)
  else
    raise EStructureException.CreateFmt(SUnknownStructType, [AName]);
end;

procedure RegisterStructType(AStructType: TAlgosimStructureType);
begin
  if TStructTypeManager.StructDict.ContainsKey(AStructType.Name) then
    raise EStructureException.CreateFmt(SStructTypeAlreadyRegistered, [AStructType.Name]);
  TStructTypeManager.StructDict.Add(AStructType.Name, AStructType.Clone as TAlgosimStructureType);
end;

procedure UnregisterStructType(const AName: string);
var
  StructType: TAlgosimStructureType;
begin
  if not TStructTypeManager.StructDict.TryGetValue(AName, StructType) then
    raise EStructureException.CreateFmt(SUnknownStructType, [AName]);
  if StructType is TAlgosimKernelStructureType then
    raise EStructureException.CreateFmt(SCannotUnregisterKernelType, [AName]);
  TStructTypeManager.StructDict.Remove(AName);
end;

function IsTypedStructure(AObject: TAlgosimObject;
  AType: TStructType): Boolean; inline;
begin
  Result := AType.MatchingName(AObject);
end;

function IsTypedStructure(AObject: TAlgosimObject;
  const ATypes: array of TStructType): Boolean;
var
  i: Integer;
begin
  for i := 0 to High(ATypes) do
    if ATypes[i].MatchingName(AObject) then
      Exit(True);
  Result := False;
end;

function ASOVariable(const AName, ADescription: string;
  const ACreated: TDateTime; AValue: TAlgosimObject;
  AProtected: Boolean): TAlgosimTypedStructure;
begin
  Result := stVariable.New(
    [
      sm('name', ASO(AName)),
      sm('description', ASO(ADescription)),
      sm('created', ASODateTime(ACreated)),
      sm('value', AValue.Clone),
      sm('protected', ASO(AProtected))
    ])
end;

function ASOVariableMetadata(const AName, ADescription: string;
  const ACreated: TDateTime; AProtected: Boolean): TAlgosimTypedStructure;
begin
  Result := stVariableMetadata.New(
    [
      sm('name', ASO(AName)),
      sm('description', ASO(ADescription)),
      sm('created', ASODateTime(ACreated)),
      sm('protected', ASO(AProtected))
    ])
end;

function ASOMember(const AMember: TAlgosimStructure.TMemberRef): TAlgosimTypedStructure;
begin
  Result := stStructMember.New(
    [
      sm('name', ASO(AMember.Name)),
      sm('value', AMember.Value)
    ])
end;

function ASODate(const ADate: TDate): TAlgosimTypedStructure;
begin
  Result := stDate.New(
    [
      sm('year', ASOInt(YearOf(ADate))),
      sm('month', ASOInt(MonthOf(ADate), fsMonth)),
      sm('day', ASOInt(DayOfTheMonth(ADate)))
    ])
end;

function ASODate(const AYear, AMonth, ADay: Integer): TAlgosimTypedStructure;
begin
  Result := stDate.New(
    [
      sm('year', ASOInt(AYear)),
      sm('month', ASOInt(AMonth, fsMonth)),
      sm('day', ASOInt(ADay))
    ])
end;

function ASOTime(const ATime: TTime): TAlgosimTypedStructure;
begin
  Result := stTime.New(
    [
      sm('hour', ASOInt(HourOf(ATime))),
      sm('minute', ASOInt(MinuteOf(ATime))),
      sm('second', ASOInt(SecondOf(ATime))),
      sm('millisecond', ASOInt(MilliSecondOf(ATime)))
    ])
end;

function ASOTime(const AHour, AMinute, ASecond, AMillisecond: Integer): TAlgosimTypedStructure;
begin
  Result := stTime.New(
    [
      sm('hour', ASOInt(AHour)),
      sm('minute', ASOInt(AMinute)),
      sm('second', ASOInt(ASecond)),
      sm('millisecond', ASOInt(AMillisecond))
    ])
end;

function ASODateTime(const ADateTime: TDateTime): TAlgosimTypedStructure;
begin
  Result := stDateTime.New(
    [
      sm('date', ASODate(ADateTime)),
      sm('time', ASOTime(ADateTime))
    ])
end;

function ASODateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
  AMillisecond: Integer): TAlgosimTypedStructure; overload;
begin
  Result := stDateTime.New(
    [
      sm('date', ASODate(AYear, AMonth, ADay)),
      sm('time', ASOTime(AHour, AMinute, ASecond, AMillisecond))
    ])
end;

function ASORationalNumber(const ARationalNumber: TRationalNumber): TAlgosimTypedStructure;
begin
  Result := stRationalNumber.New(
    [
      sm('numerator', ASOInt(ARationalNumber.Numerator)),
      sm('denominator', ASOInt(ARationalNumber.Denominator))
    ])
end;

function ASOMatrixSize(const AMatrixSize: TMatrixSize): TAlgosimTypedStructure;
begin
  Result := stMatrixSize.New(
    [
      sm('rows', ASOInt(AMatrixSize.Rows)),
      sm('cols', ASOInt(AMatrixSize.Cols))
    ])
end;

function ASOSize(const ASize: TSize): TAlgosimTypedStructure;
begin
  Result := stMatrixSize.New(
    [
      sm('rows', ASOInt(ASize.cy)),
      sm('cols', ASOInt(ASize.cx))
    ])
end;

function ASOSize(ARows, ACols: Integer): TAlgosimTypedStructure;
begin
  Result := stMatrixSize.New(
    [
      sm('rows', ASOInt(ARows)),
      sm('cols', ASOInt(ACols))
    ])
end;

function ASORGB(const ARGB: TRGB): TAlgosimTypedStructure;
begin
  Result := stRGB.New(
    [
      sm('red', ASO(ARGB.Red)),
      sm('green', ASO(ARGB.Green)),
      sm('blue', ASO(ARGB.Blue))
    ])
end;

function ASOHSV(const AHSV: THSV): TAlgosimTypedStructure;
begin
  Result := stHSV.New(
    [
      sm('hue', ASO(AHSV.Hue)),
      sm('saturation', ASO(AHSV.Saturation)),
      sm('value', ASO(AHSV.Value))
    ])
end;

function ASOHSL(const AHSL: THSL): TAlgosimTypedStructure;
begin
  Result := stHSL.New(
    [
      sm('hue', ASO(AHSL.Hue)),
      sm('saturation', ASO(AHSL.Saturation)),
      sm('lightness', ASO(AHSL.Lightness))
    ])
end;

function ASOToRationalNumber(AObject: TAlgosimObject): TRationalNumber;
var
  AStruct: TAlgosimTypedStructure absolute AObject;
begin
  if stRationalNumber.MatchingName(AObject) then
  begin
    Result.Numerator := AStruct.Values['numerator'].ToASI;
    Result.Denominator := AStruct.Values['denominator'].ToASI;
  end
  else
    raise Exception.Create('Invalid rational number structure.');
end;

function ASOToDateTime(AObject: TAlgosimObject): TDateTime;
var
  AStruct: TAlgosimTypedStructure absolute AObject;
  D, T: TAlgosimTypedStructure;
begin

  if stDateTime.MatchingName(AObject) then
  begin
    D := AStruct.Values['date'] as TAlgosimTypedStructure;
    if not stDate.MatchingName(D) then
      raise Exception.Create('Invalid date structure.');
    T := AStruct.Values['time'] as TAlgosimTypedStructure;
    if not stTime.MatchingName(T) then
      raise Exception.Create('Invalid time structure.');
    Result := EncodeDateTime(
      D.Values['year'].ToASI,
      D.Values['month'].ToASI,
      D.Values['day'].ToASI,
      T.Values['hour'].ToASI,
      T.Values['minute'].ToASI,
      T.Values['second'].ToASI,
      T.Values['millisecond'].ToASI
    )
  end
  else if stDate.MatchingName(AObject) then
  begin
    D := AStruct;
    Result := EncodeDate(
      D.Values['year'].ToASI,
      D.Values['month'].ToASI,
      D.Values['day'].ToASI
    )
  end
  else if stTime.MatchingName(AObject) then
  begin
    T := AStruct;
    Result := EncodeTime(
      T.Values['hour'].ToASI,
      T.Values['minute'].ToASI,
      T.Values['second'].ToASI,
      T.Values['millisecond'].ToASI
    )
  end
  else
    raise Exception.Create('Invalid datetime structure.');

end;

function ASOToDateTimeFree(AObject: TAlgosimObject): TDateTime;
begin
  try
    Result := ASOToDateTime(AObject);
  finally
    AObject.Free;
  end;
end;

function ASOToIntRange(AObject: TAlgosimObject): TRange;
var
  AStruct: TAlgosimTypedStructure absolute AObject;
begin
  if stIntRange.MatchingName(AObject) then
  begin
    Result.From := AStruct.Values['from'].ToInt32;
    Result.&To := AStruct.Values['to'].ToInt32;
    if AStruct.HasMember('step') then
      Result.Step := AStruct.Values['step'].ToInt32
    else
      Result.Step := 1;
  end
  else
    raise Exception.Create('Invalid integer range structure.');
end;

function ASOToColor(AObject: TAlgosimObject): TRGB;
var
  AStruct: TAlgosimTypedStructure absolute AObject;
begin
  if stRGB.MatchingName(AObject) then
    Result := TRGB.Create(
      AStruct['red'].ToRealNumber,
      AStruct['green'].ToRealNumber,
      AStruct['blue'].ToRealNumber
    )
  else if stHSV.MatchingName(AObject) then
    Result := TRGB(THSV.Create(
      AStruct['hue'].ToRealNumber,
      AStruct['saturation'].ToRealNumber,
      AStruct['value'].ToRealNumber
    ))
  else if stHSL.MatchingName(AObject) then
    Result := TRGB(THSL.Create(
      AStruct['hue'].ToRealNumber,
      AStruct['saturation'].ToRealNumber,
      AStruct['lightness'].ToRealNumber
    ))
  else
    raise Exception.Create('Invalid colour coordinates structure.');
end;

function ASONamedColor(const AName: string; const AColor: TColor): TAlgosimTypedStructure;
begin
  Result := stNamedColor.New(
    [
      sm('name', ASO(AName)),
      sm('color', TAlgosimColor.CreateWithValue(AColor))
    ])
end;

function ASOIntRect(ALeft, ATop, AWidth, AHeight: Integer): TAlgosimTypedStructure;
begin
  Result := stIntRect.New(
    [
      sm('left', ASOInt(ALeft)),
      sm('top', ASOInt(ATop)),
      sm('width', ASOInt(AWidth)),
      sm('height', ASOInt(AHeight))
    ])
end;

function ASOIntRect(const ARect: TRect): TAlgosimTypedStructure;
begin
  Result := ASOIntRect(ARect.Left, ARect.Top, ARect.Width, ARect.Height);
end;

function ASOIntPoint(X, Y: Integer): TAlgosimTypedStructure;
begin
  Result := stIntPoint.New(
    [
      sm('x', ASOInt(X)),
      sm('y', ASOInt(Y))
    ])
end;

function ASOIntPoint(const APoint: TPoint): TAlgosimTypedStructure;
begin
  Result := ASOIntPoint(APoint.X, APoint.Y);
end;

function ASOIntRange(AFrom, ATo: integer; AStep: Integer = 1): TAlgosimTypedStructure;
begin
  Result := stIntRange.New(
    [
      sm('from', ASOInt(AFrom)),
      sm('to', ASOInt(ATo)),
      sm('step', ASOInt(AStep))
    ])
end;

function ASOErrorInfo(const AReason: string; const ACallStack: array of TClass): TAlgosimTypedStructure;
var
  Source: string;
begin
  if Length(ACallStack) > 0 then
    Source := ASExpression.NodeName(ACallStack[0]);
  Result := stErrorInfo.New(
    [
      sm('reason', ASO(AReason)),
      sm('source', ASO(Source)),
      sm('stack', TAlgosimArray.CreateWithValue(ASExpression.NodeNames(ACallStack)))
    ]
  )
end;

function ASOOpData(ASymbol: Char; const AKind: string; APrecedence: Integer;
  const AAssociativity: string; AFunction: TClass;
  AListLeft, AListRight, ACollapse: Boolean): TAlgosimTypedStructure;
begin
  if (AFunction = nil) or not AFunction.InheritsFrom(TASFunction) then
    raise Exception.Create('Invalid operator function.');
  Result := stOpData.New(
    [
      sm('symbol', ASO(ASymbol)),
      sm('kind', ASO(AKind)),
      sm('precedence', ASOInt(APrecedence)),
      sm('associativity', ASO(AAssociativity)),
      sm('function', TKernelFunctionObj.Create(TASFunctionClass(AFunction))),
      sm('ListLeft', ASO(AListLeft)),
      sm('ListRight', ASO(AListRight)),
      sm('collapse', ASO(ACollapse))
    ]
  )
end;

function ASOVersionData(const AVersionData: TVersionData): TAlgosimTypedStructure;
begin
  Result := stVersionData.New(
    [
      sm('major', ASOInt(AVersionData.Major)),
      sm('minor', ASOInt(AVersionData.Minor)),
      sm('release', ASOInt(AVersionData.Release)),
      sm('build', ASOInt(AVersionData.Build))
    ]
  )
end;

function ASOCmdHistItem(const ACmd: string; const ATime: TDateTime;
  const AEvalTime: Double; AResult: TAlgosimObject): TAlgosimTypedStructure;
begin
  if AResult = nil then
    AResult := ASO(null);
  try
    Result := stCmdHistItem.New(
      [
        sm('cmd', ASO(ACmd)),
        sm('time', ASODateTime(ATime)),
        sm('EvalTime', ASO(AEvalTime)),
        sm('result', AResult)
      ]
    )
  except
    AResult.Free;
    raise;
  end;
end;

function ASOVisObject(const ID: TGUID; const AName, AType, ARealm, ATitle,
  ADescription: string): TAlgosimTypedStructure;
begin
  Result := stVisObj.New(
   [
    sm('ID', ASO(ID.ToString)),
    sm('name', ASO(AName)),
    sm('type', ASO(AType)),
    sm('realm', ASO(ARealm)),
    sm('title', ASO(ATitle)),
    sm('description', ASO(ADescription))
   ]
  )
end;

{ TStructTypeManager }

class constructor TStructTypeManager.Create;
begin

  StructDict := TObjectDictionary<string, TAlgosimStructureType>.Create([doOwnsValues]);

  StructTypes[stDate] := def('Date',
    [
      sm('year', ASOInt(0)),
      sm('month', ASOInt(0)),
      sm('day', ASOInt(0))
    ]);

  StructTypes[stTime] := def('Time',
    [
      sm('hour', ASOInt(0)),
      sm('minute', ASOInt(0)),
      sm('second', ASOInt(0)),
      sm('millisecond', ASOInt(0))
    ]);

  StructTypes[stDateTime] := def('DateTime',
    [
      sm('date', StructTypes[stDate].New),
      sm('time', StructTypes[stTime].New)
    ]);

  StructTypes[stRGB] := def('RGB',
    [
      sm('red', ASO(1)),
      sm('green', ASO(0)),
      sm('blue', ASO(0))
    ]);

  StructTypes[stHSV] := def('HSV',
    [
      sm('hue', ASO(0)),
      sm('saturation', ASO(1)),
      sm('value', ASO(1))
    ]);

  StructTypes[stHSL] := def('HSL',
    [
      sm('hue', ASO(0)),
      sm('saturation', ASO(1)),
      sm('lightness', ASO(0.5))
    ]);

  StructTypes[stStructMember] := def('StructMember',
    [
      sm('name', ASO('')),
      sm('value', ASO(null))
    ]);

  StructTypes[stVariable] := def('Variable',
    [
      sm('name', ASO('')),
      sm('description', ASO('')),
      sm('created', StructTypes[stDateTime].New),
      sm('value', ASO(null)),
      sm('protected', ASO(False))
    ]);

  StructTypes[stVariableMetadata] := def('VariableMetadata',
    [
      sm('name', ASO('')),
      sm('description', ASO('')),
      sm('created', StructTypes[stDateTime].New),
      sm('protected', ASO(False))
    ]);

  StructTypes[stRationalNumber] := def('RationalNumber',
    [
      sm('numerator', ASOInt(1)),
      sm('denominator', ASOInt(1))
    ]);

  StructTypes[stMatrixSize] := def('MatrixSize',
    [
      sm('rows', ASOInt(1)),
      sm('cols', ASOInt(1))
    ]);

  StructTypes[stNamedColor] := def('NamedColor',
    [
      sm('name', ASO('')),
      sm('color', TAlgosimColor.CreateWithValue(TRGB.Create(0, 0, 0)))
    ]);

  StructTypes[stIntRect] := def('IntRect',
    [
      sm('left', ASOInt(0)),
      sm('top', ASOInt(0)),
      sm('width', ASOInt(0)),
      sm('height', ASOInt(0))
    ]);

  StructTypes[stIntPoint] := def('IntPoint',
    [
      sm('x', ASOInt(0)),
      sm('y', ASOInt(0))
    ]);

  StructTypes[stIntRange] := def('IntRange',
    [
      sm('from', ASOInt(0)),
      sm('to', ASOInt(0)),
      sm('step', ASOInt(1))
    ]);

  StructTypes[stErrorInfo] := def('ErrorInfo',
    [
      sm('reason', ASO('')),
      sm('source', ASO('')),
      sm('stack', TAlgosimArray.Create)
    ]);

  StructTypes[stOpData] := def('OpData',
    [
      sm('symbol', ASO('')),
      sm('kind', ASO('')),
      sm('precedence', ASO('')),
      sm('associativity', ASOInt(0)),
      sm('function', ASO(null)),
      sm('ListLeft', ASO(False)),
      sm('ListRight', ASO(False)),
      sm('collapse', ASO(False))
    ]);

  StructTypes[stVersionData] := def('VersionData',
    [
      sm('major', ASOInt(0)),
      sm('minor', ASOInt(0)),
      sm('release', ASOInt(0)),
      sm('build', ASOInt(0))
    ]);

  StructTypes[stCmdHistItem] := def('HistoryItem',
    [
      sm('cmd', ASO('')),
      sm('time', StructTypes[stDateTime].New),
      sm('EvalTime', ASO(0.0)),
      sm('result', ASO(null))
    ]);

  StructTypes[stVisObj] := def('VisualObject',
    [
      sm('ID', ASO('')),
      sm('name', ASO('')),
      sm('type', ASO('')),
      sm('realm', ASO('')),
      sm('title', ASO('')),
      sm('description', ASO(''))
    ]);

end;

class destructor TStructTypeManager.Destroy;
var
  st: TStructType;
begin
  for st := Low(TStructType) to High(TStructType) do
    StructTypes[st] := nil;
  FreeAndNil(StructDict);
end;

class function TStructTypeManager.def(const AName: string;
  const AMembers: array of TAlgosimStructure.TMemberRef): TAlgosimStructureType;
begin
  Result := TAlgosimKernelStructureType.CreateWithValue(AMembers);
  Result.Name := AName;
  StructDict.Add(AName, Result);
end;

{ TStructTypeHelper }

function TStructTypeHelper.MatchingName(AStruct: TAlgosimStructure): Boolean;
begin
  Result := (AStruct is TAlgosimTypedStructure) and
    (TAlgosimTypedStructure(AStruct).StructureTypeName = Self.Name);
end;

class function TStructTypeHelper.FromString(const AName: string): TStructType;
var
  i: TStructType;
begin
  for i := Low(TStructType) to High(TStructType) do
    if i.Name = AName then
      Exit(i);
  raise EStructureException.CreateFmt(SUnknownStructType, [AName]);
end;

function TStructTypeHelper.MatchingName(AObject: TAlgosimObject): Boolean;
begin
  Result := (AObject is TAlgosimTypedStructure) and
    (TAlgosimTypedStructure(AObject).StructureTypeName = Self.Name);
end;

function TStructTypeHelper.Name: string;
begin
  Result := TStructTypeManager.StructTypes[Self].Name;
end;

function TStructTypeHelper.New(
  const AMembers: array of TAlgosimStructure.TMemberRef): TAlgosimTypedStructure;
begin
  Result := TStructTypeManager.StructTypes[Self].New(AMembers);
end;

function TStructTypeHelper.New: TAlgosimTypedStructure;
begin
  Result := TStructTypeManager.StructTypes[Self].New;
end;

function TStructTypeHelper.CreateTypeObject: TAlgosimStructureType;
begin
  Result := TAlgosimStructureType.Create(TStructTypeManager.StructTypes[Self]);
end;

function TStructTypeHelper.New(
  const AValues: array of TAlgosimObject): TAlgosimTypedStructure;
begin
  Result := TStructTypeManager.StructTypes[Self].New(AValues);
end;

function TStructTypeHelper.ValidateAgainst(AStruct: TAlgosimStructure): Boolean;
begin
  Result := AStruct.ValidateAgainst(TStructTypeManager.StructTypes[Self])
end;

function TStructTypeHelper.ValidateAgainst(AObject: TAlgosimObject): Boolean;
begin
  Result := (AObject is TAlgosimStructure) and Self.ValidateAgainst(TAlgosimStructure(AObject));
end;

function FPCWStructure(AFPCW: Word): TAlgosimStructure;
begin

  var LComment := '';
  case AFPCW and $1F3F of
    $1332:
      LComment := 'RTL default';
    $133F:
      LComment := 'Platform default';
  end;

  var LExceptionMask := TArithmeticExceptionMask(Byte(AFPCW and $3F));
  Result := TAlgosimStructure.CreateWithValue(
    [
      sm('ControlWord', ASOInt(AFPCW, 16)),
      sm('comment', ASO(LComment)),
      sm('InvalidOp', ASO(exInvalidOp in LExceptionMask)),
      sm('Denormalized', ASO(exDenormalized in LExceptionMask)),
      sm('ZeroDivide', ASO(exZeroDivide in LExceptionMask)),
      sm('Overflow', ASO(exOverflow in LExceptionMask)),
      sm('Underflow', ASO(exUnderflow in LExceptionMask)),
      sm('Precision', ASO(exPrecision in LExceptionMask))
    ]
  )
end;

end.