"Голый код" про Immutable-строки и фабрику строк

unit kwStringFactory;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "ScriptEngine"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Scripting::ScriptEngine::PrimitiveWords::TkwStringFactory
//
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// ! Полностью генерируется с модели. Править руками - нельзя. !

{$Include ..\ScriptEngine\seDefine.inc}

interface

{$If not defined(NoScripts)}
uses
  l3Interfaces,
  kwString,
  kwStringList
  ;
{$IfEnd} //not NoScripts

{$If not defined(NoScripts)}
type
 TkwStringFactory = class(TkwStringList)
 protected
 // overridden protected methods
   procedure InitFields; override;
 public
 // public methods
   function MakeKW(const aValue: Il3CString): TkwString;
 public
 // singleton factory method
   class function Instance: TkwStringFactory;
    {- возвращает экземпляр синглетона. }
 end;//TkwStringFactory
{$IfEnd} //not NoScripts

implementation

{$If not defined(NoScripts)}
uses
  l3Base {a},
  SysUtils,
  l3String
  ;
{$IfEnd} //not NoScripts

{$If not defined(NoScripts)}


// start class TkwStringFactory

var g_TkwStringFactory : TkwStringFactory = nil;

procedure TkwStringFactoryFree;
begin
 l3Free(g_TkwStringFactory);
end;

class function TkwStringFactory.Instance: TkwStringFactory;
begin
 if (g_TkwStringFactory = nil) then
 begin
  l3System.AddExitProc(TkwStringFactoryFree);
  g_TkwStringFactory := Create;
 end;
 Result := g_TkwStringFactory;
end;


function TkwStringFactory.MakeKW(const aValue: Il3CString): TkwString;
//#UC START# *4F3E41C603BC_4F3E416701E8_var*
const
 cLimit = 300;
var
 l_Len : Integer;
 l_Index : Integer;
 l_KW : TkwString;
//#UC END# *4F3E41C603BC_4F3E416701E8_var*
begin
//#UC START# *4F3E41C603BC_4F3E416701E8_impl*
 l_Len := l3Len(aValue);
 if (l_Len < cLimit) then
 begin
  if FindData(aValue, l_Index) then
   Result := Self.Items[l_Index].Use
  else
  begin
   l_KW := TkwString.Create(aValue);
   Result := l_KW;
   Self.DirectInsert(l_Index, l_KW);
  end;//FindData(aValue, l_Index)
 end//l_Len < cLimit
 else
  Result := TkwString.Create(aValue);
//#UC END# *4F3E41C603BC_4F3E416701E8_impl*
end;//TkwStringFactory.MakeKW

procedure TkwStringFactory.InitFields;
//#UC START# *47A042E100E2_4F3E416701E8_var*
//#UC END# *47A042E100E2_4F3E416701E8_var*
begin
//#UC START# *47A042E100E2_4F3E416701E8_impl*
 inherited;
 Sorted := true;
//#UC END# *47A042E100E2_4F3E416701E8_impl*
end;//TkwStringFactory.InitFields

{$IfEnd} //not NoScripts

end.

unit l3TwoByteCString;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "L3"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Low Level::L3::l3CoreObjects::Tl3TwoByteCString
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// ! Полностью генерируется с модели. Править руками - нельзя. !

{$Include ..\L3\l3Define.inc}

interface

uses
  l3Interfaces,
  l3CProtoObject
  ;

type
 Tl3TwoByteCString = class(Tl3CProtoObject, Il3CString)
 private
 // private fields
   f_Chars : Word;
 protected
 // realized methods
   function pm_GetAsWStr: Tl3WString;
 public
 // public methods
   constructor Create(aChars: Word); reintroduce;
   class function Make(aChars: Word): Il3CString; reintroduce;
     {* Сигнатура фабрики Tl3TwoByteCString.Make }
 end;//Tl3TwoByteCString

implementation

uses
  l3String,
  l3Chars
  ;

// start class Tl3TwoByteCString

constructor Tl3TwoByteCString.Create(aChars: Word);
//#UC START# *4F5CBCAF00B4_4F5CBBE60070_var*
//#UC END# *4F5CBCAF00B4_4F5CBBE60070_var*
begin
//#UC START# *4F5CBCAF00B4_4F5CBBE60070_impl*
 inherited Create;
 f_Chars := aChars;
//#UC END# *4F5CBCAF00B4_4F5CBBE60070_impl*
end;//Tl3TwoByteCString.Create

