{
    This file is part of chepersy
    Copyright (c) 2004-2008 by Anton Rzheshevski (chebmaster@mail.ru),

    See the file COPYING.CPS, included in this distribution,
    for details about the copyright.

    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.

 **********************************************************************}

  procedure CpsValidate(n: string); overload;
  begin
    n:=uppercase(trim(n));
    if copy(n, 1, 1) = '*' then n:= copy(n, 2, length(n) - 2);
    if not CpsValid then ClassesRegistrationStart;
    if CpsFinalized then Die(MI_ERROR_PROGRAMMER_NO_BAKA, [PervertedFormat(RuEn(
      'Попытка зарегистрировать тип %0 когда регистрация уже завершена!',
      'Attempt to register type %0 when registering is finalized!'),
       [n])]);
  end;
  
  procedure CpsValidate(i: PTypeInfo); overload;
  begin
    CpsValidate(i^.Name);
  end;

  function VarRecTypeName(vt: Integer): WideString;
  begin
    case vt of
      vtInteger    : Result:=RuEn('целый','integer');
      vtBoolean    : Result:=RuEn('булев','boolean');
      vtChar       : Result:= 'Char';
      vtExtended   : Result:=RuEn('вещественный','extended');
      vtString     : Result:=RuEn('строка','string');
      vtPointer    : Result:=RuEn('указатель','pointer');
      vtPChar      : Result:= 'PChar';
      vtObject     : Result:=RuEn('объект','object');
      vtClass      : Result:=RuEn('класс','class');
      vtWideChar   : Result:= 'WideChar';
      vtPWideChar  : Result:= 'PWideChar';
      vtAnsiString : Result:=RuEn('строка','string');
      vtCurrency   : Result:= 'currency';
      vtVariant    : Result:=RuEn('вариант','variant');
      vtInterface  : Result:=RuEn('интерфейс','interface');
      vtWideString : Result:=RuEn('строка (utf16)','widestring');
      vtInt64      : Result:=RuEn('64-битный целый','64-bit integer');
     {$ifdef fpc}
      vtQWord      : Result:=RuEn('64-битный беззнаковый целый','64-bit unsigned integer');
     {$endif}
    else
      Result:=RuEn('неизвестный','unknown');
    end;
  end;

  function CheckVarRecType(V: TVarRec; IntendedType: array of integer): WideString;
  var
    i: integer;
  begin
    Result:='';
    for i:=0 to high(IntendedType) do
      if V.Vtype = IntendedType[i] then exit;
    Result:= VarRecTypeName(V.vtype) + ' = ' + VarRecToWide(V);
  end;


  //this bunny performs the actual work for ListFields.

  function _ListRecordFields(packd, addrrequired: boolean; base: pointer;
                             startoffset: longint; v: array of const): TFieldDesc;
  var
    ii, i, CurrentField, Off: integer;
    w, StringID: WideString;
    _Name: string;
    function ErFil: WideString;
    begin
      Result:= RuEn('Ошибка в описании поля №','Error parsing field #')
       + IntToStr(CurrentField);
    end;
    procedure swape (var a, b: TFieldInfo);
    var
      c: TFieldInfo;
    begin
      move(a, c, SizeOf(a));
      move(b, a, SizeOf(a));
      move(c, b, SizeOf(a));
    end;
  begin
    Assert(not(packd and addrrequired), 'Invalid parameter combination in the call to _ListRecordFields()');
    SetLength(result.Field, 0);
    if length(v) = 0 then begin
      Result.size:= 0;
      Exit;
    end;
    //parsing the fields
    ii:= 0;
    while ii < length(v) do begin
