fpc/utils/unicode/cldrhelper.pas

{   CLDR collation helper unit.

    Copyright (c) 2013-2015 by Inoussa OUEDRAOGO

    The source code is distributed under the Library GNU
    General Public License with the following modification:

        - object files and libraries linked into an application may be
          distributed without source code.

    If you didn't receive a copy of the file COPYING, contact:
          Free Software Foundation
          675 Mass Ave
          Cambridge, MA  02139
          USA

    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.
}

unit cldrhelper;

{$mode delphi}
{$H+}
{$PACKENUM 1}
{$modeswitch advancedrecords}
{$scopedenums on}
{$typedaddress on}
{$POINTERMATH on}

{$macro on}
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  {$define X_PACKED:=}
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
  {$define X_PACKED:=packed}
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}

interface

uses
  SysUtils, Classes, helper;

const
  COLLATION_FILE_PREFIX = 'collation_';

  COLLATION_ITEM_SEARCH = 'search';
  COLLATION_ITEM_STD = 'standard';
  COLLATION_ITEM_DEFAULT = COLLATION_ITEM_STD;

type
  TAliasRec = record
    Name  : UTF8String;
    Alias : UTF8String;
  end;
const
  BCP47_COLLATION_TYPE_ALIAS : array[0..3] of TAliasRec = (
    (Name : 'dict'; Alias : 'dictionary'),
    (Name : 'gb2312'; Alias : 'gb2312han'),
    (Name : 'phonebk'; Alias : 'phonebook'),
    (Name : 'trad'; Alias : 'traditional')
  );

type

  TUCA_LineRecArray = array of TUCA_LineRec;

  ECldrException = class(Exception)
  end;

  TReorderWeigthKind = (
    Primary, Secondary, Tertiary, Identity, Deletion
  );
  TReorderWeigthKinds = set of TReorderWeigthKind;
  TReorderLogicalReset = (
    None,// FirstVariable, LastVariable,
    FirstTertiaryIgnorable, LastTertiaryIgnorable,
    FirstSecondaryIgnorable, LastSecondaryIgnorable,
    FirstPrimaryIgnorable, LastPrimaryIgnorable,
    LastRegular,
    FirstNonIgnorable, LastNonIgnorable,
    FirstTrailing, LastTrailing
  );
const
  FixableReorderLogicalSet = [
    TReorderLogicalReset.LastRegular,TReorderLogicalReset.FirstTrailing,
    TReorderLogicalReset.LastTrailing
  ];

type
  TCollationField = (
    BackWards, VariableLowLimit, VariableHighLimit, Alternate, Normalization,
    Strength
  );
  TCollationFields = set of TCollationField;

  PReorderUnit = ^TReorderUnit;

  { TReorderUnit }

  TReorderUnit = X_PACKED record
  private
    FVirtualPosition : TReorderLogicalReset;
  public
    Context         : TUnicodeCodePointArray;
    ExpansionChars  : TUnicodeCodePointArray;
    Characters      : TUnicodeCodePointArray;
    WeigthKind      : TReorderWeigthKind;
    InitialPosition : Integer;
    Changed         : Boolean;
  public
    property VirtualPosition : TReorderLogicalReset read FVirtualPosition;
    function IsVirtual() : Boolean;inline;
  public
    class function From(
      const AChars,
            AContext         : array of TUnicodeCodePoint;
      const AWeigthKind      : TReorderWeigthKind;
      const AInitialPosition : Integer
    ) : TReorderUnit;static;overload;
    class function From(
      const AChars           : array of TUnicodeCodePoint;
      const AWeigthKind      : TReorderWeigthKind;
      const AInitialPosition : Integer
    ) : TReorderUnit;static;overload;
    class function From(
      const AChar            : TUnicodeCodePoint;
      const AWeigthKind      : TReorderWeigthKind;
      const AInitialPosition : Integer
    ) : TReorderUnit;static;overload;
    class function From(
      const AChar            : TUnicodeCodePoint;
      const AContext         : array of TUnicodeCodePoint;
      const AWeigthKind      : TReorderWeigthKind;
      const AInitialPosition : Integer
    ) : TReorderUnit;static;overload;
    class function From(
      const AReset : TReorderLogicalReset
    ) : TReorderUnit;static;overload;
    procedure SetExpansion(const AChars : array of TUnicodeCodePoint);overload;
    procedure SetExpansion(const AChar : TUnicodeCodePoint);overload;
    procedure Clear();
    procedure Assign(const AItem : PReorderUnit);
    function HasContext() : Boolean;
    function IsExpansion() : Boolean;
  end;


  PReorderSequence = ^TReorderSequence;

  { TReorderSequence }

  TReorderSequence = X_PACKED record
  public
    Reset           : array of TUnicodeCodePoint;
    Elements        : array of TReorderUnit;
    LogicalPosition : TReorderLogicalReset;
    Before          : Boolean;
  public
    procedure Clear();
    procedure SetElementCount(const ALength : Integer);
    procedure Assign(ASource : PReorderSequence);
  end;
  TReorderSequenceArray = array of TReorderSequence;

  { TOrderedCharacters }

  TOrderedCharacters = record
  private
    FActualLength : Integer;
  private
    procedure EnsureSize(const AMinSize : Integer);
  public
    Data : array of TReorderUnit;
    property ActualLength : Integer read FActualLength;

  public
    class function Create(const ACapacity : Integer) : TOrderedCharacters;static;overload;
    class function Create() : TOrderedCharacters;static;overload;
    procedure Clear();
    function Clone() : TOrderedCharacters;
    function Insert(const AItem : TReorderUnit; const ADestPos : Integer) : Integer;
    function Append(const AItem : TReorderUnit) : Integer;
    procedure Delete(const AIndex : Integer);

    procedure ApplyStatement(const AStatement : PReorderSequence);
  end;
  POrderedCharacters = ^TOrderedCharacters;

  { TCldrImport }

  TCldrImport = class
  private
    FSource: string;
    FTypeName: string;
  public
    property Source : string read FSource;
    property TypeName : string read FTypeName;
  end;

  { TCldrImportList }

  TCldrImportList = class
  private
    FItems : array of TCldrImport;
  private
    function GetCount: Integer;
    function GetItem(AIndex : Integer): TCldrImport;
  public
    destructor Destroy();override;
    procedure Clear();
    function IndexOf(const ASource, AType : string) : Integer;
    function Find(const ASource, AType : string) : TCldrImport;
    function Add(const ASource, AType : string) : TCldrImport;
    property Count : Integer read GetCount;
    property Item[AIndex : Integer] : TCldrImport read GetItem;default;
  end;


  TComparisonStrength = (
    Primary, Secondary, Tertiary, Quaternary, Identity
  );

  TSettingOption = (
    Unknown, Strength, Alternate, Backwards, Normalization, CaseLevel, CaseFirst,
    HiraganaQ, NumericOrdering, Reorder, MaxVariable, Import,
    SuppressContractions, Optimize
  );
  PSettingRec = ^TSettingRec;

  { TSettingRec }

  TSettingRec = record
  public
    Name   : UTF8String;
    Values : array of UTF8String;
    OptionValue : TSettingOption;
    Understood : Boolean;
  public
    class function From(
      const AName   : UTF8String;
      const AValues : array of UTF8String;
      const AOption : TSettingOption
    ) : TSettingRec;static;
    procedure Assign(const AItem : PSettingRec);
    procedure Clear();
  end;
  TSettingRecArray = array of TSettingRec;

  TCldrCollation = class;

  TCldrParserMode = (HeaderParsing, FullParsing);

  { TCldrCollationItem }

  TCldrCollationItem = class
  private
    FAlt: string;
    FBackwards: Boolean;
    FBase: string;
    FChangedFields: TCollationFields;
    FImports: TCldrImportList;
    FMode : TCldrParserMode;
    FNormalization : Boolean;
    FParent: TCldrCollation;
    FRules: TReorderSequenceArray;
    FSettings : TSettingRecArray;
    FStrength : TComparisonStrength;
    FTypeName: string;
    FVariableWeight : TUCA_VariableKind;
  public
    class function FindAlias(const AName : UTF8String) : UTF8String;static;
    constructor Create();
    destructor Destroy;override;
    procedure Clear();
    function IsPrivate() : Boolean;
    property Mode : TCldrParserMode read FMode write FMode;
    property Parent : TCldrCollation read FParent;
    property TypeName : string read FTypeName write FTypeName;
    property Alt : string read FAlt write FAlt;
    property Base : string read FBase write FBase;
    property Backwards : Boolean read FBackwards write FBackwards;
    property Rules : TReorderSequenceArray read FRules write FRules;
    property ChangedFields : TCollationFields read FChangedFields write FChangedFields;
    property Imports : TCldrImportList read FImports;
    property Settings : TSettingRecArray read FSettings write FSettings;
    property VariableWeight : TUCA_VariableKind read FVariableWeight write FVariableWeight;
    property Normalization : Boolean read FNormalization write FNormalization;
    property Strength : TComparisonStrength read FStrength write FStrength;
  end;

  TCldrCollationRepository = class;

  { TCldrCollation }

  TCldrCollation = class
  private
    FItems : array of TCldrCollationItem;
    FLocalID: string;
    FDefaultType: string;
    FVersion: string;
    FLanguage: string;
    FMode: TCldrParserMode;
    FRepository: TCldrCollationRepository;
  private
    function GetItem(Index : Integer): TCldrCollationItem;
    function GetItemCount: Integer;
  public
    destructor Destroy();override;
    procedure Clear();
    function IndexOf(const AItemName : string) : Integer;overload;
    function IndexOf(const AItemName, AItemAlt : string) : Integer;overload;
    function Find(const AItemName : string) : TCldrCollationItem;overload;
    function Find(const AItemName, AItemAlt : string) : TCldrCollationItem;overload;
    function Add(AItem : TCldrCollationItem) : Integer;
    function FindPublicItemCount() : Integer;
    property Language : string read FLanguage write FLanguage;
    property LocalID : string read FLocalID write FLocalID;
    property Version : string read FVersion write FVersion;
    property DefaultType : string read FDefaultType write FDefaultType;
    property ItemCount : Integer read GetItemCount;
    property Items[Index : Integer] : TCldrCollationItem read GetItem;
    property Mode : TCldrParserMode read FMode write FMode;
    property Repository : TCldrCollationRepository read FRepository;
  end;

  ICldrCollationLoader = interface
    ['{117AAC84-06CE-4EC8-9B07-4E81EC23930C}']
    procedure LoadCollation(
      const ALanguage  : string;
            ACollation : TCldrCollation;
            AMode      : TCldrParserMode
    );
    procedure LoadCollationType(
      const ALanguage,
            ATypeName : string;
            AType     : TCldrCollationItem
    );
  end;

  { TCldrCollationRepository }

  TCldrCollationRepository = class
  private
    FItems : array of TCldrCollation;
    FLoader: ICldrCollationLoader;
  private
    function GetItem(const AIndex : Integer): TCldrCollation;
    function GetItemCount: Integer;
    function IndexOfItem(AItem : TCldrCollation) : Integer;
    procedure Add(AItem : TCldrCollation);
  public
    constructor Create(ALoader : ICldrCollationLoader);
    destructor Destroy;override;
    procedure FreeItems();
    procedure Clear();
    procedure SetLoader(AValue : ICldrCollationLoader);
    function IndexOf(const ALanguage : string) : Integer;
    function Find(const ALanguage : string) : TCldrCollation;
    function Load(const ALanguage : string; const AMode : TCldrParserMode) : TCldrCollation;
    function LoadType(const ALanguage, AType, ATypeALT : string) : TCldrCollationItem;
    property ItemCount : Integer read GetItemCount;
    property Items[const AIndex : Integer] : TCldrCollation read GetItem;
    property Loader : ICldrCollationLoader read FLoader;
  end;

  TRuleVisiterFunction =
    function(
      ARule  : PReorderSequence;
      AOwner : TCldrCollationItem;
      AData  : Pointer
    ) : Boolean;

  function ForEachRule(
    ACollationType : TCldrCollationItem;
    AVisitFunc     : TRuleVisiterFunction;
    ACustomData    : Pointer
  ) : Boolean;

  function ComputeWeigths(
    const AData        : PReorderUnit;
    const ADataLen     : Integer;
    const ADataWeigths : TUCA_LineRecArray;
      out AResult      : TUCA_LineRecArray
  ) : Integer;
  function FindCollationDefaultItemName(ACollation : TCldrCollation) : string;
  procedure GenerateCdlrCollation(
    ACollation                : TCldrCollation;
    AItemName                 : string;
    AStoreName                : string;
    AStream,
    ANativeEndianStream,
    AOtherEndianStream,
    ABinaryNativeEndianStream,
    ABinaryOtherEndianStream  : TStream;
    ARootChars                : TOrderedCharacters;
    ARootWeigths              : TUCA_LineRecArray
  );

  procedure GenerateUCA_CLDR_Head(
    ADest  : TStream;
    ABook  : PUCA_DataBook;
    AProps : PUCA_PropBook;
    ACollation : TCldrCollationItem
  );

  function FillInitialPositions(
          AData        : PReorderUnit;
    const ADataLen     : Integer;
    const ADataWeigths : TUCA_LineRecArray
  ) : Integer;

  function IndexOf(
    const APattern        : array of TUnicodeCodePoint;
    const APatternContext : array of TUnicodeCodePoint;
    const ASequence       : PReorderUnit;
    const ASequenceLength : Integer
  ) : Integer;overload;

  function TryStrToLogicalReorder(
    const AValue  : string;
    out   AResult : TReorderLogicalReset
  ) : Boolean;