class function Tl3TwoByteCString.Make(aChars: Word): Il3CString;
var
 l_Inst : Tl3TwoByteCString;
begin
 l_Inst := Create(aChars);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;

function Tl3TwoByteCString.pm_GetAsWStr: Tl3WString;
//#UC START# *46780DEF03E5_4F5CBBE60070get_var*
//#UC END# *46780DEF03E5_4F5CBBE60070get_var*
begin
//#UC START# *46780DEF03E5_4F5CBBE60070get_impl*
 Result.S := @f_Chars;
 Result.SLen := 2;
 Result.SCodePage := CP_ANSI;
//#UC END# *46780DEF03E5_4F5CBBE60070get_impl*
end;//Tl3TwoByteCString.pm_GetAsWStr

end.

function l3CStr(const aStr: Tl3WString): Il3CString;
  //overload;
  {-}
var
 l_S : Tl3InterfacedString;
begin
 if l3IsNil(aStr) then
 begin
  Result := Tl3CEmptyString.Instance;
  Exit;
 end;//l3IsNil(aStr)
 if l3IsAnsi(aStr.SCodePage) then
 begin
  if (aStr.SLen = 1) then
  begin
   Result := Tl3OneByteCString.Make(aStr.S^);
   Exit;
  end//aStr.SLen = 1
  else
  if (aStr.SLen = 2) then
  begin
   Result := Tl3TwoByteCString.Make(PWord(aStr.S)^);
   Exit;
  end//aStr.SLen = 2
  else
  if (aStr.SLen = 4) then
  begin
   Result := Tl3FourByteCString.Make(PLong(aStr.S)^);
   Exit;
  end;//aStr.SLen = 4
 end;//l3IsAnsi(aStr.SCodePage)
 l_S := Tl3InterfacedString.Make(aStr);
 try
  Result := l_S;
 finally
  l3Free(l_S);
 end;//try..finally
end;

unit tfwCStringFactory;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "ScriptEngine"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Scripting::ScriptEngine::CString::TtfwCStringFactory
//
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// ! Полностью генерируется с модели. Править руками - нельзя. !

{$Include ..\ScriptEngine\seDefine.inc}

interface

{$If not defined(NoScripts)}
uses
  l3Interfaces,
  l3PrimString,
  tfwCStringList
  ;
{$IfEnd} //not NoScripts

{$If not defined(NoScripts)}
type
 TtfwCStringFactory = class(TtfwCStringList)
 protected
 // overridden protected methods
   procedure InitFields; override;
 public
 // public methods
   class function C(const aString: AnsiString): Il3CString; overload; 
   class function C(const aString: Tl3WString): Il3CString; overload; 
   class function C(aString: Tl3PrimString): Il3CString; overload; 
   class function C(aChar: AnsiChar): Il3CString; overload; 
 public
 // singleton factory method
   class function Instance: TtfwCStringFactory;
    {- возвращает экземпляр синглетона. }
 end;//TtfwCStringFactory
{$IfEnd} //not NoScripts

implementation

{$If not defined(NoScripts)}
uses
  l3Base {a},
  l3String,
  tfwCStringArraySing,
  tfwCStringArraySing2,
  l3Types
  ;
{$IfEnd} //not NoScripts

{$If not defined(NoScripts)}


// start class TtfwCStringFactory

var g_TtfwCStringFactory : TtfwCStringFactory = nil;

procedure TtfwCStringFactoryFree;
begin
 l3Free(g_TtfwCStringFactory);
end;

class function TtfwCStringFactory.Instance: TtfwCStringFactory;
begin
 if (g_TtfwCStringFactory = nil) then
 begin
  l3System.AddExitProc(TtfwCStringFactoryFree);
  g_TtfwCStringFactory := Create;
 end;
 Result := g_TtfwCStringFactory;
end;

const
   { Local }
  cLimit = 200;

// start class TtfwCStringFactory

class function TtfwCStringFactory.C(const aString: AnsiString): Il3CString;
//#UC START# *4F47405B02FD_4F473F9402D8_var*
var
 i : Integer;
 l_Len : Integer;
 l_W   : Word;