//addlog('-- ii %0',[ii]);
      CurrentField:= length(result.Field) + 1;
      SetLength(result.Field, CurrentField);

      with result.Field[high(result.Field)] do begin
        w:= CheckVarRecType(v[ii], [vtString, vtPChar, vtChar, vtWideChar, vtPWideChar, vtAnsiString, vtWideString]);
        if w <> '' then Die(ErFil+RuEn(
          ':'#10#13'  ожидалось имя поля, найден %0',
          ':'#10#13'  expected field name, found %0') ,[w]);
        _Name:= Trim(Utf8Encode(UpperCase(VarRecToWide(v[ii]))));
        if _Name='' then Die(ErFil+RuEn(
          ':'#10#13'  имя поля не может быть пустой строкой',
          ':'#10#13'  field name must not be empty'));
        if _Name[1] = '*' then Die(ErFil+RuEn(
          ':'#10#13'  ожидалось имя поля, найдено имя типа (%0)',
          ':'#10#13'  expected field name, found type name (%0)') ,[_Name]);
        if _Name[1] = '-' then begin
          Skip:= True;
          _Name:= Trim(Copy(_Name, 2, length(_Name) - 1));
        end
        else
          Skip:= false;
        Name:= NameSpace.Add(_Name);
        for i:=0 to CurrentField - 2 do
          if Name = Result.Field[i].Name then Die(ErFil + RuEn(
            ' (%0):'#10#13'  поле с таким именем уже есть! (№%1)',
            ' (%0):'#10#13'  duplicate field name! (vs #%1)')
            ,[Name, i]);
//addlog('-- b %0',[namespace[Name]]);
        if addrrequired then begin
          inc(ii);
          if ii > high(v) then Die(ErFil + RuEn(
            ' (%0):'#10#13'  ожидался адрес поля, найден конец массива',
            ' (%0):'#10#13'  expected field address, found array end')
            ,[NameSpace[Name]]);
          w:= CheckVarRecType(v[ii], [vtPointer]);
          if w <> '' then Die(ErFil+RuEn(
            ' (%0):'#10#13'  ожидался адрес поля, найден %1',
            ' (%0):'#10#13'  expected field address, found %1') ,[NameSpace[Name], w]);
          if not Assigned(v[ii].VPointer) then Die (ErFil+RuEn(
            ' (%0):'#10#13'  ожидался адрес поля, найден NIL',
            ' (%0):'#10#13'  expected field address, found NIL'));
          {$ifdef fpc}
          offset:= int64(ptruint(v[ii].VPointer)) - int64(ptruint(base));
          {$else}
          //E2003 Undeclared identifier: 'ptruint'
          offset:= int64(cardinal(v[ii].VPointer)) - int64(cardinal(base));
          {$endif}
          if offset < 0 then Die(ErFil+RuEn(
            ' (%3):'#10#13'  ожидался адрес поля, найден дикий указатель'#10#13'  (%0 при базе %1, смещение %2)',
            ' (%3):'#10#13'  expected field address, found wild pointer'#10#13'  (%0 while base is %1, offset %2)')
            ,[v[ii].VPointer, base, offset, NameSpace[Name]]);
        end;
        inc(ii);
        if ii > high(v) then tind:=-1
        else
          Case v[ii].Vtype of
            vtString, vtPChar, vtChar, vtWideChar, vtPWideChar, vtAnsiString, vtWideString: begin
              StringID:= UpperCase(VarRecToWide(v[ii]));
              if Copy(StringId, 1, 1) <> '*' then begin
                //this isn't a type name this is the next field name!
                tind:= -1;
                dec(ii)
              end
              else begin
                StringID:= trim(copy(StringId, 2, length(StringID) - 1));
                if StringID = 'POINTER' then begin
                  tind:= tind_pointer;
                  skip:= True;
                end
                else begin
                  if StringID = 'METACLASS' then tind:= StdTindMetaclass
                  else begin
                    tind:= TypeNameSpace.Ind(StringID, 0);
                    if tind < 0 then Die (ErFil + RuEn(
                      ' (%0):'#10#13'  неизвестный тип "%1", зарегистрируйте сначала.',
                      ' (%0):'#10#13'  unknown type "%1", register it prior.')
                      ,[NameSpace[Name], StringID]);
                  end;
                end;
              end;
            end;
            vtPointer: begin
              if not Assigned(v[ii].VPointer) then Die(ErFil + RuEn(
                ' (%0):'#10#13'  ожидался тип поля, найден NIL',
                ' (%0):'#10#13'  expected field type, found NIL')
                ,[NameSpace[Name]]);
              StringId:= UpperCase(PTypeInfo(v[ii].VPointer)^.Name);
              tind:= TypeNameSpace.Ind(StringID, 0);
  //addlog('^^^^ %3  %0  %1  %4  %2',[StringID, tind, TypeNameSpace[tind], NameSpace[Name], NameSpace[types[tind].name]]);
              if tind < 0 then begin
                if PTypeInfo(v[ii].VPointer)^.Kind = tkUnknown
                then Die (ErFil + RuEn(
                   ' (%0):'#10#13'  тип "%1" не поддерживаемый RTTI.'#10#13
                   + '  Если это метакласс - используйте строковую константу ''*METACLASS'' для задания типа поля.',
                   ' (%0):'#10#13'  type "%1" is of kind not supported by RTTI.'#10#13
                   + '  If it''s an metaclass, use the string ''*METACLASS'' to define the field type.')
                   ,[NameSpace[Name], StringId])
                else Die (ErFil + RuEn(
                  ' (%0):'#10#13'  неизвестный тип "%1", зарегистрируйте сначала.',
                  ' (%0):'#10#13'  unknown type "%1", register it prior.')
                  ,[NameSpace[Name], StringID]);
              end;
            end;
            vtInteger: begin
              if (v[ii].VInteger <> CPS_POINTER) and (v[ii].VInteger <> CPS_METACLASS) then
                Die(ErFil+RuEn(
                  ': ожидался тип поля, найден %0',
                  ': expected field type, found %0') ,
                  [CheckVarRecType(v[ii], [-1])])
              else begin
                if (v[ii].VInteger = CPS_POINTER) then begin
                  Skip:= True;
                  tind:= tind_pointer;
                end
                else tind:= StdTindMetaclass;
              end;
            end;
          else
            Die(ErFil+RuEn(
              ': ожидался тип поля, найден %0',
              ': expected field type, found %0') ,
              [CheckVarRecType(v[ii], [-1])]);
          end;
        inc(ii);
      end;
    end;
    //fill in the skipped type definitions
    ii:=  StdTindDword;
    for i:= high(result.Field) downto 0 do begin
      if result.Field[i].tind >= 0
        then ii:= result.Field[i].tind
        else begin
          result.Field[i].tind:= ii;
          if ii = StdTindPointer
            then result.Field[i].Skip:= true;
        end;
    end;

    //calculate or check the offsets
    Off:= startoffset;
    for i:=0 to high(Result.Field) do
      with Result.Field[i] do begin
        CurrentField:= i + 1;
        if addrrequired and (offset <> Off) then begin
          if i = 0
            then Die(RuEn(
              '%0 (%1):'#10#13'  смещение первого поля %2, а должно быть %3.',
              '%0 (%1):'#10#13'  the first field offset is %2 while it should be %3.')
              ,[ErFil, NameSpace[Name], offset, Off])
            else
              Die(RuEn(
                '%0 (%1):'#10#13'  нарушен порядок. Смещение %2, должно быть %3'#10#13'  Предыдущее поле:'#10#13'    %4:%5, размер %6 смещение %7',
                '%0 (%1):'#10#13'  wrong order. Offset is %2, should be %3'#10#13'  Previous field is'#10#13'    %4:%5, size %6 offset %7')
                ,[ErFil, NameSpace[Name], offset, Off,
                  NameSpace[Result.Field[i - 1].Name],
                  TypeNameSpace[Result.Field[i - 1].tind],
                  Types[Result.Field[i - 1].tind].Size,
                  Result.Field[i - 1].offset]);
        end
        else
          offset:= Off;
        if packd
          then inc(Off, Types[tind].Size)
          else Off:= GetAlignedNextOffset(Off + types[tind].Size);
      end;
    result.Size:= Off;
  end;

  function ExplainProperCallingR(tk: TTypeKind): WideString;
  begin
    case tk of
      tkSet: Result:= 'RegType(TypeInfo(ВашТип), TypeInfo(БазовыйПеречислимыйТип))';
      tkEnumeration, tkClass: Result:= 'RegType(TypeInfo(ВашТип))';
      tkRecord: Result:= 'RegType(TypeInfo(ВашТип), SizeOf(ВашТип), [<описание полей>]) или RegType(''*ИмяВашегоТипа'', SizeOf(ВашТип), [<описание полей>])';
      tkDynArray: Result:= 'RegType(TypeInfo(ВашТип), TypeInfo(БазовыйТип)) или RegType(TypeInfo(ВашТип), n, TypeInfo(БазовыйТип))';
      tkArray: Result:= 'RegType(TypeInfo(ВашТип), TypeInfo(БазовыйТип), TypeInfo(ИндексныйПеречислимыйТип)) или RegType(TypeInfo(ВашТип), TypeInfo(БазовыйТип), [Low0, high0 ... LowN, HighN])';
    else
      Result:='Нельзя зарегистрировать подобную разновидность типа'
    end;
  end;


  function ExplainProperCallingE(tk: TTypeKind): WideString;
  begin
    case tk of
      tkSet: Result:= 'RegType(TypeInfo(YourType), TypeInfo(BaseEnumeratedType))';
      tkEnumeration, tkClass: Result:= 'RegType(TypeInfo(YourType))';
      tkRecord: Result:= 'RegType(TypeInfo(YourType), SizeOf(YourType), [<fields description>]) or RegType(''*YourTypeStringName'', SizeOf(YourType), [<fields description>])';
      tkDynArray: Result:= 'RegType(TypeInfo(YourType), TypeInfo(BaseType)) or RegType(TypeInfo(YourType), n, TypeInfo(BaseType))';
      tkArray: Result:= 'RegType(TypeInfo(YourType), TypeInfo(BaseType), TypeInfo(EnumeratedIndexingType)) or RegType(TypeInfo(YourType), TypeInfo(BaseType), [Low0, high0 ... LowN, HighN])';
    else
      Result:='You cannot register this kind of type'
    end;
  end;

  function ExplainProperCalling(tk: TTypeKind): WideString;
  begin
    if MotherState^.IsRussian
      then Result:= ExplainProperCallingR(tk)
      else Result:= ExplainProperCallingE(tk);
  end;

  function TypeKindName(tk: TTypeKind): WideString;
  begin
    case tk of
      tkInteger: Result:=RuEn('целый','integer');
      tkChar: Result:='Char';
      tkEnumeration: Result:=RuEn('перечислимый','enumerated');
      tkFloat: Result:=RuEn('вещественный','floating-point');
      tkSet: Result:=RuEn('множество','set');
      tkMethod: Result:=RuEn('метод','method');
      {$ifdef fpc}
      //Turbo Delphi:
      //  E2003 Undeclared identifier: 'tkSString'
      //  E2003 Undeclared identifier: 'tkAString'
      tkSString: Result:=RuEn('короткая строка','short string');
      {$endif}
      tkLString {$ifdef fpc}, tkAString{$endif}: Result:=RuEn('строка','string');
      tkWString, tkUstring: Result:= 'WideString';
      tkVariant: Result:=RuEn('вариант','variant');
      tkArray: Result:=RuEn('массив','array');
      tkRecord: Result:=RuEn('запись','record');
      tkInterface: Result:=RuEn('интерфейс','interface');
      tkClass: Result:=RuEn('класс','class');
      {$ifdef fpc}
      //E2003 Undeclared identifier: 'tkObject'
      tkObject: Result:=RuEn('объект','object');
      {$endif}
      tkWChar: Result:='WideChar';
      {$ifdef fpc}
      tkBool: Result:=RuEn('булев','boolean');
      {$endif}
      tkInt64: Result:='int64';
      {$ifdef fpc}
      tkQWord: Result:='QWORD';
      {$endif}
      tkDynArray: Result:=RuEn('динамический массив','dynamic array');
      {$ifdef fpc}
      tkInterfaceRaw: Result:=RuEn('raw интерфейс','interface raw');
      {$endif}
    else
      Result:=RuEn('неизвестный','unknown');
    end;
  end;

  function ExplainImproperCalling(info: PTypeInfo; details: WideString): WideString;
  begin
    Result:= PervertedFormat(RuEn(
        'Неправильный вызов RegType() для "%0" (%1):'#10#13'  %2'#10#13'  Правильный формат: %3',
        'Invalid call to RegType() for "%0" (%1):'#10#13'  %2'#10#13'  The correct call would be: %3'
        ), [string(info^.Name), TypeKindName(info^.Kind), details, ExplainProperCalling(info^.Kind)]);
  end;

  procedure ListFields(v: array of const);
  var
    desc: TFieldDesc;
    i, j, k, t, r, soff: longint;
    F: TFieldInfo;
  begin
    FieldsRegistrationInProgress:=Yes;
//addlog('-- o %0', [CurrentObjectInd.Length]);
    if Fields[CurrentObjectInd.Last].Length = 0
      then soff:= ExtraInfoOffset
      else with Fields[CurrentObjectInd.Last].Last do
        soff:= GetAlignedNextOffset(offset + types[tind].Size);
//addlog('--a');
    desc:= _ListRecordFields(false, true, pointer(CurrentObject.Last), soff, v);
//addlog('--b');
    //add the parsed list content to the class' fields list
    for i:=0 to high(desc.Field) do begin
      soff:= desc.Field[i].offset;
      t:= desc.Field[i].tind;
      case Types[t].Kind of
        //substitute the records and enumerable arrays with their elements.
        //  Architecturally stupid but required for backward compatibility.
        fk_record, fk_packed_record: begin
          r:= Types[t].RecordInd;
          for j:=0 to Fields[r].High do begin
            F:= Fields[r][j];
            F.Skip:= F.Skip or desc.Field[i].Skip;
            F.Name:= NameSpace.Add(NameSpace[desc.Field[i].Name] + '.' + NameSpace[F.Name]);
            inc(F.offset, soff);
            Fields[CurrentObjectInd.Last].Add(F);
          end;
        end;
        fk_enumind_array: begin
          F.tind:= Types[t].BaseTypeInd;
          k:=Types[t].IndEnumInd;
          For j:=0 to Enums[k].High do begin
            F.Name:= NameSpace.Add(NameSpace[desc.Field[i].Name] + '['
              + NameSpace[Enums[k][j]] + ']');
            F.offset:= soff + j * Types[F.tind].Size;
            F.Skip:= desc.Field[i].Skip;
            Fields[CurrentObjectInd.Last].Add(F);
          end;
        end;
      else
        Fields[CurrentObjectInd.Last].Add(desc.Field[i]);
      end;
    end;
  end;

  //class, enum
  procedure RegType(info: PTypeInfo); overload;
  var
    data: PTypeData;
    C: TClass;
  begin
    CpsValidate(info);
    case info^.Kind of
      tkClass: begin
        data:=  GetTypeData(info);
        C:= data^.ClassType;
        if IsCTPDescendant(C)
          then RegTypeClass(CManagedObject(C))
          else Die(PervertedFormat(RuEn('НеДоделано: не могу зарегистрировать %0, он не является потомком TTrulyPersistent!','Not Implemented Yet: unable to register %0, it''s not a TTrulyPersistent descendant!'), [ansistring(C.ClassName)]));
      end;
      tkEnumeration, tkInteger: RegTypeEnum(info);
    else
      Die(ExplainImproperCalling(info, RuEn('без дополнительных параметров','no additional parameters')));
    end;
  end;



  procedure AddRecordType(name: string; _kind: TFieldKind; var fd: TFieldDesc);
  var
    T: TTypeRecord;
    i: integer;
  begin
    name:=UpperCase(name);
    if TypeNameSpace.Ind(name, 0) >=0 then begin
      //T.name:=NameSpace.Ind(Info^.Name); //needed for the error message
//      if VerboseLog then AddLog('HINT: Type "%0" is alraedy registered! (index %1)', [stringId, NameSpace.Ind(name{Info^.Name}, 0)]);
      EXIT;
    end;
    FillChar(T, SizeOf(T), 0);
    T.name:=NameSpace.Add(name);
    TypeNameSpace.Add(name);
    T.ClassName:=ClassNameSpace.Add(name);
    Records.Add(TypeNameSpace.Ind(name, 0));
    ClassAncestors.Length:= Records.Length;
    Fields.Increment;
    SaveableFields.Increment;
    T.RecordInd:=Records.High;
    T.Info:=New(PTypeInfo);
    T.Info^.Kind:=tkRecord;
    T.Info^.Name:=name;
    T.Data:=nil;
    T.Size:= fd.Size;
    T.proc:= @RP_Record;
    T._class:= nil;
    For i:=0 to high(fd.Field) do Fields.Last.Add(fd.Field[i]);
    T.kind:= _kind;
//addlog('== %0  %1', [ord(_kind), name]);
    Types.Add(T);
    if MotherState^.VerboseLog then begin
      AddLog(RuEn('  Тип: %0 (%2 / %1)','  Type: %0 (%2 / %1)')
      ,[NameSpace[T.name], FieldKindToStr(T.Kind), T.Size]);
      with Fields.Last do
        for i:= 0 to High do
          with D[i] do
            if Skip then
              AddLog(RuEn('    поле','    field') +' "%0:%3", %1 / %2, '+RuEn('опускаемое.','skipped.'),
                [NameSpace[name],offset,Types[Tind].size, NameSpace[Types[tind].Name]])
            else
              AddLog(RuEn('    поле','    field') +' "%0:%3", %1 / %2.',
                [NameSpace[name],offset,Types[Tind].size, NameSpace[Types[Tind].Name]]);
    end;
  end;


  //record
  procedure RegType(tname: string; Size: longint; v: array of const);  overload;
  var
    f: TFieldDesc;
    ps: integer;
    fi: TTypeInfo;
  begin
    CpsValidate(tname);
    fi.Name:= tname; //fake TypeInfo
    fi.kind:= tkRecord;
    if copy(tname, 1, 1) <> '*' then
      Die(ExplainImproperCalling(@fi, RuEn(
        'имя типа не предваряется звёздочкой',
        'type name is not preceeded by asterisk!')));
    fi.name:=copy(tname, 2, length(tname) - 1);
    f:=_ListRecordFields(true, false, nil, 0, v);
    if f.Size = Size then begin
      //register a packed record
      AddRecordType(fi.name, fk_packed_record, f);
    end
    else begin
      ps:= f.Size;
      f:=_ListRecordFields(false, false, nil, 0, v);
      if f.Size <> Size then
        Die(ExplainImproperCalling(@fi, PervertedFormat(RuEn(
          'общий размер полей не совпадает!'#10#13'  Указан %0, но они занимают %1 (упакованные %2)',
          'the fields don''t add up!'#10#13'  The size specified is %0, the fields take %1 (%2 if packed)'),
          [Size, f.Size, ps])))
      else begin
       // register a non-packed record
        AddRecordType(fi.name, fk_record, f);
      end;
    end;
  end;

{$ifdef fpc}
  procedure RegType(info: PTypeInfo; Size: longint; v: array of const);  overload;
  begin
    CpsValidate(info);
    if info^.Kind <> tkRecord then
      ExplainImproperCalling(info, RuEn(
          '..., SizeOf(ВашаЗапись), [описание полей])',
          '..., SizeOf(YourRecord), [fields description]'));
    RegType('*' + info^.Name, Size, v);
  end;
{$endif}


  //dynamic array, set
  procedure RegType(info, base: PTypeInfo);  overload;
    procedure ComplainMeImproperCalling();
    begin
      Die(ExplainImproperCalling(info, '(..., ' + TypeKindName(base^.Kind)+')'))
    end;
  begin
    CpsValidate(info);
    case info^.Kind of
      tkDynArray: begin
        RegTypeDynArray1d(info, base);
      end;
      tkSet: begin
        if base^.Kind <> tkEnumeration then ComplainMeImproperCalling;
        RegTypeEnum(base);
        RegTypeSet(info, base);
      end;
    else
      ComplainMeImproperCalling();
    end;
  end;
  
  //returns tind
  function ProcessTypeName(
    hostinfo: PTypeInfo; var typename: string; nickN, nickA: WideString): longint;
  begin
    typename:=trim(uppercase(typename));
    if copy(typename, 1, 1) <> '*' then
      Die(ExplainImproperCalling(@hostinfo, PervertedFormat(RuEn(
        'имя %1 типа "%0" не предваряется звёздочкой.',
        'the %1 type name "%0" is not preceeded by asterisk.'),
        [typename, nickA])));
    typename:= copy(typename, 2, length(typename) - 1);
    Result:= TypeNameSpace.ind(typename, 0);
    if Result < 0 then
      Die(ExplainImproperCalling(@hostinfo, PervertedFormat(RuEn(
        'имя %1 тип "%0" не зарегистрирован.',
        'the %1 type "%0" not registered.'),
        [typename, nickN])));
  end;
  
  function _RegTypeArrayStartS(var T: TTypeRecord; ArrayInfo: PTypeInfo; BaseTind: integer): string;
  var
    StringID: ansistring;
  begin
    FillChar(T, Sizeof(T), 0);
    StringID:=UpperCase(ArrayInfo^.Name);
    if TypeNameSpace.Ind(StringID, 0) >=0 then begin
      Result:='';
      Exit;
    end;
//    TypeNameSpace.Add(StringId);
    Result:= StringID;
    T.Kind:=fk_dynamic_array;
    T.Info:=ArrayInfo;
    T.Data:=GetTypeData(ArrayInfo);
    T.name:=NameSpace.Add(StringId);
    T.BaseTypeInd:= BaseTind;
    T.size:=4;
  end;

  procedure RegTypeDynArray1dS(ArrayInfo: PTypeInfo; BaseS: integer);
  var
    T: TTypeRecord;
    StringID: ansistring;
  begin
    StringID:= _RegTypeArrayStartS(T, ArrayInfo, BaseS);
    if StringID = '' then Exit;
    T.proc:=@RP_GenericDynArray;
    T.DynArrayLevel:=1;
    T.DynArrayBaseInd:= BaseS;
    if not Assigned(Types[T.BaseTypeInd].proc) then
      DieTypeFailed(T,
        RuEn('Базовый тип "','The base type "')
        +TypeNameSpace[BaseS]
        +RuEn('" не имеет обрабатывающей процедуры.', '" does not have a processing procedure.'));
    Types.Add(T);
    TypeNameSpace.Add(StringID);
    if MotherState^.VerboseLog then AddLog(RuEn('  Тип:','  Type:') +' %0 = array of %1' ,[NameSpace[T.name], NameSpace[Types[T.BaseTypeInd].Name]]);
  end;
  
  procedure RegTypeDynArrayNdS(Dimensions: integer; ArrayInfo: PTypeInfo; BaseTind: integer);
  var
    T, FT: TTypeRecord;
    j, i, ii: integer;
    FakeInfo: PTypeInfo;
    nm, newname: string;
  begin
    nm:= _RegTypeArrayStartS(T, ArrayInfo, BaseTind);
    if nm='' then Exit;
    FT:=T;
    For j:=1 to Dimensions - 1 do begin
      //adding the fake types...
      newname:=NameSpace[T.name] + '@' + IntToStr(j);
      FT.name:=NameSpace.Add(newname);
      if j > 1 then begin
        FT.BaseTypeInd:= i;
        _ChooseArrayType(FT, FakeInfo);
      end
      else begin
        T.proc:=@RP_GenericDynArray;
        T.DynArrayLevel:=1;
        T.DynArrayBaseInd:= BaseTind;
      end;

      New(FakeInfo);
      FakeInfo^.Name:=newname;
      FT.Info:=FakeInfo;
      FT.Data:=New(PTypeData);
//      FT.name:=NameSpace.Add(newname);
      ii:=TypeNameSpace.Add(newname);
      i:= Types.Add(FT);
      if MotherState^.VerboseLog then AddLog(RuEn('  Подложный тип:','  Fake type:') + ' %0 = array of %1' ,[NameSpace[FT.name],  TypeNameSpace[FT.BaseTypeInd]]);
//addlog('-%0 %1 %2',[i, ii,  TypeNameSpace[ii]]);
    end;
    T.BaseTypeInd:=i;
    _ChooseArrayType(T, FakeInfo);
    Types.Add(T);
    TypeNameSpace.Add(nm);
    if MotherState^.VerboseLog then AddLog(RuEn('  Тип:','  Type:') +' %0 = array of %1' ,[NameSpace[T.name], NameSpace[Types[T.BaseTypeInd].Name]]);
  end;

  //dynamic array
  procedure RegType(info: PTypeInfo; base: string);  overload;
  var i: integer;
  begin
    CpsValidate(info);
    i:= ProcessTypeName(info, base, RuEn('базовый','base'), RuEn('базового','base'));
    case info^.Kind of
      tkDynArray:
        RegTypeDynArray1dS(info, i);
    else
      Die(ExplainImproperCalling(info, '(..., ''*' + base +''')'))
    end;
  end;

  procedure RegType(info: PTypeInfo; n: integer; base: PTypeInfo);  overload;
  begin
    CpsValidate(info);
    if (info^.Kind <> tkDynArray) or (n < 1) or (n > CPS_MAX_MULTIDIM_ARRAY)
      then Die(ExplainImproperCalling(info, '(..., ' +IntToStr(n) + ', ' + TypeKindName(base^.Kind)+')'));
    if n = 1 then RegTypeDynArray1d(info, base)
             else RegTypeDynArrayNd(n, info, base);
  end;
  
  procedure RegType(info: PTypeInfo; n: integer; base: string);  overload;
  var i: integer;
  begin
    CpsValidate(info);
    i:= ProcessTypeName(info, base, RuEn('базовый','base'), RuEn('базового','base'));
    if (info^.Kind <> tkDynArray) or (n < 1) or (n > CPS_MAX_MULTIDIM_ARRAY)
      then Die(ExplainImproperCalling(info, '(..., ' +IntToStr(n) + ', ''*' + base+''')'));
    if n = 1 then RegTypeDynArray1dS(info, i)
             else RegTypeDynArrayNdS(n, info, i);
  end;

  //enum-indexed array
  procedure RegTypeEIA(Info: PTypeInfo; BaseTind: integer; IndEnum: PTypeInfo);
  var
    T: TTypeRecord;
    F: TFieldInfo;
    i: integer;
    StringID: ansistring;
  begin
    if (info^.Kind <> tkArray) or not (indEnum^.Kind in [tkEnumeration, tkInteger])
      then Die(ExplainImproperCalling(info, '(..., ' + TypeNameSpace[BaseTind] + ', ' +TypeKindName(indEnum^.Kind)+')'));
    RegTypeEnum(indEnum);
    FillChar(T, Sizeof(T), 0);
    StringID:=UpperCase(Info^.Name);
    if TypeNameSpace.Ind(StringID, 0) >=0 then begin
      //T.name:=NameSpace.Ind(Info^.Name); //needed for the error message
//      if VerboseLog then AddLog('HINT: Type "%0" is alraedy registered! (index %1)', [stringId, NameSpace.Ind(Info^.Name, 0)]);
      EXIT;
    end;

    T.BaseTypeInd:= BaseTind;

    T.IndEnumInd:=TypeNameSpace.Ind(AnsiString(IndEnum^.Name), 0);

    T.IsEnumIndArray:=Yes;
    T.Info:=Info;
    T.Data:=GetTypeData(Info);

    T.name:=NameSpace.Add(StringId);
    TypeNameSpace.Add(StringId);
    T.proc:=@RP_Record;
    T.Kind:=fk_enumInd_Array;
    T.size:= Types[T.BaseTypeInd].Size * Enums[T.IndEnumInd].Length;


    T.ClassName:=ClassNameSpace.Add(StringID);
    T._class:= nil;
    Records.Add(TypeNameSpace.Ind(StringID, 0));
    ClassAncestors.Length:= Records.Length;
    Fields.Increment;
    SaveableFields.Increment;

    FillChar(f, SizeOf(f), 0);
    F.tind:= T.BaseTypeInd;
    For i:=0 to Enums[T.IndEnumInd].High do begin
      F.name:= Enums[T.IndEnumInd][i];
      F.offset:= i * Types[T.BaseTypeInd].Size;
      F.Skip:= false;
      Fields.Last.Add(F);
    end;

    Types.Add(T);
    if MotherState^.VerboseLog then AddLog(RuEn('  Тип: %0 (%1)','  Type: %0 (%1)')
      ,[NameSpace[T.name], FieldKindToStr(T.Kind)]);
  end;

  procedure RegType(Info, BaseType, IndEnum: PTypeInfo);overload;
  var i: integer;
  begin
    CpsValidate(info);
    i:=TypeNameSpace.Ind(AnsiString(BaseType^.Name), 0);
    if i < 0 then
      Die(ExplainImproperCalling(info, RuEn('Базовый тип ','The base type ')+AnsiString(BaseType^.Name)
                        + RuEn(' ещё не зарегистрирован.'
                              ,' is not registered.')));
    RegTypeEIA(Info, i, IndEnum);
  end;

  procedure RegType(Info: PTypeInfo; BaseType: string; IndEnum: PTypeInfo);overload;
  var i: integer;
  begin
    CpsValidate(info);
    i:= ProcessTypeName(Info, BaseType, RuEn('базовый','base'), RuEn('базового','base'));
    RegTypeEIA(Info, i, IndEnum);
  end;

  procedure RegType(Info, BaseType: string; IndEnum: PTypeInfo);overload;
  var fi: PTypeInfo;
  begin
    CpsValidate(Info);
    Info:=trim(upperCase(info));
    New(fi);
    fi^.Kind:= tkArray;
    fi^.Name:=Info;
    if copy(info, 1, 1) <> '*' then
      Die(ExplainImproperCalling(fi, '('+RuEn('<имя, НЕ начинающееся с *, как должно>','<name NOT beginning with * as it should>')+', ...)'))
      else fi^.Name:= copy(info, 2, length(fi^.Name) - 1);
    RegType(fi, BaseType, IndEnum);
  end;



  function NonIntInd(v: array of const): integer;
  var i: integer;
  begin
    Result:= -1;
    for i:=0 to high(v) do
      if v[i].vtype<> vtInteger then begin
        Result:= i;
        Exit;
      end;
  end;

 //static array
  procedure RegType(tname: string; base: PTypeInfo; lohi: array of const);
  var
    fakeinfo: TTypeInfo;
    i: integer;
  begin
    CpsValidate(tname);
    fakeinfo.Kind:= tkArray;
    fakeinfo.Name:= tname;
    i:= NonIntInd(lohi);
    if i>=0 then Die(ExplainImproperCalling(@fakeinfo, PervertedFormat(RuEn(
      '( ..., [массив, в котором %0 значение - не целое])',
      '( ..., [array where value #%0 is not an integer])'), [i])));
    if copy(tname, 1, 1) <> '*' then
      Die(ExplainImproperCalling(@fakeinfo, '('+RuEn('<имя, НЕ начинающееся с *, как должно>','<name NOT beginning with * as it should>')+', ...)'))
      else fakeinfo.Name:= copy(tname, 2, length(tname) - 1);
    if ((length(lohi) shr 1) shl 1) <> length(lohi)
      then Die(ExplainImproperCalling(@fakeinfo, '(..., ' + TypeKindName(base^.Kind)+', ' + RuEn('[массив из НЕЧЁТНОГО числа целых]','[array of an ODD number of integers]') + ')'));
    if length(lohi) <> 2 then
       Die(PervertedFormat(RuEn(
       'НеДоделано: не могу зарегистрировать многомерный статический массив %0',
       'Not Implemented Yet: unable to register the multi-dimensional static array %0'),
        [fakeinfo.Name]));
    if lohi[0].vInteger <> 0 then
       Die(PervertedFormat(RuEn(
       'НеДоделано: не могу зарегистрировать статический массив %0 c Low <> 0',
       'Not Implemented Yet: unable to register the static array %0 with Low <> 0'),
        [fakeinfo.Name]));
    TwkRegTypeStaticArray(fakeinfo.Name, -1, base, lohi[1].vInteger);
  end;

  procedure RegType(tname, base: string; lohi: array of const); overload;
  var
    fakeinfo: TTypeInfo;
    i: integer;
  begin
    CpsValidate(tname);
    fakeinfo.Kind:= tkArray;
    fakeinfo.Name:= tname;
    i:= NonIntInd(lohi);
    if i>=0 then Die(ExplainImproperCalling(@fakeinfo, PervertedFormat(RuEn(
      '( ..., [массив, в котором %0 значение - не целое])',
      '( ..., [array where value #%0 is not an integer])'), [i])));
    if copy(tname, 1, 1) <> '*' then
      Die(ExplainImproperCalling(@fakeinfo, '('+RuEn('<имя, НЕ начинающееся с *, как должно>','<name NOT beginning with * as it should>')+', ...)'))
      else fakeinfo.Name:= copy(tname, 2, length(tname) - 1);
    i:= ProcessTypeName(@fakeinfo, base, RuEn('базовый','base'), RuEn('базового','base'));
    if ((length(lohi) shr 1) shl 1) <> length(lohi)
      then Die(ExplainImproperCalling(@fakeinfo, '(..., ''*' + TypeNameSpace[i] + ''', '+ RuEn('[массив из НЕЧЁТНОГО числа целых]','[array of an ODD number of integers]') + ')'));
    if length(lohi) <> 2 then
       Die(PervertedFormat(RuEn(
       'НеДоделано: не могу зарегистрировать многомерный статический массив %0',
       'Not Implemented Yet: unable to register the multi-dimensional static array %0'),
        [fakeinfo.Name]));
    if lohi[0].vInteger <> 0 then
       Die(PervertedFormat(RuEn(
       'НеДоделано: не могу зарегистрировать статический массив %0 c Low <> 0',
       'Not Implemented Yet: unable to register the static array %0 with Low <> 0'),
        [fakeinfo.Name]));
    TwkRegTypeStaticArray(fakeinfo.Name, i, nil, lohi[1].vInteger);
  end;


{$ifdef fpc}
 //static array
  procedure RegType(info, base: PTypeInfo; lohi: array of const);  overload;
  begin
    CpsValidate(info);
    if (info^.Kind <> tkArray)
      then Die(ExplainImproperCalling(info, '(..., ' + TypeKindName(base^.Kind) + ', [...]'));
    RegType('*' + info^.Name, base, lohi);
  end;
  
  procedure RegType(info: PTypeInfo; base: String; lohi: array of const);  overload;
  begin
    CpsValidate(info);
    if (info^.Kind <> tkArray)
      then Die(ExplainImproperCalling(info, '(..., ''' + base + ''', [...]'));
    RegType('*' + info^.Name, base, lohi);
  end;

{$endif}