resourcestring
  sCaseNothandled = 'This case is not handled : "%s", Position = %d.';
  sCodePointExpected = 'Code Point node expected as child at this position "%d".';
  sCollationsExistsAlready = 'This collation already exists : "%s"';
  sCollationsNodeNotFound = '"collations" node not found.';
  sCollationTypeNotFound = 'collation "Type" not found : "%s".';
  sHexAttributeExpected = '"hex" attribute expected at this position "%d".';
  sInvalidAlternateStatement = 'Invalid "Alternate" statement, only one option is permit by statement :"%s".';
  sInvalidBackwardsStatement = 'Invalid "Backwards" statement, only one level is permit by statement :"%s".';
  sInvalidImportStatement = 'Invalid "Import" statement, only one collation is permit by statement :"%s".';
  sInvalidNormalizationStatement = 'Invalid "Normalization" statement, only one option is permit by statement :"%s".';
  sInvalidResetClause = 'Invalid "Reset" clause.';
  sInvalidSettingExpression = 'Invalid Setting expression, Line : "%s".';
  sInvalidSettingValue = 'Invalid Setting value, Setting : "%s", Value : "%s".';
  sInvalidStrengthStatement = 'Invalid "Strength" statement, only one option is permit by statement :"%s".';
  sInvalidSuppressContractionsStatement = 'Invalid "SuppressContractions" statement, only one UnicodeSet is permit by statement :"%s".';
  sInvalidUnicodeSetExpression = 'Invalid Unicode Set expression, Line : "%s".';
  sLoaderNotSet = 'The Repository''s Loader is not set.';
  sNodeNameAssertMessage = 'Expected NodeName "%s", got "%s".';
  sRepositoryNotSet = 'The Repository is not set.';
  sRulesNodeNotFound = '"rules" node not found.';
  sSpecialCharacterExpected = 'Special character expected but found "%s", line = "%s".';
  sTextNodeChildExpected = '(Child) text node expected at this position "%d", but got "%s".';
  sUnexpectedConditionsFailure = 'Unexpected conditions failure.';
  sUniqueChildNodeExpected = 'Unique child node expected at this position "%d".';
  sUnknownResetLogicalPosition = 'Unknown reset logical position : "%s".';
  sVirtualIsReadOnly = 'Virtual logical "Reset" items are read only.';

implementation
uses
  RtlConsts, typinfo;

function TryStrToLogicalReorder(
  const AValue  : string;
  out   AResult : TReorderLogicalReset
) : Boolean;
var
  s : string;
  i : Integer;
begin
  s := StringReplace(AValue,' ','',[rfReplaceAll]);
  s := StringReplace(s,'_','',[rfReplaceAll]);
  i := GetEnumValue(TypeInfo(TReorderLogicalReset),s);
  Result := (i > -1);
  if Result then
    AResult := TReorderLogicalReset(i);
end;

function ToStr(const ACharacters : array of TUnicodeCodePoint): string;overload;
var
  i : Integer;
begin
  Result := '';
  for i := Low(ACharacters) to High(ACharacters) do begin
    if (ACharacters[i] > $FFFF) then
      Result := Result + ' ' + IntToHex(ACharacters[i],5)
    else
      Result := Result + ' ' + IntToHex(ACharacters[i],4);
  end;
  Result := Trim(Result);
end;

function ToStr(const AWeights : array of TUCA_WeightRec): string;overload;
var
  i : Integer;
  p : ^TUCA_WeightRec;
begin
  Result := '';
  p := @AWeights[Low(AWeights)];
  for i := 1 to Length(AWeights) do begin
    Result :=
      Format('%s {%s %s %s %s}',
        [ Result,IntToHex(p^.Weights[0],4),IntToHex(p^.Weights[1],4),
          IntToHex(p^.Weights[2],4), IntToHex(p^.Weights[3],4)
        ]
      );
    Inc(p);
  end;
  Result := Trim(Result);
end;

function IsZero(AItems : TUCA_WeightRecArray) : Boolean;
const ZERO_ITEM  : TUCA_WeightRec = (
        Weights  : (0,0,0,0);
        Variable : False;
      );
var
  c, i : Integer;
begin
  c := Length(AItems);
  if (c < 1) then
    exit(True);
  Result := (AItems[0] = ZERO_ITEM);{
  for i := 0 to c-1 do begin
    if (AItems[i] <> ZERO_ITEM) then
      exit(False);
  end;
  Result := True;}
end;

function IndexOf(
  const APattern        : array of TUnicodeCodePoint;
  const APatternContext : array of TUnicodeCodePoint;
  const ASequence       : PReorderUnit;
  const ASequenceLength : Integer
) : Integer;
var
  i, lp, sizep, lengthContext, sizeContext : Integer;
  p : PReorderUnit;
begin
  Result := -1;
  if (ASequenceLength = 0) then
    exit;
  lp := Length(APattern);
  if (lp = 0) then
    exit;
  sizep := lp*SizeOf(TUnicodeCodePoint);
  lengthContext := Length(APatternContext);
  sizeContext := lengthContext*SizeOf(TUnicodeCodePoint);
  p := ASequence;
  for i := 0 to ASequenceLength - 1 do begin
    if (Length(p^.Characters) = lp) then begin
      if CompareMem(@APattern[0],@p^.Characters[0],sizep) then begin
        if (Length(p^.Context) = lengthContext) and
           ( (lengthContext = 0) or
             CompareMem(@p^.Context[0],@APatternContext[0],sizeContext)
           )
        then begin
          Result := i;
          Break;
        end;
      end;
    end;
    Inc(p);
  end;
end;

{procedure ApplyStatementToSequence(
  var   ASequence  : TOrderedCharacters;
  const AStatement : PReorderSequence;
  const AStatementCount : Integer
);
var
  pse, pd : PReorderUnit;
  kr : Integer;

  function GetNextInsertPos() : Integer;
  var
    kk : Integer;
  begin
    if (pse^.WeigthKind = rwkDeletion) then
      exit(0);
    if (pse^.WeigthKind = rwkIdentity) then
      exit(kr + 1);
    kk := kr + 1;
    pd := @ASequence.Data[kk];
    for kk := kk to ASequence.ActualLength - 1 do begin
      if (pd^.WeigthKind <= pse^.WeigthKind) then
        exit(kk);
      Inc(pd);
    end;
    Result := ASequence.ActualLength;
  end;

var
  locResetPos, i, k, h : Integer;
  pst : PReorderSequence;
begin
  pst := AStatement;
  for h := 0 to AStatementCount - 1 do begin
    locResetPos := -1;
    if (Length(pst^.Reset) > 0) then begin
      locResetPos := IndexOf(pst^.Reset,[],@ASequence.Data[0],ASequence.ActualLength);
      if (locResetPos = -1) then
        raise ECldrException.CreateFmt('Character(s) not found in sequence : "%s".',[ToStr(pst^.Reset)]);
    end;
    pse := @pst^.Elements[0];
    kr := locResetPos;
    k := GetNextInsertPos();
    for i := Low(pst^.Elements) to High(pst^.Elements) do begin
      k := ASequence.Insert(pse^,k)+1;
      Inc(pse);
    end;
    Inc(pst);
  end;
end;}
function FindLogicalPos(
  const ASequence  : POrderedCharacters;
  const APosition  : TReorderLogicalReset
) : Integer;
var
  i, c : Integer;
  p : PReorderUnit;
  firstPos, lastPos : Integer;
begin
  Result := 0;
  if (ASequence^.ActualLength = 0) then
    exit;
  p := @ASequence^.Data[0];
  c := ASequence^.ActualLength;
  if (APosition in FixableReorderLogicalSet) then begin
    for i := 0 to c - 1 do begin
      if (p^.VirtualPosition = APosition) then
        exit(i);
      Inc(p);
    end;
    p := @ASequence^.Data[0];
  end;
  if (APosition in [TReorderLogicalReset.FirstTertiaryIgnorable, TReorderLogicalReset.LastTertiaryIgnorable])
  then begin
    firstPos := -1;
    for i := 0 to c - 1 do begin
      if (p^.WeigthKind <= TReorderWeigthKind.Tertiary) then begin
        firstPos := i;
        Break;
      end;
      Inc(p);
    end;
    if (firstPos = -1) then
      exit(0);
    if (APosition = TReorderLogicalReset.FirstTertiaryIgnorable) then
      exit(firstPos);
    if (p^.WeigthKind < TReorderWeigthKind.Tertiary) then
      exit(firstPos);
    lastPos := -1;
    for i := firstPos + 1 to c - 1 do begin
      if (p^.WeigthKind <> TReorderWeigthKind.Identity) then begin
        lastPos := i;
        Break;
      end;
      Inc(p);
    end;
    if (lastPos = -1) then
      exit(c);
    exit(lastPos);
  end;
  if (APosition in [TReorderLogicalReset.FirstSecondaryIgnorable, TReorderLogicalReset.LastSecondaryIgnorable])
  then begin
    firstPos := -1;
    for i := 0 to c - 1 do begin
      if (p^.WeigthKind <= TReorderWeigthKind.Secondary) then begin
        firstPos := i;
        Break;
      end;
      Inc(p);
    end;
    if (firstPos = -1) then
      exit(0);
    if (APosition = TReorderLogicalReset.FirstSecondaryIgnorable) then
      exit(firstPos);
    if (p^.WeigthKind < TReorderWeigthKind.Secondary) then
      exit(firstPos);
    lastPos := -1;
    for i := firstPos + 1 to c - 1 do begin
      if (p^.WeigthKind <> TReorderWeigthKind.Identity) then begin
        lastPos := i;
        Break;
      end;
      Inc(p);
    end;
    if (lastPos = -1) then
      exit(c);
    exit(lastPos);
  end;
  if (APosition in [TReorderLogicalReset.FirstPrimaryIgnorable, TReorderLogicalReset.LastPrimaryIgnorable])
  then begin
    firstPos := -1;
    for i := 0 to c - 1 do begin
      if (p^.WeigthKind <= TReorderWeigthKind.Primary) then begin
        firstPos := i;
        Break;
      end;
      Inc(p);
    end;
    if (firstPos = -1) then
      exit(0);
    if (APosition = TReorderLogicalReset.FirstPrimaryIgnorable) then
      exit(firstPos);
    if (p^.WeigthKind < TReorderWeigthKind.Primary) then
      exit(firstPos);
    lastPos := -1;
    for i := firstPos + 1 to c - 1 do begin
      if (p^.WeigthKind <> TReorderWeigthKind.Identity) then begin
        lastPos := i;
        Break;
      end;
      Inc(p);
    end;
    if (lastPos = -1) then
      exit(c);
    exit(lastPos);
  end;
  if (APosition = TReorderLogicalReset.FirstNonIgnorable) then begin
    firstPos := -1;
    for i := 0 to c - 1 do begin
      if (p^.WeigthKind <= TReorderWeigthKind.Primary) then begin
        firstPos := i;
        Break;
      end;
      Inc(p);
    end;
    if (firstPos = -1) then
      exit(0);
    exit(firstPos);
  end;
  if (APosition in [TReorderLogicalReset.LastNonIgnorable,TReorderLogicalReset.LastRegular])
  then begin
    exit(c);
  end;
  for i := 0 to c - 1 do begin
    if (p^.VirtualPosition = APosition) then
      exit(i);
    Inc(p);
  end;