//#UC END# *4F47405B02FD_4F473F9402D8_var*
begin
//#UC START# *4F47405B02FD_4F473F9402D8_impl*
 {.$IfNDef XE}
 l_Len := Length(aString);
 if (l_Len < cLimit) then
 begin
  if (l_Len = 1) then
   Result := C(aString[1])
  else
  if (l_Len = 2) then
  begin
   l_W := PWord(@(aString[1]))^;
   Result := TtfwCStringArraySing2.Instance.Items[l_W];
   if (Result = nil) then
   begin
    Result := l3CStr(aString);
    TtfwCStringArraySing2.Instance.Items[l_W] := Result;
   end;//Result = nil
  end//l_Len = 2
  else
   with Instance do
   begin
    if FindData(l3PCharLen(aString), i, SortIndex) then
     Result := Items[i]
    else
    begin
     Result := l3CStr(aString);
     DirectInsert(i, Result);
    end;//FindData(l3PCharLen(aString), i)
   end;//with Instance
 end//Length(aString) < cLimit
 else
 {.$EndIf XE}
  Result := l3CStr(aString);
//#UC END# *4F47405B02FD_4F473F9402D8_impl*
end;//TtfwCStringFactory.C

class function TtfwCStringFactory.C(const aString: Tl3WString): Il3CString;
//#UC START# *4F47407D0052_4F473F9402D8_var*
var
 i : Integer;
 l_W : Word;
//#UC END# *4F47407D0052_4F473F9402D8_var*
begin
//#UC START# *4F47407D0052_4F473F9402D8_impl*
 {.$IfNDef XE}
 if (aString.SLen < cLimit) then
 begin
  if (aString.SLen = 1) AND l3IsANSI(aString.SCodePage) then
  begin
   Assert(aString.S <> nil);
   Result := C(aString.S[0]);
  end//aString.SLen = 1
  else
  if (aString.SLen = 2) AND l3IsANSI(aString.SCodePage) then
  begin
   Assert(aString.S <> nil);
   l_W := PWord(aString.S)^;
   Result := TtfwCStringArraySing2.Instance.Items[l_W];
   if (Result = nil) then
   begin
    Result := l3CStr(aString);
    TtfwCStringArraySing2.Instance.Items[l_W] := Result;
   end;//Result = nil
  end//aString.SLen = 2
  else
   with Instance do
   begin
    if FindData(aString, i, SortIndex) then
     Result := Items[i]
    else
    begin
     Result := l3CStr(aString);
     DirectInsert(i, Result);
    end;//FindData(l3PCharLen(aString), i)
   end;//with Instance
 end//Length(aString) < cLimit
 else
 {.$EndIf XE}
  Result := l3CStr(aString);
//#UC END# *4F47407D0052_4F473F9402D8_impl*
end;//TtfwCStringFactory.C

class function TtfwCStringFactory.C(aString: Tl3PrimString): Il3CString;
//#UC START# *4F4740A802A8_4F473F9402D8_var*
var
 l_S : Tl3WString;
//#UC END# *4F4740A802A8_4F473F9402D8_var*
begin
//#UC START# *4F4740A802A8_4F473F9402D8_impl*
 if (aString = nil) then
  Result := l3CStr('')
 else
 begin
  l_S := aString.AsWStr;
  if (l_S.SLen < cLimit) then
   Result := C(l_S)
  else
   Result := l3CStr(aString);
 end;//aString = nil
//#UC END# *4F4740A802A8_4F473F9402D8_impl*
end;//TtfwCStringFactory.C

class function TtfwCStringFactory.C(aChar: AnsiChar): Il3CString;
//#UC START# *4F50782700AA_4F473F9402D8_var*
//#UC END# *4F50782700AA_4F473F9402D8_var*
begin
//#UC START# *4F50782700AA_4F473F9402D8_impl*
 Result := TtfwCStringArraySing.Instance.Items[Ord(aChar)];
 if (Result = nil) then
 begin
  Result := l3CStr(aChar);
  TtfwCStringArraySing.Instance.Items[Ord(aChar)] := Result;
 end;//Result = nil
//#UC END# *4F50782700AA_4F473F9402D8_impl*
end;//TtfwCStringFactory.C

procedure TtfwCStringFactory.InitFields;
//#UC START# *47A042E100E2_4F473F9402D8_var*
//#UC END# *47A042E100E2_4F473F9402D8_var*
begin
//#UC START# *47A042E100E2_4F473F9402D8_impl*
 inherited;
 Sorted := true;
//#UC END# *47A042E100E2_4F473F9402D8_impl*
end;//TtfwCStringFactory.InitFields

{$IfEnd} //not NoScripts

end.