end;

procedure ApplyStatementToSequence(
  var   ASequence  : TOrderedCharacters;
  const AStatement : PReorderSequence;
  const AStatementCount : Integer
);
var
  pse, pd : PReorderUnit;
  kr : Integer;
  pst : PReorderSequence;

  function GetNextInsertPos() : Integer;
  var
    kk : Integer;
  begin
    if (pse^.WeigthKind = TReorderWeigthKind.Deletion) then
      exit(0);
    if (pse^.WeigthKind = TReorderWeigthKind.Identity) then
      exit(kr + 1);
    if not pst^.Before then begin
      kk := kr + 1;
      if (kk >= ASequence.ActualLength) then
        exit(kk);
      pd := @ASequence.Data[kk];
      for kk := kk to ASequence.ActualLength - 1 do begin
        if (pd^.WeigthKind <= pse^.WeigthKind) then
          exit(kk);
        Inc(pd);
      end;
      Result := ASequence.ActualLength;
    end else begin
      if (kr = 0) then
        exit(0);
      pd := @ASequence.Data[kr];
      if pd^.IsVirtual() and (pd^.VirtualPosition in FixableReorderLogicalSet) then begin
        kr := kr-1;
        if (kr = 0) then
          exit;
      end;
      kk := kr;
      pd := @ASequence.Data[kk];
      if (pd^.WeigthKind = TReorderWeigthKind.Primary) then begin
        pd^.WeigthKind := pse^.WeigthKind;
        pse^.WeigthKind := TReorderWeigthKind.Primary;
        exit(kk);
      end;
      for kk := kk downto 0 do begin
        if (pd^.WeigthKind = TReorderWeigthKind.Deletion) or (pd^.WeigthKind <= pse^.WeigthKind) then begin
          if (pd^.WeigthKind > pse^.WeigthKind) then
            pd^.WeigthKind := pse^.WeigthKind;
          exit(kk);
        end;
        Dec(pd);
      end;
      Result := 0;
    end;
  end;

var
  locResetPos, i, k, h : Integer;
begin
  if (Length(AStatement^.Elements) = 0) then
    exit;
  pst := AStatement;
  for h := 0 to AStatementCount - 1 do begin
    locResetPos := -1;
    if (pst^.LogicalPosition > TReorderLogicalReset.None) then
      locResetPos := FindLogicalPos(@ASequence,pst^.LogicalPosition)
    else if (Length(pst^.Reset) > 0) then begin
      locResetPos := IndexOf(pst^.Reset,[],@ASequence.Data[0],ASequence.ActualLength);
      {if (locResetPos = -1) then
        raise ECldrException.CreateFmt('Character(s) not found in sequence : "%s".',[ToStr(pst^.Reset)]);}
      if (locResetPos = -1) then
        locResetPos := ASequence.ActualLength;
    end;
    if (pst^.LogicalPosition in FixableReorderLogicalSet) then begin
      if (locResetPos < 0) or
         (locResetPos >= ASequence.ActualLength) or
         not(ASequence.Data[locResetPos].VirtualPosition in FixableReorderLogicalSet)
      then begin
        locResetPos := ASequence.Append(TReorderUnit.From(pst^.LogicalPosition));
      end;
    end;

    pse := @pst^.Elements[0];
    kr := locResetPos;
    k := GetNextInsertPos();
    for i := Low(pst^.Elements) to High(pst^.Elements) do begin
      k := ASequence.Insert(pse^,k)+1;
      Inc(pse);
    end;
    Inc(pst);
  end;
end;

type
  PUCA_WeightRecArray = ^TUCA_WeightRecArray;
  TUCASortKey = array of Word;

function SimpleFormKey(const ACEList : TUCA_WeightRecArray) : TUCASortKey;
var
  r : TUCASortKey;
  i, c, k, ral, levelCount : Integer;
  pce : ^TUCA_WeightRec;
begin
  c := Length(ACEList);
  if (c = 0) then
    exit(nil);
  //SetLength(r,((3+1{Level Separator})*c));
  levelCount := Length(ACEList[0].Weights);
  if (levelCount > 3) then
    levelCount := 3;
  SetLength(r,(levelCount*c + levelCount));
  ral := 0;
  for i := 0 to levelCount - 1 do begin
    for k := 0 to c - 1 do begin
      pce := @ACEList[k];
      if (pce^.Weights[i] <> 0) then begin
        r[ral] := pce^.Weights[i];
        ral := ral + 1;
      end;
      //pce := pce + 1;
    end;
    r[ral] := 0;
    ral := ral + 1;
  end;
  ral := ral - 1;
  SetLength(r,ral);
  Result := r;
end;

function CompareSortKey(const A, B : TUCASortKey) : Integer;
var
  i, hb : Integer;
begin
  if (Pointer(A) = Pointer(B)) then
    exit(0);
  Result := 1;
  hb := Length(B) - 1;
  for i := 0 to Length(A) - 1 do begin
    if (i > hb) then
      exit;
    if (A[i] < B[i]) then
      exit(-1);
    if (A[i] > B[i]) then
      exit(1);
  end;
  if (Length(A) = Length(B)) then
    exit(0);
  exit(-1);
end;

{function ComputeWeigths(
  const AData        : PReorderUnit;
  const ADataLen     : Integer;
  const ADataWeigths : TUCA_LineRecArray;
  out   AResult      : TUCA_LineRecArray
) : Integer;

  function GetWeigth(AItem : PReorderUnit) : PUCA_WeightRecArray;
  begin
    Result := nil;
    if (AItem^.InitialPosition < 1) or (AItem^.InitialPosition > Length(ADataWeigths)) then
      raise ECldrException.CreateFmt('Invalid "InitialPosition" value : %d.',[AItem^.InitialPosition]);
    Result := @ADataWeigths[(AItem^.InitialPosition-1)].Weights;
  end;

var
  c, i, ral : Integer;
  p, q : PReorderUnit;
  r : TUCA_LineRecArray;
  pr : PUCA_LineRec;
  pbase : PReorderUnit;
  pw, pwb : PUCA_WeightRecArray;
  cw, ki : Integer;
begin
  Result := 0;
  if (ADataLen < 1) then
    exit;
  c := ADataLen;
  ral := 0;
  SetLength(r,c);
  FillByte(r[0],(Length(r)*SizeOf(r[0])),0);
  q := nil;
  pbase := nil;
  p := AData+1;
  pr := @r[0];
  i := 1;
  while (i < c) do begin
    if p^.Changed then begin
      if (pbase = nil) then begin
        pbase := p - 1;
        pwb := GetWeigth(pbase);
      end;
      if (p^.WeigthKind = rwkIdentity) then begin
        pr^.CodePoints := Copy(p^.Characters);
        q := p - 1;
        if (q = pbase) then
          pw := pwb
        else
          pw := @((pr-1)^.Weights);
        pr^.Weights := Copy(pw^);
        Inc(pr);
        Inc(ral);
      end else begin
        pr^.CodePoints := Copy(p^.Characters);
        q := p - 1;
        if (q = pbase) then begin
          pw := pwb;
          cw := (Length(pw^)+1);
          SetLength(pr^.Weights,cw);
          Move(pw^[0],pr^.Weights[0],((cw-1)*SizeOf(pw^[0])));
          FillByte(pr^.Weights[(cw-1)],SizeOf(pr^.Weights[0]),0);
          ki := Ord(p^.WeigthKind);
          pr^.Weights[(cw-1)].Weights[ki] := pr^.Weights[(cw-2)].Weights[ki]+1;
        end else begin
          pw := @((pr-1)^.Weights);
          pr^.Weights := Copy(pw^);
          cw := Length(pr^.Weights);
          ki := Ord(p^.WeigthKind);
          for ki := Ord(rwkPrimary) to Ord(rwkTertiary) do begin
            if (ki < Ord(p^.WeigthKind)) then
              pr^.Weights[(cw-1)].Weights[ki] := pw^[(cw-1)].Weights[ki]
            else if (ki = Ord(p^.WeigthKind)) then begin
              if (pw^[(cw-1)].Weights[ki] = 0) then
                pr^.Weights[(cw-1)].Weights[ki] := pwb^[(Length(pwb^)-1)].Weights[ki]+1
              else
                pr^.Weights[(cw-1)].Weights[ki] := pw^[(cw-1)].Weights[ki]+1;
            end else begin
              pr^.Weights[(cw-1)].Weights[ki] := 0;
            end;
          end;
        end;
        Inc(pr);
        Inc(ral);
      end;
    end else begin
      pbase := nil;
      pwb := nil;
    end;
    Inc(p);
    Inc(i);
  end;
  SetLength(r,ral);
  AResult := r;
  Result := Length(AResult);
end;}
function IndexOf(
  const APattern : array of TUnicodeCodePoint;
  const AList    : PUCA_LineRec;
  const AListLen : Integer
) : Integer;overload;
var
  i, lengthPattern, sizePattern : Integer;
  pl : PUCA_LineRec;
begin
  Result := -1;
  if (Length(APattern) = 0) then
    exit;
  if (AListLen = 0) then
    exit;
  lengthPattern := Length(APattern);
  sizePattern := lengthPattern*SizeOf(TUnicodeCodePoint);
  pl := AList;
  for i := 0 to AListLen - 1 do begin
    if (Length(pl^.CodePoints) = lengthPattern) and
       CompareMem(@pl^.CodePoints[0],@APattern[0],sizePattern)
    then begin
      Result := i;
      Break;
    end;
    Inc(pl);
  end;
end;

function IsIgnorable(AWeight : TUCA_WeightRecArray) : Boolean;
var
  i : Integer;
begin
  if (Length(AWeight) = 0) then
    exit(True);
  for i := Low(AWeight) to High(AWeight) do begin
    if (AWeight[i].Weights[0] <> 0) or
       (AWeight[i].Weights[1] <> 0) or
       (AWeight[i].Weights[2] <> 0)
    then begin
      exit(False);
    end;
  end;
  Result := True;
end;

function RemoveIgnorables(
        AItem    : TUnicodeCodePointArray;
  const AList    : PUCA_LineRec;
  const AListLen : Integer
) : TUnicodeCodePointArray;
var
  i, c, k : Integer;
begin
  SetLength(Result,Length(AItem));
  c := 0;
  for i := 0 to Length(AItem) - 1 do begin
    k := IndexOf([AItem[i]],AList,AListLen);
    if (k >= 0) and
       IsIgnorable(AList[k].Weights)
    then
      k := -1;
    if (k >= 0) then begin
      Result[c] := AItem[i];
      c := c+1;
    end;
  end;
  SetLength(Result,c);
end;

function Compress(
  const AData   : TUCA_LineRecArray;
  out   AResult : TUCA_LineRecArray
) : Boolean;
var
  r : TUCA_LineRecArray;
  pr, p : PUCA_LineRec;
  ral : Integer;

  function FindOutSlot() : Boolean;
  var
    k : Integer;
  begin
    k := IndexOf(p^.CodePoints,@r[0],ral);
    Result := (k >= 0);
    if (k = -1) then begin
      k := ral;
      ral := ral + 1;
    end;
    pr := @r[k];
  end;

  procedure AddContextData();
  var
    k : Integer;
  begin
    if not p^.HasContext() then
      exit;
    k := Length(pr^.Context.Data);
    SetLength(pr^.Context.Data,(k+1));
    pr^.Context.Data[k].CodePoints := Copy(p^.Context.Data[0].CodePoints);
    pr^.Context.Data[k].Weights := Copy(p^.Weights);
  end;

  procedure AddItem();
  begin
    pr^.Assign(p);
    if p^.HasContext() then begin
      SetLength(pr^.Context.Data,0);
      pr^.Weights := nil;
      AddContextData();
    end;
  end;

var
  c, i : Integer;
begin
  c := Length(AData);
  if (c = 0) then
    exit;
  SetLength(r,c);
  FillByte(r[0],(Length(r)*SizeOf(r[0])),0);
  pr := @r[0];
  p := @AData[0];
  ral := 0;
  i := 0;
  AddItem();
  ral := 1;
  i := 1;
  Inc(p);
  while (i < c) do begin
    if FindOutSlot() then
      AddContextData()
    else
      AddItem();
    Inc(p);
    Inc(i);
  end;
  SetLength(r,ral);
  AResult := r;
  Result := (ral < Length(AData));
end;

function MarkSuffixAsChanged(
  const AData : PReorderUnit;
  const ADataLen : Integer
) : Integer;
var
  i, k : Integer;
  p, q : PReorderUnit;
  suffixChar : TUnicodeCodePoint;
begin
  Result := 0;
  if (ADataLen <= 1) then
    exit;
  q := AData;
  p := AData;
  for i := 0 to ADataLen - 1 do begin
    if not(p^.IsVirtual()) and p^.Changed then begin
      suffixChar := p^.Characters[0];
      for k := 0 to ADataLen - 1 do begin
        if not(q[k].Changed) and (q[k].Characters[0] = suffixChar) then begin
          q[k].Changed := True;
          Result := Result + 1;
        end;
      end;
    end;
    Inc(p);
  end;
end;

function CountChangedPrimaries(APosition, AEnd : PReorderUnit) : Integer;
var
  p : PReorderUnit;
begin
  p := APosition+1;
  while (p < AEnd) and
        p^.Changed and (p^.WeigthKind = TReorderWeigthKind.Primary)
  do begin
    p := p+1;
  end;
  Result := (p-(APosition+1));
end;

function FindNextUnchangedPrimary(AStartPos, AEnd : PReorderUnit) : PReorderUnit;
var
  p : PReorderUnit;
begin
  p := AStartPos;
  while (p < AEnd) and (p^.WeigthKind <> TReorderWeigthKind.Primary) do begin
    p := p+1;
  end;
  if (p >= AEnd) or p^.Changed or
     (p^.WeigthKind <> TReorderWeigthKind.Primary) or
     (p^.InitialPosition < 1)
  then begin
    p := nil;
  end;
  Result := p;
end;

function ComputeWeigthItem(
  ABase        : PUCA_WeightRecArray;
  APosition    : PReorderUnit;
  AEnd         : PReorderUnit;
  ADataWeigths : TUCA_LineRecArray
) : TUCA_WeightRecArray;
var
  r : TUCA_WeightRecArray;
  c, i : Integer;
  p : PReorderUnit;
  changedPrimaryCount : Integer;
  nextUnchangedPrimary : PReorderUnit;
begin
  case APosition^.WeigthKind of
    TReorderWeigthKind.Primary :
      begin
        if (Length(ABase^) = 2) and
           (ABase^[1].Weights[1] = 0) and (ABase^[1].Weights[2] = 0)
        then begin
          r := Copy(ABase^);
          Inc(r[1].Weights[0]);
        end else begin
          changedPrimaryCount :=  CountChangedPrimaries(APosition,AEnd);
          nextUnchangedPrimary := FindNextUnchangedPrimary(APosition+changedPrimaryCount+1,AEnd);
          if (nextUnchangedPrimary = nil) or
             ( (ABase^[0].Weights[0]+changedPrimaryCount+1) >=
               ADataWeigths[nextUnchangedPrimary^.InitialPosition-1].Weights[0].Weights[0]
             )
          then begin
            p := nil;
            if (nextUnchangedPrimary = nil) and (APosition < (AEnd-1)) then begin
              p := APosition+1;
            end;
            if (nextUnchangedPrimary = nil) and
               ( (p = nil) or (p^.WeigthKind = TReorderWeigthKind.Primary)) and
               (Length(ABase^) = 1) and (ABase^[0].Weights[0] < $FFF0)
            then begin
              SetLength(r,1);
              FillByte(r[0],(Length(r)*SizeOf(r[0])),0);
              r[0].Weights[0] := (ABase^[0].Weights[0] + 1);
              r[0].Variable := ABase^[0].Variable;
            end else begin
              SetLength(r,2);
              FillByte(r[0],(Length(r)*SizeOf(r[0])),0);
              r[0].Weights[0] := (ABase^[0].Weights[0] + 1);
              r[0].Variable := ABase^[0].Variable;
              r[1].Weights[0] := 1;
            end;
          end else begin
            SetLength(r,2);
            FillByte(r[0],(Length(r)*SizeOf(r[0])),0);
            r[0].Weights[0] := (ABase^[0].Weights[0] + 1);
            r[0].Variable := ABase^[0].Variable;
            r[1] := r[0];
          end;
        end;
      end;
    TReorderWeigthKind.Secondary :
      begin
        c := Length(ABase^);
        SetLength(r,c);
        FillByte(r[0],(Length(r)*SizeOf(r[0])),0);
        for i := 0 to c-1 do begin
          r[i].Weights[0] := ABase^[i].Weights[0];
          r[i].Variable := ABase^[i].Variable;
        end;
        r[0].Weights[1] := (ABase^[0].Weights[1] + 1);
      end;
    TReorderWeigthKind.Tertiary :
      begin
        c := Length(ABase^);
        SetLength(r,c);
        FillByte(r[0],(Length(r)*SizeOf(r[0])),0);
        for i := 0 to c-1 do begin
          r[i].Weights[0] := ABase^[i].Weights[0];
          r[i].Weights[1] := ABase^[i].Weights[1];
          r[i].Variable := ABase^[i].Variable;
        end;
        r[0].Weights[2] := (ABase^[0].Weights[2] + 1);
      end;
    TReorderWeigthKind.Identity : r := Copy(ABase^);
    else
      r := nil;
  end;
  Result := r;
end;

{$include weight_derivation.inc}

function InternalComputeWeigths(
  const AData        : PReorderUnit;
  const ADataLen     : Integer;
  const ADataWeigths : TUCA_LineRecArray;
    out AResult      : TUCA_LineRecArray
) : Integer;

  function GetWeigth(AItem : PReorderUnit) : PUCA_WeightRecArray;
  begin
    Result := nil;
    if (AItem^.InitialPosition < 1) or (AItem^.InitialPosition > Length(ADataWeigths)) then
      raise ECldrException.CreateFmt('Invalid "InitialPosition" value : %d.',[AItem^.InitialPosition]);
    Result := @ADataWeigths[(AItem^.InitialPosition-1)].Weights;
  end;

var
  r : TUCA_LineRecArray;
  pr : PUCA_LineRec;
  dataEnd : PReorderUnit;

  procedure AddContext(const ACodePointPattern : TUnicodeCodePointArray);
  var
    k : Integer;
  begin
    k := Length(pr^.Context.Data);
    SetLength(pr^.Context.Data,(k+1));
    pr^.Context.Data[k].CodePoints := Copy(ACodePointPattern);
    SetLength(pr^.Context.Data[k].Weights,0);
  end;

var
  ral : Integer;
  i : Integer;
  p : PReorderUnit;
  pbase : PReorderUnit;
  pwb : PUCA_WeightRecArray;
  actualBegin : Boolean;
  loopIndex : Integer;

  procedure SkipDeletion();
  begin
    pr^.CodePoints := Copy(p^.Characters);
    pr^.Deleted := True;
    SetLength(pr^.Weights,0);
    if p^.HasContext() then
      AddContext(p^.Context);
    Inc(pr);
    Inc(ral);
    Inc(p);
    Inc(i);
  end;

  procedure FindBaseItem();
  begin
    if (pbase = nil) or (pwb^ = nil) then begin
      if actualBegin then begin
        pwb := @ADataWeigths[0].Weights;
      end else begin
        pbase := p - 1;
        if pbase^.Changed then
          pwb := @((pr-1)^.Weights)
        else
          pwb := GetWeigth(pbase);
        if (pwb^ = nil) and (pbase = AData) then
          pwb := @ADataWeigths[0].Weights;
      end;
    end;
  end;

  function InternalComputeWeights(const AList : array of TUnicodeCodePointArray) : TUCA_WeightRecArray;
  var
    kral : Integer;
    kres : TUCA_WeightRecArray;

    procedure EnsureResultLength(const APlus : Integer);//inline;
    begin
      if ((kral+APlus) > Length(kres)) then
        SetLength(kres,(2*(kral+APlus)));
    end;

    procedure AddToResult(const AValue : TUCA_WeightRecArray);//inline;
    begin
      if not IsZero(AValue) then begin
        EnsureResultLength(Length(AValue));
        Move(AValue[0],kres[kral],(Length(AValue)*SizeOf(kres[0])));
        kral := kral + Length(AValue);
      end;
    end;

  var
    kc, k, ktempIndex, ki : Integer;
    tmpWeight : array of TUCA_PropWeights;
    cp : TUnicodeCodePoint;
  begin
    kc := Length(AList);
    kral := 0;
    SetLength(kres,(10*kc));
    FillChar(kres[0],(Length(kres)*SizeOf(kres[0])),0);
    for k := 0 to kc - 1 do begin
      ktempIndex := IndexOf(AList[k],@r[0],ral);
      if (ktempIndex <> -1) then begin
        AddToResult(r[ktempIndex].Weights);
        Continue;
      end;
      ktempIndex := IndexOf(AList[k],[],AData,ADataLen);
      if (ktempIndex <> -1) then begin
        if not AData[ktempIndex].Changed then begin
          AddToResult(ADataWeigths[AData[ktempIndex].InitialPosition-1].Weights);
          Continue;
        end;
      end;
      if (Length(AList[k]) > 1) then begin
        for ki := 0 to Length(AList[k]) - 1 do begin
          ktempIndex := IndexOf([AList[k][ki]],@r[0],ral);
          if (ktempIndex <> -1) then begin
            AddToResult(r[ktempIndex].Weights);
            Continue;
          end;
          cp := AList[k][ki];
          ktempIndex := IndexOf([cp],[],AData,ADataLen); //ktempIndex := IndexOf([AList[k][ki]],[],AData,ADataLen);
          if (ktempIndex <> -1) then begin
            //if not AData[ktempIndex].Changed then begin
              AddToResult(ADataWeigths[AData[ktempIndex].InitialPosition-1].Weights);
              Continue;
            //end;
          end;
          SetLength(tmpWeight,2);
          DeriveWeight(AList[k][ki],@tmpWeight[0]);
          EnsureResultLength(2);
          kres[kral].Weights[0] := tmpWeight[0].Weights[0];
          kres[kral].Weights[1] := tmpWeight[0].Weights[1];
          kres[kral].Weights[2] := tmpWeight[0].Weights[2];
          kres[kral+1].Weights[0] := tmpWeight[1].Weights[0];
          kres[kral+1].Weights[1] := tmpWeight[1].Weights[1];
          kres[kral+1].Weights[2] := tmpWeight[1].Weights[2];
          kral := kral + 2;
          tmpWeight := nil;
        end;
        Continue;// ??????????????
      end;
      SetLength(tmpWeight,2);
      DeriveWeight(AList[k][0],@tmpWeight[0]);
      EnsureResultLength(2);
      kres[kral].Weights[0] := tmpWeight[0].Weights[0];
      kres[kral].Weights[1] := tmpWeight[0].Weights[1];
      kres[kral].Weights[2] := tmpWeight[0].Weights[2];
      kres[kral+1].Weights[0] := tmpWeight[1].Weights[0];
      kres[kral+1].Weights[1] := tmpWeight[1].Weights[1];
      kres[kral+1].Weights[2] := tmpWeight[1].Weights[2];
      kral := kral + 2;
      tmpWeight := nil;
    end;
    SetLength(kres,kral);
    Result := kres;
  end;

  procedure Handle_Expansion();
  var
    expChars : array[0..1] of TUnicodeCodePointArray;
    kres : TUCA_WeightRecArray;
  begin
    expChars[0] := (p-1)^.Characters;
    expChars[1] := p^.ExpansionChars;
    kres := InternalComputeWeights(expChars);
    pr^.Weights := ComputeWeigthItem(@kres,p,dataEnd,ADataWeigths);
  end;

  function FindLastNotEmptyWeigth() : PUCA_LineRec;
  var
    p0, pk : PUCA_LineRec;
  begin
    p0 := @r[0];
    pk := pr-1;
    while (pk >= p0) do begin
      if (Length(pk^.Weights) > 0) then
        exit(pk);
      pk := pk-1;
    end;
    Result := nil;
  end;

  procedure CheckWeight(AItem : TUCA_WeightRecArray);
  begin
    if (Length(AItem) = 0) then
      raise ECldrException.Create(sUnexpectedConditionsFailure);
  end;

var
  c, ti : Integer;
  q : PReorderUnit;
  pw : PUCA_WeightRecArray;
  pt : PUCA_LineRec;
begin
  Result := 0;
  if (ADataLen < 1) then
    exit;
  SetLength(AResult,0);
  dataEnd := AData+ADataLen;
  while True do begin
    for loopIndex := 0 to 1 do begin
      c := ADataLen;
      ral := 0;
      SetLength(r,c);
      pr := @r[0];
      for i := Low(r) to High(r) do begin
        pr^.Clear();
        Inc(pr);
      end;
      q := nil;
      pbase := nil;
      pr := @r[0];
      p := AData;
      i := 0;
      while (i < c) do begin
        if (p^.WeigthKind = TReorderWeigthKind.Deletion) then begin
          SkipDeletion();
          Continue;
        end;
        if p^.Changed then begin
          actualBegin := (i = 0) or (((p-1)^.WeigthKind = TReorderWeigthKind.Deletion));
          FindBaseItem();
          if p^.IsExpansion() then begin
            if (loopIndex = 0) then begin
              q := p;
              Inc(p);
              Inc(i);
              while (i < c) do begin
                if (p^.WeigthKind = TReorderWeigthKind.Primary) then
                  Break;
                Inc(p);
                Inc(i);
              end;
              Continue;
            end;
            pr^.CodePoints := Copy(p^.Characters);
            Handle_Expansion();
            if p^.HasContext() then
              AddContext(p^.Context);
            Inc(pr);
            Inc(ral);
          end else if actualBegin then begin
            pr^.CodePoints := Copy(p^.Characters);
            pw := pwb;
            CheckWeight(pw^);
            pr^.Weights := Copy(pw^);
            if p^.HasContext() then
              AddContext(p^.Context);
            Inc(pr);
            Inc(ral);
          end else if (p^.WeigthKind = TReorderWeigthKind.Identity) then begin
            pr^.CodePoints := Copy(p^.Characters);
            q := p - 1;
            if (q = pbase) then
              pw := pwb
            else
              pw := @((pr-1)^.Weights);
            CheckWeight(pw^);
            pr^.Weights := Copy(pw^);
            if p^.HasContext() then
              AddContext(p^.Context);
            Inc(pr);
            Inc(ral);
          end else begin
            CheckWeight(pwb^);
            pr^.CodePoints := Copy(p^.Characters);
            if ((p - 1) = pbase) then begin
              pr^.Weights := ComputeWeigthItem(pwb,p,dataEnd,ADataWeigths);
            end else begin
              if (Length(pr^.Weights) = 0) then begin
                pt := FindLastNotEmptyWeigth();
                if (pt = nil) then
                  raise ECldrException.Create(sUnexpectedConditionsFailure);
                CheckWeight(pt^.Weights);
              end;
              pr^.Weights := ComputeWeigthItem(@pt^.Weights,p,dataEnd,ADataWeigths);
            end;
            if p^.HasContext() then
              AddContext(p^.Context);
            Inc(pr);
            Inc(ral);
          end;
        end else begin
          if (i > 0) and ((p-1)^.WeigthKind <> TReorderWeigthKind.Deletion) and (p-1)^.Changed and
             (ral > 0)
          then begin
            pw := GetWeigth(p);
            CheckWeight(pw^);
            ti := CompareSortKey(SimpleFormKey((pr-1)^.Weights),SimpleFormKey(pw^));
            if ( (p^.WeigthKind = TReorderWeigthKind.Identity) and (ti > 0) ) or
               ( (p^.WeigthKind >= TReorderWeigthKind.Primary) and (ti >= 0) )
            then begin
              p^.Changed := True;
              Continue;
            end;
          end;
          pbase := nil;
          pwb := nil;
        end;
        Inc(p);
        Inc(i);
      end;
    end;
    SetLength(r,ral);
    if (MarkSuffixAsChanged(AData,ADataLen) = 0) then
      Break;
  end;
  Compress(r,AResult);
  Result := Length(AResult);
end;

function ComputeWeigths(
  const AData        : PReorderUnit;
  const ADataLen     : Integer;
  const ADataWeigths : TUCA_LineRecArray;
    out AResult      : TUCA_LineRecArray
) : Integer;
var
  locData : array of TReorderUnit;
  i, actualLength : Integer;
  p : PReorderUnit;
begin
  SetLength(AResult,0);
  SetLength(locData,ADataLen);
  actualLength := 0;
  p := AData;
  for i := 0 to ADataLen-1 do begin
    if not p^.IsVirtual() then begin
      locData[actualLength].Assign(p);
      actualLength := actualLength+1;
    end;
    Inc(p);
  end;
  if (Length(locData) <> actualLength) then
    SetLength(locData,actualLength);
  Result := InternalComputeWeigths(@locData[0],actualLength,ADataWeigths,AResult);

  p := AData;
  for i := 0 to actualLength-1 do begin
    while p^.IsVirtual() do begin
      Inc(p);
    end;
    p^.Assign(@locData[i]);
    Inc(p);
  end;
end;

const
  // Bidirectional Ordering Controls : Unicode 9 => Page 833
  ARABIC_LETTER_MARK = $061C;//  ALM arabic letter mark alm
  LEFT_TO_RIGHT_MARK = $200E;//  LRM left-to-right mark lrm
  RIGHT_TO_LEFT_MARK = $200F;//  RLM right-to-left mark rlm
  LEFT_TO_RIGHT_EMBEDDING = $202A;//  LRE left-to-right embedding lre
  RIGHT_TO_LEFT_EMBEDDING = $202B;//  RLE right-to-left embedding rle
  POP_DIRECTIONAL_FORMATTING = $202C;//  PDF pop directional formatting pdf
  LEFT_TO_RIGHT_OVERRIDE = $202D;//  LRO left-to-right override lro
  RIGHT_TO_LEFT_OVERRIDE = $202E;//  RLO right-to-left override rlo
  LEFT_TO_RIGHT_ISOLATE = $2066;//  LRI left-to-right isolate lri
  RIGHT_TO_LEFT_ISOLATE = $2067;//  RLI right-to-left isolate rli
  FIRST_STRONG_ISOLATE = $2068;//  FSI first strong isolate fsi
  POP_DIRECTIONAL_ISOLATE = $2069;//  PDI pop directional isolate pdi

  BIDIRECTIONAL_ORDERING_CONTROLS : array[0..11] of DWord = (
    ARABIC_LETTER_MARK, LEFT_TO_RIGHT_MARK, RIGHT_TO_LEFT_MARK,
    LEFT_TO_RIGHT_EMBEDDING, RIGHT_TO_LEFT_EMBEDDING,
    POP_DIRECTIONAL_FORMATTING, LEFT_TO_RIGHT_OVERRIDE, RIGHT_TO_LEFT_OVERRIDE,
    LEFT_TO_RIGHT_ISOLATE, RIGHT_TO_LEFT_ISOLATE, FIRST_STRONG_ISOLATE,
    POP_DIRECTIONAL_ISOLATE
  );

function IsBidirectionalOrderingControls(const ACodePoint : DWord) : Boolean;inline;
begin
  Result :=
    IndexDWord(
      BIDIRECTIONAL_ORDERING_CONTROLS, SizeOf(BIDIRECTIONAL_ORDERING_CONTROLS),
      ACodePoint
    ) >= 0;
end;

function RemoveBidirectionalOrderingControls(
  AItem : TUnicodeCodePointArray
) : TUnicodeCodePointArray;
var
  i, c, k : Integer;
begin
  SetLength(Result,Length(AItem));
  c := 0;
  for i := 0 to Length(AItem) - 1 do begin
    if not IsBidirectionalOrderingControls(AItem[i]) then begin
      Result[c] := AItem[i];
      c := c+1;
    end;
  end;
  SetLength(Result,c);
end;

function FillInitialPositions(
        AData        : PReorderUnit;
  const ADataLen     : Integer;
  const ADataWeigths : TUCA_LineRecArray
) : Integer;
var
  locNotFound, i, cw : Integer;
  p : PReorderUnit;
  pw : PUCA_LineRec;
  chars : TUnicodeCodePointArray;
  k : Integer;
begin
  locNotFound := 0;
  cw := Length(ADataWeigths);
  if (cw > 0) then
    pw := @ADataWeigths[0]
  else
    pw := nil;
  p := AData;
  for i := 0 to ADataLen - 1 do begin
    if not p^.IsVirtual() then begin
      p^.InitialPosition := IndexOf(p^.Characters,pw,cw) + 1;
      if (p^.InitialPosition = 0) then begin
        chars := RemoveBidirectionalOrderingControls(p^.Characters);
        p^.InitialPosition := IndexOf(chars,pw,cw) + 1;
        if (p^.InitialPosition > 0) then begin
          k := IndexOf(chars,[],AData,ADataLen);
          if (k < 0) then
            p^.Characters := chars;
        end;
        if (p^.InitialPosition = 0) then begin
          chars := RemoveIgnorables(p^.Characters,pw,cw);
          p^.InitialPosition := IndexOf(chars,pw,cw) + 1;
        end;
      end;
      if (p^.InitialPosition = 0) then
        Inc(locNotFound);
    end;
    Inc(p);
  end;
  Result := locNotFound;
end;

{ TSettingRec }

class function TSettingRec.From(
  const AName   : UTF8String;
  const AValues : array of UTF8String;
  const AOption : TSettingOption
) : TSettingRec;
var
  i : Integer;
begin
  Result.Name := AName;
  SetLength(Result.Values,Length(AValues));
  for i := 0 to Length(AValues)-1 do
    Result.Values[i] := AValues[i];
  Result.OptionValue := AOption;
end;

procedure TSettingRec.Assign(const AItem : PSettingRec);
begin
  if (AItem = nil) then begin
    Clear();
  end else begin
    Self.Name := AItem^.Name;
    Self.Values := Copy(AItem^.Values);
    Self.OptionValue := AItem^.OptionValue;
    Self.Understood := AItem^.Understood;
  end;
end;

procedure TSettingRec.Clear;
begin
  Name := '';
  Values := nil;
  OptionValue := TSettingOption.Unknown;
  Understood := False;
end;

{ TCldrImportList }

function TCldrImportList.GetCount: Integer;
begin
  Result := Length(FItems);
end;

function TCldrImportList.GetItem(AIndex : Integer): TCldrImport;
begin
  if (AIndex < 0) or (AIndex >= Length(FItems)) then
    raise ERangeError.CreateFmt(SListIndexError,[AIndex]);
  Result := FItems[AIndex];
end;

destructor TCldrImportList.Destroy();
begin
  Clear();
  inherited;
end;

procedure TCldrImportList.Clear();
var
  i : Integer;
begin
  for i := Low(FItems) to High(FItems) do
    FreeAndNil(FItems[i]);
  SetLength(FItems,0);
end;

function TCldrImportList.IndexOf(const ASource, AType: string): Integer;
var
  i : Integer;
begin
  for i := Low(FItems) to High(FItems) do begin
    if (FItems[i].Source = ASource) and (FItems[i].TypeName = AType) then begin
      Result := i;
      exit;
    end;
  end;
  Result := -1;
end;

function TCldrImportList.Find(const ASource, AType: string): TCldrImport;
var
  i : Integer;
begin
  i := IndexOf(ASource,AType);
  if (i >= 0) then
    Result := FItems[i]
  else
    Result := nil;
end;

function TCldrImportList.Add(const ASource, AType: string): TCldrImport;
var
  i : Integer;
begin
  i := IndexOf(ASource,AType);
  if (i >= 0) then begin
    Result := FItems[i];
  end else begin
    Result := TCldrImport.Create();
    Result.FSource := ASource;
    Result.FTypeName := AType;
    i := Length(FItems);
    SetLength(FItems,(i+1));
    FItems[i] := Result;
  end;
end;

{ TCldrCollationRepository }

function TCldrCollationRepository.GetItem(const AIndex : Integer): TCldrCollation;
begin
  if (AIndex < 0) or (AIndex >= Length(FItems)) then
    raise ERangeError.CreateFmt(SListIndexError,[AIndex]);
  Result := FItems[AIndex];
end;

function TCldrCollationRepository.GetItemCount: Integer;
begin
  Result := Length(FItems);
end;

function TCldrCollationRepository.IndexOfItem(AItem: TCldrCollation): Integer;
var
  i : Integer;
begin
  for i := Low(FItems) to High(FItems) do begin
    if (FItems[i] = AItem) then begin
      Result := i;
      exit;
    end;
  end;
  Result := -1;
end;

procedure TCldrCollationRepository.Add(AItem: TCldrCollation);
var
  i : Integer;
begin
  if (AItem = nil) then
    raise EArgumentException.CreateFmt(SParamIsNil,['AItem: TCldrCollation']);
  if (IndexOfItem(AItem) >= 0) then
    raise EArgumentException.CreateFmt(sCollationsExistsAlready,[AItem.Language]);
  i := Length(FItems);
  SetLength(FItems,(i+1));
  AItem.FRepository := Self;
  FItems[i] := AItem;
end;

constructor TCldrCollationRepository.Create(ALoader: ICldrCollationLoader);
begin
  if (ALoader = nil) then
    raise EArgumentException.CreateFmt(SInvalidPropertyElement,['Loader']);
  SetLoader(ALoader);
end;

destructor TCldrCollationRepository.Destroy;
begin
  Clear();
  inherited Destroy;
end;

procedure TCldrCollationRepository.FreeItems();
var
  i : Integer;
begin
  for i := 0 to Length(FItems) - 1 do
    FreeAndNil(FItems[i]);
  SetLength(FItems,0);
end;

procedure TCldrCollationRepository.Clear();
begin
  FreeItems();
end;

procedure TCldrCollationRepository.SetLoader(AValue: ICldrCollationLoader);
begin
  if (FLoader <> AValue) then
    FLoader := AValue;
end;

function TCldrCollationRepository.IndexOf(const ALanguage: string): Integer;
var
  i : Integer;
begin
  for i := Low(FItems) to High(FItems) do begin
    if (FItems[i].Language = ALanguage) then begin
      Result := i;
      exit;
    end
  end;
  Result := -1;
end;

function TCldrCollationRepository.Find(const ALanguage: string): TCldrCollation;
var
  i : Integer;
begin
  i := IndexOf(ALanguage);
  if (i >= 0) then
    Result := FItems[i]
  else
    Result := nil;
end;

function TCldrCollationRepository.Load(
  const ALanguage : string;
  const AMode     : TCldrParserMode
) : TCldrCollation;
var
  isnew : Boolean;
begin
  Result := Find(ALanguage);
  if (Result <> nil) then begin
    if (Result.Mode = TCldrParserMode.FullParsing) or (Result.Mode = AMode) then
      exit;
  end;
  isnew := (Result = nil);
  if isnew then
    Result := TCldrCollation.Create();
  try
    Loader.LoadCollation(ALanguage,Result,AMode);
    if isnew then
      Add(Result);
  except
    if isnew then
      FreeAndNil(Result);
    raise;
  end;
end;

function TCldrCollationRepository.LoadType(
  const ALanguage, AType, ATypeALT : string
) : TCldrCollationItem;
var
  item : TCldrCollationItem;
  col : TCldrCollation;
  newItem : Boolean;
begin
  col := Find(ALanguage);
  if (col = nil) then
    col := Load(ALanguage,TCldrParserMode.HeaderParsing);
  if (ATypeALT <> '') then
    item := col.Find(AType,ATypeALT)
  else
    item := col.Find(AType);
  newItem := (item = nil);
  try
    if newItem then
      item := TCldrCollationItem.Create();
    if newItem or (item.Mode = TCldrParserMode.HeaderParsing) then
      Loader.LoadCollationType(ALanguage,AType,item);
    if newItem then
      col.Add(item);
  except
    if newItem then
      item.Free();
    raise;
  end;
  Result := item;
end;

{ TCldrCollationItem }

class function TCldrCollationItem.FindAlias(
  const AName : UTF8String
) : UTF8String;
var
  s : UTF8String;
  i : Integer;
begin
  Result := '';
  if (AName <> '') then begin
    s := LowerCase(AName);
    for i := Low(BCP47_COLLATION_TYPE_ALIAS) to High(BCP47_COLLATION_TYPE_ALIAS) do begin
      if (s = BCP47_COLLATION_TYPE_ALIAS[i].Name) then begin
        Result := BCP47_COLLATION_TYPE_ALIAS[i].Alias;
        break;
      end;
    end;
  end;
end;

constructor TCldrCollationItem.Create;
begin
  FImports := TCldrImportList.Create();
  FNormalization := True;
  FStrength := TComparisonStrength.Tertiary;
end;

destructor TCldrCollationItem.Destroy;
begin
  FImports.Free();
  inherited Destroy;
end;

procedure TCldrCollationItem.Clear();
begin
  FBackwards := False;
  FNormalization := True;
  FStrength := TComparisonStrength.Tertiary;
  FVariableWeight := Low(TUCA_VariableKind);
  FAlt := '';
  FBase := '';
  FTypeName := '';
  FChangedFields := [];
  SetLength(FRules,0);
  SetLength(FSettings,0);
  FImports.Clear();
end;

function TCldrCollationItem.IsPrivate() : Boolean;
begin
  Result := (Pos('private-',TypeName) = 1);
end;

{ TCldrCollation }

function TCldrCollation.GetItem(Index : Integer): TCldrCollationItem;
begin
  if (Index < 0) or (Index >= Length(FItems)) then
    raise ERangeError.CreateFmt(SListIndexError,[Index]);
  Result := FItems[Index];
end;

function TCldrCollation.GetItemCount: Integer;
begin
  Result := Length(FItems);
end;

destructor TCldrCollation.Destroy;
begin
  Clear();
  inherited Destroy;
end;

procedure TCldrCollation.Clear();
var
  i : Integer;
begin
  for i := 0 to Length(FItems) - 1 do
    FreeAndNil(FItems[i]);
  SetLength(FItems,0);
  FLocalID := '';
  FDefaultType := '';
  FVersion := '';
  FLanguage := '';
  FMode := Low(TCldrParserMode);
end;

function TCldrCollation.IndexOf(const AItemName: string): Integer;
var
  i : Integer;
begin
  for i := 0 to ItemCount - 1 do begin
    if SameText(AItemName,Items[i].TypeName) then
      exit(i);
  end;
  Result := -1;
end;

function TCldrCollation.IndexOf(const AItemName, AItemAlt: string): Integer;
var
  i : Integer;
begin
  for i := 0 to ItemCount - 1 do begin
    if SameText(AItemName,Items[i].TypeName) and
       SameText(AItemAlt,Items[i].Alt)
    then begin
      exit(i);
    end;
  end;
  Result := -1;
end;

function TCldrCollation.Find(const AItemName: string): TCldrCollationItem;
var
  i : Integer;
  s : UTF8String;
begin
  i := IndexOf(AItemName);
  if (i = - 1) then begin
    s := TCldrCollationItem.FindAlias(AItemName);
    if (s <> '') then
      i := IndexOf(s);
  end;
  if (i = - 1) then
    Result := nil
  else
    Result := Items[i];
end;

function TCldrCollation.Find(const AItemName, AItemAlt: string): TCldrCollationItem;
var
  i : Integer;
begin
  i := IndexOf(AItemName,AItemAlt);
  if (i = - 1) then
    Result := nil
  else
    Result := Items[i];
end;

function TCldrCollation.Add(AItem: TCldrCollationItem): Integer;
begin
  Result := Length(FItems);
  SetLength(FItems,(Result+1));
  FItems[Result] := AItem;
  AItem.FParent := Self;
end;

function TCldrCollation.FindPublicItemCount() : Integer;
var
  r, i : Integer;
begin
  r := 0;
  for i := 0 to ItemCount-1 do begin
    if not Items[i].IsPrivate() then
      r := r+1;
  end;
  Result := r;
end;

{ TReorderSequence }

procedure TReorderSequence.Clear();
begin
  Reset    := nil;
  Elements := nil;
  LogicalPosition := TReorderLogicalReset(0);
  Before   := False;
end;

procedure TReorderSequence.SetElementCount(const ALength: Integer);
begin
  SetLength(Elements,ALength);
end;

procedure TReorderSequence.Assign(ASource: PReorderSequence);
var
  c, i : Integer;
begin
  if (ASource = nil) then begin
    Self.Clear();
    exit;
  end;
  Self.Reset := Copy(ASource^.Reset);
  c := Length(ASource^.Elements);
  SetLength(Self.Elements,c);
  for i := 0 to c-1 do
    Self.Elements[i].Assign(@ASource^.Elements[i]);
  Self.Before := ASource^.Before;
  Self.LogicalPosition := ASource^.LogicalPosition;
end;

{ TReorderUnit }

function TReorderUnit.IsVirtual() : Boolean;
begin
  Result := (FVirtualPosition > TReorderLogicalReset.None);
end;

class function TReorderUnit.From(
  const AChars,
        AContext         : array of TUnicodeCodePoint;
  const AWeigthKind      : TReorderWeigthKind;
  const AInitialPosition : Integer
) : TReorderUnit;
var
  c : Integer;
begin
  Result.Clear();
  c := Length(AChars);
  SetLength(Result.Characters,c);
  if (c > 0) then
    Move(AChars[0],Result.Characters[0],(c*SizeOf(Result.Characters[0])));
  Result.WeigthKind := AWeigthKind;
  Result.InitialPosition := AInitialPosition;
  Result.Changed := False;
  c := Length(AContext);
  SetLength(Result.Context,c);
  if (c > 0) then
    Move(AContext[0],Result.Context[0],(c*SizeOf(Result.Context[0])));
end;

class function TReorderUnit.From(
  const AChars           : array of TUnicodeCodePoint;
  const AWeigthKind      : TReorderWeigthKind;
  const AInitialPosition : Integer
) : TReorderUnit;
begin
  Result := From(AChars,[],AWeigthKind,AInitialPosition);
end;

class function TReorderUnit.From(
  const AChar            : TUnicodeCodePoint;
  const AWeigthKind      : TReorderWeigthKind;
  const AInitialPosition : Integer
) : TReorderUnit;
begin
  Result := From([AChar],AWeigthKind,AInitialPosition);
end;

class function TReorderUnit.From(
  const AChar            : TUnicodeCodePoint;
  const AContext         : array of TUnicodeCodePoint;
  const AWeigthKind      : TReorderWeigthKind;
  const AInitialPosition : Integer
) : TReorderUnit;
begin
  Result := From([AChar],AContext,AWeigthKind,AInitialPosition);
end;

class function TReorderUnit.From(const AReset: TReorderLogicalReset): TReorderUnit;
begin
  Result.Clear();
  Result.FVirtualPosition := AReset;
end;

procedure TReorderUnit.SetExpansion(const AChars: array of TUnicodeCodePoint);
var
  c : Integer;
begin
  if IsVirtual() then
    raise ECldrException.Create(sVirtualIsReadOnly);

  c := Length(AChars);
  SetLength(ExpansionChars,c);
  if (c > 0) then
    Move(AChars[0],ExpansionChars[0],(c*SizeOf(AChars[0])));
end;

procedure TReorderUnit.SetExpansion(const AChar: TUnicodeCodePoint);
begin
  if IsVirtual() then
    raise ECldrException.Create(sVirtualIsReadOnly);

  SetExpansion([AChar]);
end;

procedure TReorderUnit.Clear();
begin
  Self.FVirtualPosition := TReorderLogicalReset(0);
  Self.Characters := nil;
  Self.Context := nil;
  Self.ExpansionChars := nil;
  Self.InitialPosition := 0;
  Self.WeigthKind := TReorderWeigthKind(0);
  Self.Changed := False;
end;

procedure TReorderUnit.Assign(const AItem : PReorderUnit);
begin
  Clear();
  if (AItem <> nil) then begin
    Self.FVirtualPosition := AItem^.VirtualPosition;
    Self.Characters := Copy(AItem^.Characters);
    //SetLength(Self.Context,Length(AItem^.Context));
    Self.Context := Copy(AItem^.Context);
    Self.ExpansionChars := Copy(AItem^.ExpansionChars);
    Self.WeigthKind := AItem^.WeigthKind;
    Self.InitialPosition := AItem^.InitialPosition;
    Self.Changed := AItem^.Changed;
  end;
end;

function TReorderUnit.HasContext() : Boolean;
begin
  Result := (Length(Context) > 0);
end;

function TReorderUnit.IsExpansion() : Boolean;
begin
  Result := (Length(ExpansionChars) > 0);
end;

{ TOrderedCharacters }

procedure TOrderedCharacters.EnsureSize(const AMinSize : Integer);
var
  c : Integer;
begin
  if (AMinSize > Length(Data)) then begin
    if (AMinSize > 1000) then
      c := AMinSize + 100
    else
      c := (3*AMinSize) div 2 ;
    SetLength(Data,c);
  end;
  FActualLength := AMinSize;
end;

class function TOrderedCharacters.Create(const ACapacity : Integer) : TOrderedCharacters;
begin
  if (ACapacity < 0) then
    raise ERangeError.Create(SRangeError);
  Result.FActualLength := 0;
  SetLength(Result.Data,ACapacity);
end;

class function TOrderedCharacters.Create() : TOrderedCharacters;
begin
  Result := Create(0);
end;

procedure TOrderedCharacters.Clear;
begin
  Data := nil;
  FActualLength := 0;
end;

function TOrderedCharacters.Clone() : TOrderedCharacters;
var
  i : Integer;
begin
  Result.Clear();
  SetLength(Result.Data,Self.ActualLength);
  for i := 0 to Length(Result.Data) - 1 do
    Result.Data[i].Assign(@Self.Data[i]);
  Result.FActualLength := Self.FActualLength;
end;

function TOrderedCharacters.Insert(
  const AItem    : TReorderUnit;
  const ADestPos : Integer
) : Integer;
var
  k, finalPos : Integer;
  p : PReorderUnit;
  i, c : Integer;
begin
  if (ActualLength=0) then begin
    EnsureSize(ActualLength + 1);
    p := @Data[0];
    p^.Assign(@AItem);
    p^.Changed := True;
    exit(0);
  end;
  k := IndexOf(AItem.Characters,AItem.Context,@Data[0],ActualLength);
  if (k = ADestPos) then begin
    Data[ADestPos].Assign(@AItem);
    Data[ADestPos].Changed := True;
    exit(k);
  end;
  finalPos := ADestPos;
  if (finalPos > ActualLength) then
    finalPos := ActualLength;
  c := ActualLength;
  EnsureSize(c + 1);
  Data[c].Clear();
  p := @Data[finalPos];
  if (finalPos = ActualLength-1) then begin
    p^.Assign(@AItem);
    p^.Changed := True;
  end else begin
    if (c > 0) then begin
      p := @Data[c-1];
      for i := finalPos to c - 1 do begin
        Move(Pointer(p)^,Pointer(p+1)^,SizeOf(p^));
        Dec(p);
      end;
    end;
    p := @Data[finalPos];

    {Move(
      Pointer(p)^,Pointer(@p[1])^,
      (ActualLength-(finalPos+1))*SizeOf(TReorderUnit)
    );}
    FillChar(Pointer(p)^,SizeOf(TReorderUnit),0);
    p^.Assign(@AItem);
    p^.Changed := True;
  end;
  if (k >= 0) then begin
    if (k > finalPos) then
      Inc(k);
    Delete(k);
  end;
  Result := finalPos;
end;

function TOrderedCharacters.Append(const AItem : TReorderUnit) : Integer;
begin
  Result := Insert(AItem,ActualLength);
end;

procedure TOrderedCharacters.Delete(const AIndex : Integer);
var
  i : Integer;
  p : PReorderUnit;
begin
  if (AIndex < 0) or (AIndex >= ActualLength) then
    raise ERangeError.CreateFmt(SListIndexError,[AIndex]);
  if (AIndex = (ActualLength-1)) then begin
    Data[AIndex].Clear();
  end else begin
    //Data[AIndex].Clear();
    p := @Data[AIndex];
    p^.Clear();
    for i := AIndex to ActualLength-2 do begin
      Move((p+1)^,p^,SizeOf(p^));
      Inc(p);
    end;
    {Move(
      Pointer(@Data[(AIndex+1)])^,Pointer(@Data[AIndex])^,
      (ActualLength-(AIndex+1))*SizeOf(TReorderUnit)
    );}
    FillChar(Pointer(@Data[(FActualLength-1)])^,SizeOf(TReorderUnit),0);
  end;
  FActualLength := FActualLength - 1;
end;

procedure TOrderedCharacters.ApplyStatement(const AStatement : PReorderSequence);
begin
  ApplyStatementToSequence(Self,AStatement,1);
end;

function FindCollationDefaultItemName(ACollation : TCldrCollation) : string;
begin
  if (ACollation.ItemCount = 0) then
    exit('');
  if (ACollation.IndexOf(ACollation.DefaultType) <> -1) then
    exit(ACollation.DefaultType);
  Result := COLLATION_ITEM_STD;
  if (ACollation.IndexOf(Result) <> -1) then
    exit;
  Result := COLLATION_ITEM_SEARCH;
  if (ACollation.IndexOf(Result) <> -1) then
    exit;
  if (ACollation.ItemCount > 0) then
    Result := ACollation.Items[0].TypeName;
end;

procedure GenerateUCA_CLDR_Head(
  ADest  : TStream;
  ABook  : PUCA_DataBook;
  AProps : PUCA_PropBook;
  ACollation : TCldrCollationItem
);

  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

  procedure AddFields();
  var
    kc : Integer;
    e : TCollationField;
    ks : string;
    ti : PTypeInfo;
  begin
    ti := TypeInfo(TCollationField);
    ks := '';
    kc := 0;
    for e := Low(TCollationField) to High(TCollationField) do begin
      if (e in ACollation.ChangedFields) then begin
        ks := ks + ti^.Name + '.' +
              GetEnumName(ti,Ord(e)) + ', ';
        kc := kc + 1;
      end
    end;
    if (AProps <> nil) then begin
      if (AProps^.VariableLowLimit < High(Word)) then begin
        ks := ks + ti^.Name + '.' +
              GetEnumName(ti,Ord(TCollationField.VariableLowLimit)) + ', ';
        kc := kc + 1;
      end;
      if (AProps^.VariableHighLimit > 0) then begin
        ks := ks + ti^.Name + '.' +
              GetEnumName(ti,Ord(TCollationField.VariableHighLimit)) + ', ';
        kc := kc + 1;
      end;
    end;
    if (kc > 0) then
      ks := Copy(ks,1,(Length(ks)-2));
    AddLine('  UPDATED_FIELDS = [ ' + ks + ' ];');
  end;

begin
  AddLine('{$IFDEF FPC}');
  AddLine('  {$mode DELPHI}{$H+}');
  AddLine('{$ENDIF FPC}');
  AddLine('');
  AddLine('{$IFNDEF FPC}');
  AddLine('  {$DEFINE ENDIAN_LITTLE}');
  AddLine('{$ENDIF !FPC}');
  AddLine('');
  AddLine('unit ' + COLLATION_FILE_PREFIX + LowerCase(ACollation.Parent.LocalID)+ ';'+sLineBreak);
  AddLine('interface'+sLineBreak);
  AddLine('implementation');
  AddLine('uses');
  AddLine('  unicodedata, unicodeducet;'+sLineBreak);
  AddLine('const');
  AddFields();
  AddLine('  COLLATION_NAME = ' + QuotedStr(ACollation.Parent.LocalID) + ';');
  AddLine('  BASE_COLLATION = ' + QuotedStr(ACollation.Base) + ';');
  if (AProps <> nil) then begin
    AddLine('  VARIABLE_LOW_LIMIT = ' + IntToStr(AProps^.VariableLowLimit) + ';');
    AddLine('  VARIABLE_HIGH_LIMIT = ' + IntToStr(AProps^.VariableHighLimit) + ';');
    AddLine('  VARIABLE_WEIGHT = ' + IntToStr(Ord(ABook^.VariableWeight)) + ';');
  end else begin
    AddLine('  VARIABLE_LOW_LIMIT = ' + IntToStr(High(Word)) + ';');
    AddLine('  VARIABLE_HIGH_LIMIT = ' + IntToStr(0) + ';');
    AddLine('  VARIABLE_WEIGHT = ' + IntToStr(0) + ';');
  end;
  AddLine('  BACKWARDS_0 = ' + BoolToStr(ABook^.Backwards[0],'True','False') + ';');
  AddLine('  BACKWARDS_1 = ' + BoolToStr(ABook^.Backwards[1],'True','False') + ';');
  AddLine('  BACKWARDS_2 = ' + BoolToStr(ABook^.Backwards[2],'True','False') + ';');
  AddLine('  BACKWARDS_3 = ' + BoolToStr(ABook^.Backwards[3],'True','False') + ';');
  if (AProps <> nil) then
    AddLine('  PROP_COUNT  = ' + IntToStr(Ord(AProps^.ItemSize)) + ';');
  AddLine('  NO_STRING_NORMALIZATION = ' + BoolToStr(not(ACollation.Normalization),'True','False') + ';');
  AddLine('  COMPARISON_STRENGTH = ' + IntToStr(Ord(ACollation.Strength)+1) + ';');

  AddLine('');
end;

procedure GenerateUCA_CLDR_Registration(
  ADest      : TStream;
  ABook      : PUCA_DataBook;
  ACollation : TCldrCollationItem
);

  procedure AddLine(const ALine : ansistring);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADest.Write(buffer[1],Length(buffer));
  end;

  procedure GenerateStrBuffer(AStr : AnsiString; const ALength : Integer);
  const LINE_ELEMENT = 8;
  var
    kc, k : Integer;
    buffer : ansistring;
  begin
    kc := Length(AStr);
    if (kc > ALength) then
      kc := ALength;

    buffer := '        ';
    for k := 1 to kc do begin
      buffer := buffer + 'Ord('''+AStr[k]+''')';
      if (k < kc) then begin
        buffer := buffer + ',';
        if ((k mod LINE_ELEMENT) = 0) then
          buffer := buffer+sLineBreak + '        ';
      end;
    end;

    if (kc < ALength) then begin
      buffer := buffer + ',' + sLineBreak+ '        ';
      for k := kc+1 to ALength do begin
        buffer := buffer + '0';
        if (k < ALength) then begin
          buffer := buffer + ',';
          if (((k-kc) mod 30) = 0) then
            buffer := buffer+sLineBreak + '        ';
        end;
      end;
    end;
    AddLine(buffer);
  end;

begin
  AddLine('var');
  AddLine('  CLDR_Collation : TUCA_DataBook = (');
  AddLine('    Base               : nil;');
  AddLine('    Version            : ');
  AddLine('      (');
  GenerateStrBuffer(ABook^.Version,128);
  AddLine('      );');
  AddLine('    CollationName      : ');
  AddLine('      (');
  GenerateStrBuffer(ACollation.Parent.LocalID,128);
  AddLine('      );');
  AddLine('    VariableWeight     : TUCA_VariableKind(VARIABLE_WEIGHT);');
  AddLine('    Backwards          : (BACKWARDS_0,BACKWARDS_1,BACKWARDS_2,BACKWARDS_3);');
  if (Length(ABook^.Lines) > 0) then begin
    AddLine('    BMP_Table1         : @UCA_TABLE_1[0];');
    AddLine('    BMP_Table2         : @UCA_TABLE_2[0];');
    AddLine('    OBMP_Table1        : @UCAO_TABLE_1[0];');
    AddLine('    OBMP_Table2        : @UCAO_TABLE_2[0];');
    AddLine('    PropCount          : PROP_COUNT;');
    AddLine('    Props              : @UCA_PROPS[0];');
  end else begin
    AddLine('    BMP_Table1         : nil;');
    AddLine('    BMP_Table2         : nil;');
    AddLine('    OBMP_Table1        : nil;');
    AddLine('    OBMP_Table2        : nil;');
    AddLine('    PropCount          : 0;');
    AddLine('    Props              : nil;');
  end;
  AddLine('    VariableLowLimit   : VARIABLE_LOW_LIMIT;');
  AddLine('    VariableHighLimit  : VARIABLE_HIGH_LIMIT;');
  AddLine('    NoNormalization    : NO_STRING_NORMALIZATION;');
  AddLine('    ComparisonStrength : COMPARISON_STRENGTH;');
  AddLine('    Dynamic            : False;');
  AddLine('  );');
  AddLine('');

  AddLine('procedure Register();');
  AddLine('begin');
  AddLine('  PrepareCollation(@CLDR_Collation,BASE_COLLATION,UPDATED_FIELDS);');
  AddLine('  RegisterCollation(@CLDR_Collation);');
  AddLine('end;');
  AddLine('');

  AddLine('initialization');
  AddLine('  Register();');
  AddLine('');

  AddLine('finalization');
  AddLine('  UnregisterCollation(COLLATION_NAME);');
  AddLine('');
  AddLine('end.');
end;

procedure CheckEndianTransform(const ASource : PUCA_PropBook);
var
  x, y : array of Byte;
  px, py : PUCA_PropItemRec;
begin
  if (ASource = nil) or (ASource^.ItemSize = 0) then
    exit;
  SetLength(x,ASource^.ItemSize);
  px := PUCA_PropItemRec(@x[0]);
  ReverseFromNativeEndian(ASource^.Items,ASource^.ItemSize,px);

  SetLength(y,ASource^.ItemSize);
  py := PUCA_PropItemRec(@y[0]);
  ReverseToNativeEndian(px,ASource^.ItemSize,py);
  if not CompareMem(ASource^.Items,@y[0],Length(x)) then
    CompareProps(ASource^.Items, PUCA_PropItemRec(@y[0]),ASource^.ItemSize);
end;

function ForEachRule(
  ACollationType : TCldrCollationItem;
  AVisitFunc     : TRuleVisiterFunction;
  ACustomData    : Pointer
) : Boolean;
var
  i : Integer;
  locImport : TCldrImport;
  locRep : TCldrCollationRepository;
  locCollation : TCldrCollation;
  locType : TCldrCollationItem;
  locRules : TReorderSequenceArray;
begin
  Result := False;
  if not Assigned(AVisitFunc) then
    exit;
  if (ACollationType.Imports.Count > 0) then begin
    if (ACollationType.Parent = nil) then
      raise ECldrException.Create(sRepositoryNotSet);
    locRep := ACollationType.Parent.Repository;
    if (locRep = nil) then
      raise ECldrException.Create(sLoaderNotSet);
    for i := 0 to ACollationType.Imports.Count-1 do begin
      locImport := ACollationType.Imports[i];
      locCollation := locRep.Load(locImport.Source,TCldrParserMode.FullParsing);
      locType := locCollation.Find(locImport.TypeName);
      if (locType = nil) then begin
        if (locType = nil) then
          raise ECldrException.CreateFmt(sCollationTypeNotFound,[locImport.TypeName]);
      end;
      if not ForEachRule(locType,AVisitFunc,ACustomData) then
        exit;
    end;
  end;
  locRules := ACollationType.Rules;
  for i := Low(locRules) to High(locRules) do begin
    if not AVisitFunc(@locRules[i],ACollationType,ACustomData) then
      exit;
  end;
  Result := True;
end;

function ApplyStatementVisitorFunc(
  ARule  : PReorderSequence;
  AOwner : TCldrCollationItem;
  AData  : Pointer
) : Boolean;
var
  locSequence : POrderedCharacters;
begin
  locSequence := POrderedCharacters(AData);
  locSequence^.ApplyStatement(ARule);
  Result := True;
end;

procedure GenerateCdlrCollation(
  ACollation                : TCldrCollation;
  AItemName                 : string;
  AStoreName                : string;
  AStream,
  ANativeEndianStream,
  AOtherEndianStream,
  ABinaryNativeEndianStream,
  ABinaryOtherEndianStream  : TStream;
  ARootChars                : TOrderedCharacters;
  ARootWeigths              : TUCA_LineRecArray
);

  procedure AddLine(const ALine : ansistring; ADestStream : TStream);
  var
    buffer : ansistring;
  begin
    buffer := ALine + sLineBreak;
    ADestStream.Write(buffer[1],Length(buffer));
  end;

var
  locUcaBook : TUCA_DataBook;
  locSequence : TOrderedCharacters;
  locItem : TCldrCollationItem;
  i : Integer;
  locUcaProps : PUCA_PropBook;
  ucaFirstTable   : TucaBmpFirstTable;
  ucaSecondTable  : TucaBmpSecondTable;
  ucaoFirstTable   : TucaoBmpFirstTable;
  ucaoSecondTable  : TucaOBmpSecondTable;
  locHasProps : Boolean;
  s : string;
  serializedHeader : TSerializedCollationHeader;
  e : TCollationField;
begin
  locItem := ACollation.Find(AItemName);
  if (locItem = nil) then
    raise Exception.CreateFmt('Collation Item not found : "%s".',[AItemName]);
  locSequence := ARootChars.Clone();
  ForEachRule(locItem,ApplyStatementVisitorFunc,@locSequence);
  {for i := 0 to Length(locItem.Rules) - 1 do
    locSequence.ApplyStatement(@locItem.Rules[i]);}
  FillChar(locUcaBook,SizeOf(locUcaBook),0);
  locUcaBook.Version := ACollation.Version;
  locUcaBook.Backwards[1] := locItem.Backwards;
  locUcaBook.VariableWeight := locItem.VariableWeight;
  ComputeWeigths(@locSequence.Data[0],locSequence.ActualLength,ARootWeigths,locUcaBook.Lines);
  for i := 0 to Length(locUcaBook.Lines) - 1 do
    locUcaBook.Lines[i].Stored := True;
  locHasProps := (Length(locUcaBook.Lines) > 0);
  if not locHasProps then
    locUcaProps := nil
  else
    MakeUCA_Props(@locUcaBook,locUcaProps);
  try
    CheckEndianTransform(locUcaProps);
    if locHasProps then begin
      MakeUCA_BmpTables(ucaFirstTable,ucaSecondTable,locUcaProps);
      SetLength(ucaoSecondTable,100);
      MakeUCA_OBmpTables(ucaoFirstTable,ucaoSecondTable,locUcaProps);
    end;
    GenerateLicenceText(AStream);
    GenerateUCA_CLDR_Head(AStream,@locUcaBook,locUcaProps,locItem);
    if locHasProps then begin
      GenerateUCA_BmpTables(AStream,ANativeEndianStream,AOtherEndianStream,ucaFirstTable,ucaSecondTable);
      GenerateUCA_OBmpTables(AStream,ANativeEndianStream,AOtherEndianStream,ucaoFirstTable,ucaoSecondTable);
      GenerateUCA_PropTable(ANativeEndianStream,locUcaProps,ENDIAN_NATIVE);
      GenerateUCA_PropTable(AOtherEndianStream,locUcaProps,ENDIAN_NON_NATIVE);

      AddLine('{$ifdef ENDIAN_LITTLE}',AStream);
        s := GenerateEndianIncludeFileName(AStoreName,ekLittle);
        AddLine(Format('  {$include %s}',[ExtractFileName(s)]),AStream);
      AddLine('{$else ENDIAN_LITTLE}',AStream);
        s := GenerateEndianIncludeFileName(AStoreName,ekBig);
        AddLine(Format('  {$include %s}',[ExtractFileName(s)]),AStream);
      AddLine('{$endif ENDIAN_LITTLE}',AStream);
    end;
    GenerateUCA_CLDR_Registration(AStream,@locUcaBook,locItem);

    FillChar(serializedHeader,SizeOf(TSerializedCollationHeader),0);
    StringToByteArray(locItem.Base,serializedHeader.Base);
    StringToByteArray(ACollation.Version,serializedHeader.Version);
    StringToByteArray(ACollation.Language,serializedHeader.CollationName);
    serializedHeader.VariableWeight := Ord(locUcaBook.VariableWeight);
    SetBit(serializedHeader.Backwards,0,locUcaBook.Backwards[0]);
    SetBit(serializedHeader.Backwards,1,locUcaBook.Backwards[1]);
    SetBit(serializedHeader.Backwards,2,locUcaBook.Backwards[2]);
    SetBit(serializedHeader.Backwards,3,locUcaBook.Backwards[3]);
    serializedHeader.NoNormalization := Ord(not locItem.Normalization);
    if locHasProps then begin
      serializedHeader.BMP_Table1Length := Length(ucaFirstTable);
      serializedHeader.BMP_Table2Length := Length(TucaBmpSecondTableItem) *
                                           (Length(ucaSecondTable) * SizeOf(UInt24));
      serializedHeader.OBMP_Table1Length := Length(ucaoFirstTable) * SizeOf(Word);
      serializedHeader.OBMP_Table2Length := Length(TucaOBmpSecondTableItem) *
                                           (Length(ucaoSecondTable) * SizeOf(UInt24));
      serializedHeader.PropCount := locUcaProps^.ItemSize;
      serializedHeader.VariableLowLimit := locUcaProps^.VariableLowLimit;
      serializedHeader.VariableHighLimit := locUcaProps^.VariableHighLimit;
    end else begin
      serializedHeader.VariableLowLimit := High(Word);
      serializedHeader.VariableHighLimit := 0;
    end;
    serializedHeader.ChangedFields := 0;
    for e := Low(TCollationField) to High(TCollationField) do begin
      if (e in locItem.ChangedFields) then
        SetBit(serializedHeader.ChangedFields,Ord(e),True);
    end;
    ABinaryNativeEndianStream.Write(serializedHeader,SizeOf(serializedHeader));
    ReverseRecordBytes(serializedHeader);
    ABinaryOtherEndianStream.Write(serializedHeader,SizeOf(serializedHeader));
    if locHasProps then begin
      GenerateBinaryUCA_BmpTables(ABinaryNativeEndianStream,ABinaryOtherEndianStream,ucaFirstTable,ucaSecondTable);
      GenerateBinaryUCA_OBmpTables(ABinaryNativeEndianStream,ABinaryOtherEndianStream,ucaoFirstTable,ucaoSecondTable);
      GenerateBinaryUCA_PropTable(ABinaryNativeEndianStream,ABinaryOtherEndianStream,locUcaProps);
    end;
  finally
    locSequence.Clear();
    FreeUcaBook(locUcaProps);
  end;
end;

end.