RealICQClient/Includes/MyBean/Source/superobject.pas

(*
 *                         Super Object Toolkit
 *
 * Usage allowed under the restrictions of the Lesser GNU General Public License
 * or alternatively the restrictions of the Mozilla Public License 1.1
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
 * the specific language governing rights and limitations under the License.
 *
 * Embarcadero Technologies Inc is not permitted to use or redistribute
 * this source code without explicit permission.
 *
 * Unit owner : Henri Gourvest <hgourvest@gmail.com>
 * Web site   : http://www.progdigy.com
 *
 * This unit is inspired from the json c lib:
 *   Michael Clark <michael@metaparadigm.com>
 *   http://oss.metaparadigm.com/json-c/
 *
 *  CHANGES:
 *  v1.2
 *   + support of currency data type
 *   + right trim unquoted string
 *   + read Unicode Files and streams (Litle Endian with BOM)
 *   + Fix bug on javadate functions + windows nt compatibility
 *   + Now you can force to parse only the canonical syntax of JSON using the stric parameter
 *   + Delphi 2010 RTTI marshalling
 *  v1.1
 *   + Double licence MPL or LGPL.
 *   + Delphi 2009 compatibility & Unicode support.
 *   + AsString return a string instead of PChar.
 *   + Escaped and Unascaped JSON serialiser.
 *   + Missed FormFeed added \f
 *   - Removed @ trick, uses forcepath() method instead.
 *   + Fixed parse error with uppercase E symbol in numbers.
 *   + Fixed possible buffer overflow when enlarging array.
 *   + Added "delete", "pack", "insert" methods for arrays and/or objects
 *   + Multi parametters when calling methods
 *   + Delphi Enumerator (for obj1 in obj2 do ...)
 *   + Format method ex: obj.format('<%name%>%tab[1]%</%name%>')
 *   + ParseFile and ParseStream methods
 *   + Parser now understand hexdecimal c syntax ex: \xFF
 *   + Null Object Design Patern (ex: for obj in values.N['path'] do ...)
 *  v1.0
 *   + renamed class
 *   + interfaced object
 *   + added a new data type: the method
 *   + parser can now evaluate properties and call methods
 *   - removed obselet rpc class
 *   - removed "find" method, now you can use "parse" method instead
 *  v0.6
 *   + refactoring
 *  v0.5
 *   + new find method to get or set value using a path syntax
 *       ex: obj.s['obj.prop[1]'] := 'string value';
 *           obj.a['@obj.array'].b[n] := true; // @ -> create property if necessary
 *  v0.4
 *   + bug corrected: AVL tree badly balanced.
 *  v0.3
 *   + New validator partially based on the Kwalify syntax.
 *   + extended syntax to parse unquoted fields.
 *   + Freepascal compatibility win32/64 Linux32/64.
 *   + JavaToDelphiDateTime and DelphiToJavaDateTime improved for UTC.
 *   + new TJsonObject.Compare function.
 *  v0.2
 *   + Hashed string list replaced with a faster AVL tree
 *   + JsonInt data type can be changed to int64
 *   + JavaToDelphiDateTime and DelphiToJavaDateTime helper fonctions
 *   + from json-c v0.7
 *     + Add escaping of backslash to json output
 *     + Add escaping of foward slash on tokenizing and output
 *     + Changes to internal tokenizer from using recursion to
 *       using a depth state structure to allow incremental parsing
 *  v0.1
 *   + first release
 *)

{$IFDEF FPC}
  {$MODE OBJFPC}{$H+}
{$ENDIF}

{$DEFINE SUPER_METHOD}
{$DEFINE WINDOWSNT_COMPATIBILITY}
{.$DEFINE DEBUG} // track memory leack


{$if defined(FPC) or defined(VER170) or defined(VER180) or defined(VER190) or defined(VER200) or defined(VER210)}
  {$DEFINE HAVE_INLINE}
{$ifend}

{$if defined(VER210) or defined(VER220) or defined(VER230)}
  {$define HAVE_RTTI}
{$ifend}

{$if defined(VER230)}
  {$define NEED_FORMATSETTINGS}
{$ifend}



{$if defined(FPC) and defined(VER2_6)}
  {$define NEED_FORMATSETTINGS}
{$ifend}

{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}

unit superobject;

{$if CompilerVersion>= 23}
  {$define NEED_FORMATSETTINGS}
{$ifend}

interface
uses
  Classes
{$IFDEF HAVE_RTTI}
  ,Generics.Collections, RTTI, TypInfo
{$ENDIF}
  ;

type
{$IFNDEF FPC}
{$IFDEF CPUX64}
  PtrInt = Int64;
  PtrUInt = UInt64;
{$ELSE}
  PtrInt = longint;
  PtrUInt = Longword;
{$ENDIF}
{$ENDIF}
  SuperInt = Int64;

{$if (sizeof(Char) = 1)}
  SOChar = WideChar;
  SOIChar = Word;
  PSOChar = PWideChar;
{$IFDEF FPC}
  SOString = UnicodeString;
{$ELSE}
  SOString = WideString;
{$ENDIF}
{$else}
  SOChar = Char;
  SOIChar = Word;
  PSOChar = PChar;
  SOString = string;
{$ifend}

const
  SUPER_ARRAY_LIST_DEFAULT_SIZE = 32;
  SUPER_TOKENER_MAX_DEPTH = 32;

  SUPER_AVL_MAX_DEPTH = sizeof(longint) * 8;
  SUPER_AVL_MASK_HIGH_BIT = not ((not longword(0)) shr 1);

type
  // forward declarations
  TSuperObject = class;
  ISuperObject = interface;
  TSuperArray = class;

(* AVL Tree
 *  This is a "special" autobalanced AVL tree
 *  It use a hash value for fast compare
 *)

{$IFDEF SUPER_METHOD}
  TSuperMethod = procedure(const This, Params: ISuperObject; var Result: ISuperObject);
{$ENDIF}


  TSuperAvlBitArray = set of 0..SUPER_AVL_MAX_DEPTH - 1;

  TSuperAvlSearchType = (stEQual, stLess, stGreater);
  TSuperAvlSearchTypes = set of TSuperAvlSearchType;
  TSuperAvlIterator = class;

  TSuperAvlEntry = class
  private
    FGt, FLt: TSuperAvlEntry;
    FBf: integer;
    FHash: Cardinal;
    FName: SOString;
    FPtr: Pointer;
    function GetValue: ISuperObject;
    procedure SetValue(const val: ISuperObject);
  public
    class function Hash(const k: SOString): Cardinal; virtual;
    constructor Create(const AName: SOString; Obj: Pointer); virtual;
    property Name: SOString read FName;
    property Ptr: Pointer read FPtr;
    property Value: ISuperObject read GetValue write SetValue;
  end;

  TSuperAvlTree = class
  private
    FRoot: TSuperAvlEntry;
    FCount: Integer;
    function balance(bal: TSuperAvlEntry): TSuperAvlEntry;
  protected
    procedure doDeleteEntry(Entry: TSuperAvlEntry; all: boolean); virtual;
    function CompareNodeNode(node1, node2: TSuperAvlEntry): integer; virtual;
    function CompareKeyNode(const k: SOString; h: TSuperAvlEntry): integer; virtual;
    function Insert(h: TSuperAvlEntry): TSuperAvlEntry; virtual;
    function Search(const k: SOString; st: TSuperAvlSearchTypes = [stEqual]): TSuperAvlEntry; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function IsEmpty: boolean;
    procedure Clear(all: boolean = false); virtual;
    procedure Pack(all: boolean);
    function Delete(const k: SOString): ISuperObject;
    function GetEnumerator: TSuperAvlIterator;
    property count: Integer read FCount;
  end;

  TSuperTableString = class(TSuperAvlTree)
  protected
    procedure doDeleteEntry(Entry: TSuperAvlEntry; all: boolean); override;
    procedure PutO(const k: SOString; const value: ISuperObject);
    function GetO(const k: SOString): ISuperObject;
    procedure PutS(const k: SOString; const value: SOString);
    function GetS(const k: SOString): SOString;
    procedure PutI(const k: SOString; value: SuperInt);
    function GetI(const k: SOString): SuperInt;
    procedure PutD(const k: SOString; value: Double);
    function GetD(const k: SOString): Double;
    procedure PutB(const k: SOString; value: Boolean);
    function GetB(const k: SOString): Boolean;
{$IFDEF SUPER_METHOD}
    procedure PutM(const k: SOString; value: TSuperMethod);
    function GetM(const k: SOString): TSuperMethod;
{$ENDIF}
    procedure PutN(const k: SOString; const value: ISuperObject);
    function GetN(const k: SOString): ISuperObject;
    procedure PutC(const k: SOString; value: Currency);
    function GetC(const k: SOString): Currency;
  public
    property O[const k: SOString]: ISuperObject read GetO write PutO; default;
    property S[const k: SOString]: SOString read GetS write PutS;
    property I[const k: SOString]: SuperInt read GetI write PutI;
    property D[const k: SOString]: Double read GetD write PutD;
    property B[const k: SOString]: Boolean read GetB write PutB;
{$IFDEF SUPER_METHOD}
    property M[const k: SOString]: TSuperMethod read GetM write PutM;
{$ENDIF}
    property N[const k: SOString]: ISuperObject read GetN write PutN;
    property C[const k: SOString]: Currency read GetC write PutC;

    function GetValues: ISuperObject;
    function GetNames: ISuperObject;
    function Find(const k: SOString; var value: ISuperObject): Boolean;
    function Exists(const k: SOString): Boolean;
  end;

  TSuperAvlIterator = class
  private
    FTree: TSuperAvlTree;
    FBranch: TSuperAvlBitArray;
    FDepth: LongInt;
    FPath: array[0..SUPER_AVL_MAX_DEPTH - 2] of TSuperAvlEntry;
  public
    constructor Create(tree: TSuperAvlTree); virtual;
    procedure Search(const k: SOString; st: TSuperAvlSearchTypes = [stEQual]);
    procedure First;
    procedure Last;
    function GetIter: TSuperAvlEntry;
    procedure Next;
    procedure Prior;
    // delphi enumerator
    function MoveNext: Boolean;
    property Current: TSuperAvlEntry read GetIter;
  end;

  TSuperObjectArray = array[0..(high(Integer) div sizeof(TSuperObject))-1] of ISuperObject;
  PSuperObjectArray = ^TSuperObjectArray;

  TSuperArray = class
  private
    FArray: PSuperObjectArray;
    FLength: Integer;
    FSize: Integer;
    procedure Expand(max: Integer);
  protected
    function GetO(const index: integer): ISuperObject;
    procedure PutO(const index: integer; const Value: ISuperObject);
    function GetB(const index: integer): Boolean;
    procedure PutB(const index: integer; Value: Boolean);
    function GetI(const index: integer): SuperInt;
    procedure PutI(const index: integer; Value: SuperInt);
    function GetD(const index: integer): Double;
    procedure PutD(const index: integer; Value: Double);
    function GetC(const index: integer): Currency;
    procedure PutC(const index: integer; Value: Currency);
    function GetS(const index: integer): SOString;
    procedure PutS(const index: integer; const Value: SOString);
{$IFDEF SUPER_METHOD}
    function GetM(const index: integer): TSuperMethod;
    procedure PutM(const index: integer; Value: TSuperMethod);
{$ENDIF}
    function GetN(const index: integer): ISuperObject;
    procedure PutN(const index: integer; const Value: ISuperObject);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Add(const Data: ISuperObject): Integer; overload;
    function Add(Data: SuperInt): Integer; overload;
    function Add(const Data: SOString): Integer; overload;
    function Add(Data: Boolean): Integer; overload;
    function Add(Data: Double): Integer; overload;
    function AddC(const Data: Currency): Integer;
    function Delete(index: Integer): ISuperObject;
    procedure Insert(index: Integer; const value: ISuperObject);
    procedure Clear(all: boolean = false);
    procedure Pack(all: boolean);
    property Length: Integer read FLength;

    property N[const index: integer]: ISuperObject read GetN write PutN;
    property O[const index: integer]: ISuperObject read GetO write PutO; default;
    property B[const index: integer]: boolean read GetB write PutB;
    property I[const index: integer]: SuperInt read GetI write PutI;
    property D[const index: integer]: Double read GetD write PutD;
    property C[const index: integer]: Currency read GetC write PutC;
    property S[const index: integer]: SOString read GetS write PutS;
{$IFDEF SUPER_METHOD}
    property M[const index: integer]: TSuperMethod read GetM write PutM;
{$ENDIF}
  end;

  TSuperWriter = class
  public
    // abstact methods to overide
    function Append(buf: PSOChar; Size: Integer): Integer; overload; virtual; abstract;
    function Append(buf: PSOChar): Integer; overload; virtual; abstract;
    procedure Reset; virtual; abstract;
  end;

  TSuperWriterString = class(TSuperWriter)
  private
    FBuf: PSOChar;
    FBPos: integer;
    FSize: integer;
  public
    function Append(buf: PSOChar; Size: Integer): Integer; overload; override;
    function Append(buf: PSOChar): Integer; overload; override;
    procedure Reset; override;
    procedure TrimRight;
    constructor Create; virtual;
    destructor Destroy; override;
    function GetString: SOString;
    property Data: PSOChar read FBuf;
    property Size: Integer read FSize;
    property Position: integer read FBPos;
  end;

  TSuperWriterStream = class(TSuperWriter)
  private
    FStream: TStream;
  public
    function Append(buf: PSOChar): Integer; override;
    procedure Reset; override;
    constructor Create(AStream: TStream); reintroduce; virtual;
  end;

  TSuperAnsiWriterStream = class(TSuperWriterStream)
  public
    function Append(buf: PSOChar; Size: Integer): Integer; override;
  end;

  TSuperUnicodeWriterStream = class(TSuperWriterStream)
  public
    function Append(buf: PSOChar; Size: Integer): Integer; override;
  end;

  TSuperWriterFake = class(TSuperWriter)
  private
    FSize: Integer;
  public
    function Append(buf: PSOChar; Size: Integer): Integer; override;
    function Append(buf: PSOChar): Integer; override;
    procedure Reset; override;
    constructor Create; reintroduce; virtual;
    property size: integer read FSize;
  end;

  TSuperWriterSock = class(TSuperWriter)
  private
    FSocket: longint;
    FSize: Integer;
  public
    function Append(buf: PSOChar; Size: Integer): Integer; override;
    function Append(buf: PSOChar): Integer; override;
    procedure Reset; override;
    constructor Create(ASocket: longint); reintroduce; virtual;
    property Socket: longint read FSocket;
    property Size: Integer read FSize;
  end;

  TSuperTokenizerError = (
    teSuccess,
    teContinue,
    teDepth,
    teParseEof,
    teParseUnexpected,
    teParseNull,
    teParseBoolean,
    teParseNumber,
    teParseArray,
    teParseObjectKeyName,
    teParseObjectKeySep,
    teParseObjectValueSep,
    teParseString,
    teParseComment,
    teEvalObject,
    teEvalArray,
    teEvalMethod,
    teEvalInt
  );

  TSuperTokenerState = (
    tsEatws,
    tsStart,
    tsFinish,
    tsNull,
    tsCommentStart,
    tsComment,
    tsCommentEol,
    tsCommentEnd,
    tsString,
    tsStringEscape,
    tsIdentifier,
    tsEscapeUnicode,
    tsEscapeHexadecimal,
    tsBoolean,
    tsNumber,
    tsArray,
    tsArrayAdd,
    tsArraySep,
    tsObjectFieldStart,
    tsObjectField,
    tsObjectUnquotedField,
    tsObjectFieldEnd,
    tsObjectValue,
    tsObjectValueAdd,
    tsObjectSep,
    tsEvalProperty,
    tsEvalArray,
    tsEvalMethod,
    tsParamValue,
    tsParamPut,
    tsMethodValue,
    tsMethodPut
  );

  PSuperTokenerSrec = ^TSuperTokenerSrec;
  TSuperTokenerSrec = record
    state, saved_state: TSuperTokenerState;
    obj: ISuperObject;
    current: ISuperObject;
    field_name: SOString;
    parent: ISuperObject;
    gparent: ISuperObject;
  end;

  TSuperTokenizer = class
  public
    str: PSOChar;
    pb: TSuperWriterString;
    depth, is_double, floatcount, st_pos, char_offset: Integer;
    err:  TSuperTokenizerError;
    ucs_char: Word;
    quote_char: SOChar;
    stack: array[0..SUPER_TOKENER_MAX_DEPTH-1] of TSuperTokenerSrec;
    line, col: Integer;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure ResetLevel(adepth: integer);
    procedure Reset;
  end;

  // supported object types
  TSuperType = (
    stNull,
    stBoolean,
    stDouble,
    stCurrency,
    stInt,
    stObject,
    stArray,
    stString
{$IFDEF SUPER_METHOD}
    ,stMethod
{$ENDIF}
  );

  TSuperValidateError = (
    veRuleMalformated,
    veFieldIsRequired,
    veInvalidDataType,
    veFieldNotFound,
    veUnexpectedField,
    veDuplicateEntry,
    veValueNotInEnum,
    veInvalidLength,
    veInvalidRange
  );

  TSuperFindOption = (
    foCreatePath,
    foPutValue,
    foDelete
{$IFDEF SUPER_METHOD}
    ,foCallMethod
{$ENDIF}
  );

  TSuperFindOptions = set of TSuperFindOption;
  TSuperCompareResult = (cpLess, cpEqu, cpGreat, cpError);
  TSuperOnValidateError = procedure(sender: Pointer; error: TSuperValidateError; const objpath: SOString);

  TSuperEnumerator = class
  private
    FObj: ISuperObject;
    FObjEnum: TSuperAvlIterator;
    FCount: Integer;
  public
    constructor Create(const obj: ISuperObject); virtual;
    destructor Destroy; override;
    function MoveNext: Boolean;
    function GetCurrent: ISuperObject;
    property Current: ISuperObject read GetCurrent;
  end;

  ISuperObject = interface
  ['{4B86A9E3-E094-4E5A-954A-69048B7B6327}']
    function GetEnumerator: TSuperEnumerator;
    function GetDataType: TSuperType;
    function GetProcessing: boolean;
    procedure SetProcessing(value: boolean);
    function ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject;
    function Format(const str: SOString; BeginSep: SOChar = '%'; EndSep: SOChar = '%'): SOString;

    function GetO(const path: SOString): ISuperObject;
    procedure PutO(const path: SOString; const Value: ISuperObject);
    function GetB(const path: SOString): Boolean;
    procedure PutB(const path: SOString; Value: Boolean);
    function GetI(const path: SOString): SuperInt;
    procedure PutI(const path: SOString; Value: SuperInt);
    function GetD(const path: SOString): Double;
    procedure PutC(const path: SOString; Value: Currency);
    function GetC(const path: SOString): Currency;
    procedure PutD(const path: SOString; Value: Double);
    function GetS(const path: SOString): SOString;
    procedure PutS(const path: SOString; const Value: SOString);
{$IFDEF SUPER_METHOD}
    function GetM(const path: SOString): TSuperMethod;
    procedure PutM(const path: SOString; Value: TSuperMethod);
{$ENDIF}
    function GetA(const path: SOString): TSuperArray;

    // Null Object Design patern
    function GetN(const path: SOString): ISuperObject;
    procedure PutN(const path: SOString; const Value: ISuperObject);

    // Writers
    function Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer;
    function SaveTo(stream: TStream; indent: boolean = false; escape: boolean = true): integer; overload;
    function SaveTo(const FileName: string; indent: boolean = false; escape: boolean = true): integer; overload;
    function SaveTo(socket: longint; indent: boolean = false; escape: boolean = true): integer; overload;
    function CalcSize(indent: boolean = false; escape: boolean = true): integer;

    // convert
    function AsBoolean: Boolean;
    function AsInteger: SuperInt;
    function AsDouble: Double;
    function AsCurrency: Currency;
    function AsString: SOString;
    function AsArray: TSuperArray;
    function AsObject: TSuperTableString;
{$IFDEF SUPER_METHOD}
    function AsMethod: TSuperMethod;
{$ENDIF}
    function AsJSon(indent: boolean = false; escape: boolean = true): SOString;

    procedure Clear(all: boolean = false);
    procedure Pack(all: boolean = false);

    property N[const path: SOString]: ISuperObject read GetN write PutN;
    property O[const path: SOString]: ISuperObject read GetO write PutO; default;
    property B[const path: SOString]: boolean read GetB write PutB;
    property I[const path: SOString]: SuperInt read GetI write PutI;
    property D[const path: SOString]: Double read GetD write PutD;
    property C[const path: SOString]: Currency read GetC write PutC;
    property S[const path: SOString]: SOString read GetS write PutS;
{$IFDEF SUPER_METHOD}
    property M[const path: SOString]: TSuperMethod read GetM write PutM;
{$ENDIF}
    property A[const path: SOString]: TSuperArray read GetA;

{$IFDEF SUPER_METHOD}
    function call(const path: SOString; const param: ISuperObject = nil): ISuperObject; overload;
    function call(const path, param: SOString): ISuperObject; overload;
{$ENDIF}

    // clone a node
    function Clone: ISuperObject;
    function Delete(const path: SOString): ISuperObject;
    // merges tow objects of same type, if reference is true then nodes are not cloned
    procedure Merge(const obj: ISuperObject; reference: boolean = false); overload;
    procedure Merge(const str: SOString); overload;

    // validate methods
    function Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload;
    function Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload;

    // compare
    function Compare(const obj: ISuperObject): TSuperCompareResult; overload;
    function Compare(const str: SOString): TSuperCompareResult; overload;

    // the data type
    function IsType(AType: TSuperType): boolean;
    property DataType: TSuperType read GetDataType;
    property Processing: boolean read GetProcessing write SetProcessing;

    function GetDataPtr: Pointer;
    procedure SetDataPtr(const Value: Pointer);
    property DataPtr: Pointer read GetDataPtr write SetDataPtr;
  end;

  TSuperObject = class(TObject, ISuperObject)
  private
    FRefCount: Integer;
    FProcessing: boolean;
    FDataType: TSuperType;
    FDataPtr: Pointer;
{.$if true}
    FO: record
      case TSuperType of
        stBoolean: (c_boolean: boolean);
        stDouble: (c_double: double);
        stCurrency: (c_currency: Currency);
        stInt: (c_int: SuperInt);
        stObject: (c_object: TSuperTableString);
        stArray: (c_array: TSuperArray);
{$IFDEF SUPER_METHOD}
        stMethod: (c_method: TSuperMethod);
{$ENDIF}
      end;
{.$ifend}
    FOString: SOString;
    function GetDataType: TSuperType;
    function GetDataPtr: Pointer;
    procedure SetDataPtr(const Value: Pointer);
  protected
{$IFDEF FPC}
    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: tguid; out obj): longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$ELSE}
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
{$ENDIF}
    function _AddRef: Integer; virtual; stdcall;
    function _Release: Integer; virtual; stdcall;

    function GetO(const path: SOString): ISuperObject;
    procedure PutO(const path: SOString; const Value: ISuperObject);
    function GetB(const path: SOString): Boolean;
    procedure PutB(const path: SOString; Value: Boolean);
    function GetI(const path: SOString): SuperInt;
    procedure PutI(const path: SOString; Value: SuperInt);
    function GetD(const path: SOString): Double;
    procedure PutD(const path: SOString; Value: Double);
    procedure PutC(const path: SOString; Value: Currency);
    function GetC(const path: SOString): Currency;
    function GetS(const path: SOString): SOString;
    procedure PutS(const path: SOString; const Value: SOString);
{$IFDEF SUPER_METHOD}
    function GetM(const path: SOString): TSuperMethod;
    procedure PutM(const path: SOString; Value: TSuperMethod);
{$ENDIF}
    function GetA(const path: SOString): TSuperArray;
    function Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer; virtual;
  public
    function GetEnumerator: TSuperEnumerator;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;

    function GetProcessing: boolean;
    procedure SetProcessing(value: boolean);

    // Writers
    function SaveTo(stream: TStream; indent: boolean = false; escape: boolean = true): integer; overload;
    function SaveTo(const FileName: string; indent: boolean = false; escape: boolean = true): integer; overload;
    function SaveTo(socket: longint; indent: boolean = false; escape: boolean = true): integer; overload;
    function CalcSize(indent: boolean = false; escape: boolean = true): integer;
    function AsJSon(indent: boolean = false; escape: boolean = true): SOString;

    // parser  ... owned!
    class function ParseString(s: PSOChar; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = [];
       const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject;
    class function ParseStream(stream: TStream; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = [];
       const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject;
    class function ParseFile(const FileName: string; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = [];
       const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject;
    class function ParseEx(tok: TSuperTokenizer; str: PSOChar; len: integer; strict: Boolean; const this: ISuperObject = nil;
      options: TSuperFindOptions = []; const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject;

    // constructors / destructor
    constructor Create(jt: TSuperType = stObject); overload; virtual;
    constructor Create(b: boolean); overload; virtual;
    constructor Create(i: SuperInt); overload; virtual;
    constructor Create(d: double); overload; virtual;
    constructor CreateCurrency(c: Currency); overload; virtual;
    constructor Create(const s: SOString); overload; virtual;
{$IFDEF SUPER_METHOD}
    constructor Create(m: TSuperMethod); overload; virtual;
{$ENDIF}
    destructor Destroy; override;

    // convert
    function AsBoolean: Boolean; virtual;
    function AsInteger: SuperInt; virtual;
    function AsDouble: Double; virtual;
    function AsCurrency: Currency; virtual;
    function AsString: SOString; virtual;
    function AsArray: TSuperArray; virtual;
    function AsObject: TSuperTableString; virtual;
{$IFDEF SUPER_METHOD}
    function AsMethod: TSuperMethod; virtual;
{$ENDIF}
    procedure Clear(all: boolean = false); virtual;
    procedure Pack(all: boolean = false); virtual;
    function GetN(const path: SOString): ISuperObject;
    procedure PutN(const path: SOString; const Value: ISuperObject);
    function ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject;
    function Format(const str: SOString; BeginSep: SOChar = '%'; EndSep: SOChar = '%'): SOString;

    property N[const path: SOString]: ISuperObject read GetN write PutN;
    property O[const path: SOString]: ISuperObject read GetO write PutO; default;
    property B[const path: SOString]: boolean read GetB write PutB;
    property I[const path: SOString]: SuperInt read GetI write PutI;
    property D[const path: SOString]: Double read GetD write PutD;
    property C[const path: SOString]: Currency read GetC write PutC;
    property S[const path: SOString]: SOString read GetS write PutS;
{$IFDEF SUPER_METHOD}
    property M[const path: SOString]: TSuperMethod read GetM write PutM;
{$ENDIF}
    property A[const path: SOString]: TSuperArray read GetA;

    {$IFDEF SUPER_METHOD}
    function call(const path: SOString; const param: ISuperObject = nil): ISuperObject; overload; virtual;
    function call(const path, param: SOString): ISuperObject; overload; virtual;
{$ENDIF}
    // clone a node
    function Clone: ISuperObject; virtual;
    function Delete(const path: SOString): ISuperObject;
    // merges tow objects of same type, if reference is true then nodes are not cloned
    procedure Merge(const obj: ISuperObject; reference: boolean = false); overload;
    procedure Merge(const str: SOString); overload;

    // validate methods
    function Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload;
    function Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload;

    // compare
    function Compare(const obj: ISuperObject): TSuperCompareResult; overload;
    function Compare(const str: SOString): TSuperCompareResult; overload;

    // the data type
    function IsType(AType: TSuperType): boolean;
    property DataType: TSuperType read GetDataType;
    // a data pointer to link to something ele, a treeview for example
    property DataPtr: Pointer read GetDataPtr write SetDataPtr;
    property Processing: boolean read GetProcessing;
  end;

{$IFDEF HAVE_RTTI}
  TSuperRttiContext = class;

  TSerialFromJson = function(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;
  TSerialToJson = function(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject;

  TSuperAttribute = class(TCustomAttribute)
  private
    FName: string;
  public
    constructor Create(const AName: string);
    property Name: string read FName;
  end;

  SOName = class(TSuperAttribute);
  SODefault = class(TSuperAttribute);


  TSuperRttiContext = class
  private
    class function GetFieldName(r: TRttiField): string;
    class function GetFieldDefault(r: TRttiField; const obj: ISuperObject): ISuperObject;
  public
    Context: TRttiContext;
    SerialFromJson: TDictionary<PTypeInfo, TSerialFromJson>;
    SerialToJson: TDictionary<PTypeInfo, TSerialToJson>;
    constructor Create; virtual;
    destructor Destroy; override;
    function FromJson(TypeInfo: PTypeInfo; const obj: ISuperObject; var Value: TValue): Boolean; virtual;
    function ToJson(var value: TValue; const index: ISuperObject): ISuperObject; virtual;
    function AsType<T>(const obj: ISuperObject): T;
    function AsJson<T>(const obj: T; const index: ISuperObject = nil): ISuperObject;
  end;

  TSuperObjectHelper = class helper for TObject
  public
    function ToJson(ctx: TSuperRttiContext = nil): ISuperObject;
    constructor FromJson(const obj: ISuperObject; ctx: TSuperRttiContext = nil); overload;
    constructor FromJson(const str: string; ctx: TSuperRttiContext = nil); overload;
  end;
{$ENDIF}

  TSuperObjectIter = record
    key: SOString;
    val: ISuperObject;
    Ite: TSuperAvlIterator;
  end;

function ObjectIsError(obj: TSuperObject): boolean;
function ObjectIsType(const obj: ISuperObject; typ: TSuperType): boolean;
function ObjectGetType(const obj: ISuperObject): TSuperType;
function ObjectIsNull(const obj: ISuperObject): Boolean;

function ObjectFindFirst(const obj: ISuperObject; var F: TSuperObjectIter): boolean;
function ObjectFindNext(var F: TSuperObjectIter): boolean;
procedure ObjectFindClose(var F: TSuperObjectIter);

function SO(const s: SOString = '{}'): ISuperObject; overload;
function SO(const value: Variant): ISuperObject; overload;
function SO(const Args: array of const): ISuperObject; overload;

function SA(const Args: array of const): ISuperObject; overload;

function JavaToDelphiDateTime(const dt: int64): TDateTime;
function DelphiToJavaDateTime(const dt: TDateTime): int64;
function TryObjectToDate(const obj: ISuperObject; var dt: TDateTime): Boolean;
function ISO8601DateToJavaDateTime(const str: SOString; var ms: Int64): Boolean;
function ISO8601DateToDelphiDateTime(const str: SOString; var dt: TDateTime): Boolean;
function DelphiDateTimeToISO8601Date(dt: TDateTime): SOString;
function UUIDToString(const g: TGUID): SOString;
function StringToUUID(const str: SOString; var g: TGUID): Boolean;

{$IFDEF HAVE_RTTI}

type
  TSuperInvokeResult = (
    irSuccess,
    irMethothodError,  // method don't exist
    irParamError,     // invalid parametters
    irError            // other error
  );

function TrySOInvoke(var ctx: TSuperRttiContext; const obj: TValue; const method: string; const params: ISuperObject; var Return: ISuperObject): TSuperInvokeResult; overload;
function SOInvoke(const obj: TValue; const method: string; const params: ISuperObject; ctx: TSuperRttiContext = nil): ISuperObject; overload;
function SOInvoke(const obj: TValue; const method: string; const params: string; ctx: TSuperRttiContext = nil): ISuperObject; overload;
{$ENDIF}

implementation
uses sysutils,
{$IFDEF UNIX}
  baseunix, unix, DateUtils
{$ELSE}
  Windows
{$ENDIF}
{$IFDEF FPC}
  ,sockets
{$ELSE}
  ,WinSock
{$ENDIF};

{$IFDEF DEBUG}
var
  debugcount: integer = 0;
{$ENDIF}

const
  super_number_chars_set = ['0'..'9','.','+','-','e','E'];
  super_hex_chars: PSOChar = '0123456789abcdef';
  super_hex_chars_set = ['0'..'9','a'..'f','A'..'F'];

  ESC_BS: PSOChar = '\b';
  ESC_LF: PSOChar = '\n';
  ESC_CR: PSOChar = '\r';
  ESC_TAB: PSOChar = '\t';
  ESC_FF: PSOChar = '\f';
  ESC_QUOT: PSOChar = '\"';
  ESC_SL: PSOChar = '\\';
  ESC_SR: PSOChar = '\/';
  ESC_ZERO: PSOChar = '\u0000';

  TOK_CRLF: PSOChar = #13#10;
  TOK_SP: PSOChar = #32;
  TOK_BS: PSOChar = #8;
  TOK_TAB: PSOChar = #9;
  TOK_LF: PSOChar = #10;
  TOK_FF: PSOChar = #12;
  TOK_CR: PSOChar = #13;
//  TOK_SL: PSOChar = '\';
//  TOK_SR: PSOChar = '/';
  TOK_NULL: PSOChar = 'null';
  TOK_CBL: PSOChar = '{'; // curly bracket left
  TOK_CBR: PSOChar = '}'; // curly bracket right
  TOK_ARL: PSOChar = '[';
  TOK_ARR: PSOChar = ']';
  TOK_ARRAY: PSOChar = '[]';
  TOK_OBJ: PSOChar = '{}'; // empty object
  TOK_COM: PSOChar = ','; // Comma
  TOK_DQT: PSOChar = '"'; // Double Quote
  TOK_TRUE: PSOChar = 'true';
  TOK_FALSE: PSOChar = 'false';

{$if (sizeof(Char) = 1)}
function StrLComp(const Str1, Str2: PSOChar; MaxLen: Cardinal): Integer;
var
  P1, P2: PWideChar;
  I: Cardinal;
  C1, C2: WideChar;
begin
  P1 := Str1;
  P2 := Str2;
  I := 0;
  while I < MaxLen do
  begin
    C1 := P1^;
    C2 := P2^;

    if (C1 <> C2) or (C1 = #0) then
    begin
      Result := Ord(C1) - Ord(C2);
      Exit;
    end;

    Inc(P1);
    Inc(P2);
    Inc(I);
  end;
  Result := 0;
end;

function StrComp(const Str1, Str2: PSOChar): Integer;
var
  P1, P2: PWideChar;
  C1, C2: WideChar;
begin
  P1 := Str1;
  P2 := Str2;
  while True do
  begin
    C1 := P1^;
    C2 := P2^;

    if (C1 <> C2) or (C1 = #0) then
    begin
      Result := Ord(C1) - Ord(C2);
      Exit;
    end;

    Inc(P1);
    Inc(P2);
  end;
end;

function StrLen(const Str: PSOChar): Cardinal;
var
  p: PSOChar;
begin
  Result := 0;
  if Str <> nil then
  begin
    p := Str;
    while p^ <> #0 do inc(p);
    Result := (p - Str);
  end;
end;
{$ifend}

function FloatToJson(const value: Double): SOString;
var
  p: PSOChar;
begin
  Result := FloatToStr(value);
  if {$if defined(NEED_FORMATSETTINGS)}FormatSettings.{$ifend}DecimalSeparator <> '.' then
  begin
    p := PSOChar(Result);
    while p^ <> #0 do
      if p^ <> SOChar({$if defined(NEED_FORMATSETTINGS)}FormatSettings.{$ifend}DecimalSeparator) then
      inc(p) else
      begin
        p^ := '.';
        Exit;
      end;
  end;
end;

function CurrToJson(const value: Currency): SOString;
var
  p: PSOChar;
begin
  Result := CurrToStr(value);
  if {$if defined(NEED_FORMATSETTINGS)}FormatSettings.{$ifend}DecimalSeparator <> '.' then
  begin
    p := PSOChar(Result);
    while p^ <> #0 do
      if p^ <> SOChar({$if defined(NEED_FORMATSETTINGS)}FormatSettings.{$ifend}DecimalSeparator) then
      inc(p) else
      begin
        p^ := '.';
        Exit;
      end;
  end;
end;

{$IFDEF UNIX}
function GetTimeBias: integer;
var
  TimeVal: TTimeVal;
  TimeZone: TTimeZone;
begin
  fpGetTimeOfDay(@TimeVal, @TimeZone);
  Result := TimeZone.tz_minuteswest;
end;
{$ELSE}
function GetTimeBias: integer;
var
  tzi : TTimeZoneInformation;
begin
  case GetTimeZoneInformation(tzi) of
    TIME_ZONE_ID_UNKNOWN : Result := tzi.Bias;
    TIME_ZONE_ID_STANDARD: Result := tzi.Bias + tzi.StandardBias;
    TIME_ZONE_ID_DAYLIGHT: Result := tzi.Bias + tzi.DaylightBias;
  else
    Result := 0;
  end;
end;
{$ENDIF}

{$IFDEF UNIX}
type
  ptm = ^tm;
  tm = record
    tm_sec: Integer;		(* Seconds: 0-59 (K&R says 0-61?) *)
    tm_min: Integer;		(* Minutes: 0-59 *)
    tm_hour: Integer;	(* Hours since midnight: 0-23 *)
    tm_mday: Integer;	(* Day of the month: 1-31 *)
    tm_mon: Integer;		(* Months *since* january: 0-11 *)
    tm_year: Integer;	(* Years since 1900 *)
    tm_wday: Integer;	(* Days since Sunday (0-6) *)
    tm_yday: Integer;	(* Days since Jan. 1: 0-365 *)
    tm_isdst: Integer;	(* +1 Daylight Savings Time, 0 No DST, -1 don't know *)
  end;

function mktime(p: ptm): LongInt; cdecl; external;
function gmtime(const t: PLongint): ptm; cdecl; external;
function localtime (const t: PLongint): ptm; cdecl; external;

function DelphiToJavaDateTime(const dt: TDateTime): Int64;
var
  p: ptm;
  l, ms: Integer;
  v: Int64;
begin
  v := Round((dt - 25569) * 86400000);
  ms := v mod 1000;
  l := v div 1000;
  p := localtime(@l);
  Result := Int64(mktime(p)) * 1000 + ms;
end;

function JavaToDelphiDateTime(const dt: int64): TDateTime;
var
  p: ptm;
  l, ms: Integer;
begin
  l := dt div 1000;
  ms := dt mod 1000;
  p := gmtime(@l);
  Result := EncodeDateTime(p^.tm_year+1900, p^.tm_mon+1, p^.tm_mday, p^.tm_hour, p^.tm_min, p^.tm_sec, ms);
end;
{$ELSE}

{$IFDEF WINDOWSNT_COMPATIBILITY}
function DayLightCompareDate(const date: PSystemTime;
  const compareDate: PSystemTime): Integer;
var
  limit_day, dayinsecs, weekofmonth: Integer;
  First: Word;
begin
  if (date^.wMonth < compareDate^.wMonth) then
  begin
    Result := -1; (* We are in a month before the date limit. *)
    Exit;
  end;

  if (date^.wMonth > compareDate^.wMonth) then
  begin
    Result := 1; (* We are in a month after the date limit. *)
    Exit;
  end;

  (* if year is 0 then date is in day-of-week format, otherwise
   * it's absolute date.
   *)
  if (compareDate^.wYear = 0) then
  begin
    (* compareDate.wDay is interpreted as number of the week in the month
     * 5 means: the last week in the month *)
    weekofmonth := compareDate^.wDay;
    (* calculate the day of the first DayOfWeek in the month *)
    First := (6 + compareDate^.wDayOfWeek - date^.wDayOfWeek + date^.wDay) mod 7 + 1;
    limit_day := First + 7 * (weekofmonth - 1);
    (* check needed for the 5th weekday of the month *)
    if (limit_day > MonthDays[(date^.wMonth=2) and IsLeapYear(date^.wYear)][date^.wMonth]) then
      dec(limit_day, 7);
  end
  else
    limit_day := compareDate^.wDay;

  (* convert to seconds *)
  limit_day := ((limit_day * 24  + compareDate^.wHour) * 60 + compareDate^.wMinute ) * 60;
  dayinsecs := ((date^.wDay * 24  + date^.wHour) * 60 + date^.wMinute ) * 60 + date^.wSecond;
  (* and compare *)

  if dayinsecs < limit_day then
    Result :=  -1 else
    if dayinsecs > limit_day then
      Result :=  1 else
      Result :=  0; (* date is equal to the date limit. *)
end;

function CompTimeZoneID(const pTZinfo: PTimeZoneInformation;
  lpFileTime: PFileTime; islocal: Boolean): LongWord;
var
  ret: Integer;
  beforeStandardDate, afterDaylightDate: Boolean;
  llTime: Int64;
  SysTime: TSystemTime;
  ftTemp: TFileTime;
begin
  llTime := 0;

  if (pTZinfo^.DaylightDate.wMonth <> 0) then
  begin
    (* if year is 0 then date is in day-of-week format, otherwise
     * it's absolute date.
     *)
    if ((pTZinfo^.StandardDate.wMonth = 0) or
        ((pTZinfo^.StandardDate.wYear = 0) and
        ((pTZinfo^.StandardDate.wDay < 1) or
        (pTZinfo^.StandardDate.wDay > 5) or
        (pTZinfo^.DaylightDate.wDay < 1) or
        (pTZinfo^.DaylightDate.wDay > 5)))) then
    begin
      SetLastError(ERROR_INVALID_PARAMETER);
      Result := TIME_ZONE_ID_INVALID;
      Exit;
    end;

    if (not islocal) then
    begin
      llTime := PInt64(lpFileTime)^;
      dec(llTime, Int64(pTZinfo^.Bias + pTZinfo^.DaylightBias) * 600000000);
      PInt64(@ftTemp)^ := llTime;
      lpFileTime := @ftTemp;
    end;

    FileTimeToSystemTime(lpFileTime^, SysTime);

    (* check for daylight savings *)
    ret := DayLightCompareDate(@SysTime, @pTZinfo^.StandardDate);
    if (ret = -2) then
    begin
      Result := TIME_ZONE_ID_INVALID;
      Exit;
    end;

    beforeStandardDate := ret < 0;

    if (not islocal) then
    begin
      dec(llTime, Int64(pTZinfo^.StandardBias - pTZinfo^.DaylightBias) * 600000000);
      PInt64(@ftTemp)^ := llTime;
      FileTimeToSystemTime(lpFileTime^, SysTime);
    end;

    ret := DayLightCompareDate(@SysTime, @pTZinfo^.DaylightDate);
    if (ret = -2) then
    begin
      Result := TIME_ZONE_ID_INVALID;
      Exit;
    end;

    afterDaylightDate := ret >= 0;

    Result := TIME_ZONE_ID_STANDARD;
    if( pTZinfo^.DaylightDate.wMonth < pTZinfo^.StandardDate.wMonth ) then
    begin
      (* Northern hemisphere *)
      if( beforeStandardDate and afterDaylightDate) then
        Result := TIME_ZONE_ID_DAYLIGHT;
    end else    (* Down south *)
      if( beforeStandardDate or afterDaylightDate) then
        Result := TIME_ZONE_ID_DAYLIGHT;
  end else
    (* No transition date *)
    Result := TIME_ZONE_ID_UNKNOWN;
end;

function GetTimezoneBias(const pTZinfo: PTimeZoneInformation;
  lpFileTime: PFileTime; islocal: Boolean; pBias: PLongint): Boolean;
var
  bias: LongInt;
  tzid: LongWord;
begin
  bias := pTZinfo^.Bias;
  tzid := CompTimeZoneID(pTZinfo, lpFileTime, islocal);

  if( tzid = TIME_ZONE_ID_INVALID) then
  begin
    Result := False;
    Exit;
  end;
  if (tzid = TIME_ZONE_ID_DAYLIGHT) then
    inc(bias, pTZinfo^.DaylightBias)
  else if (tzid = TIME_ZONE_ID_STANDARD) then
    inc(bias, pTZinfo^.StandardBias);
  pBias^ := bias;
  Result := True;
end;

function SystemTimeToTzSpecificLocalTime(
  lpTimeZoneInformation: PTimeZoneInformation;
  lpUniversalTime, lpLocalTime: PSystemTime): BOOL;
var
  ft: TFileTime;
  lBias: LongInt;
  llTime: Int64;
  tzinfo: TTimeZoneInformation;
begin
  if (lpTimeZoneInformation <> nil) then
    tzinfo := lpTimeZoneInformation^ else
    if (GetTimeZoneInformation(tzinfo) = TIME_ZONE_ID_INVALID) then
    begin
      Result := False;
      Exit;
    end;

  if (not SystemTimeToFileTime(lpUniversalTime^, ft)) then
  begin
    Result := False;
    Exit;
  end;
  llTime := PInt64(@ft)^;
  if (not GetTimezoneBias(@tzinfo, @ft, False, @lBias)) then
  begin
    Result := False;
    Exit;
  end;
  (* convert minutes to 100-nanoseconds-ticks *)
  dec(llTime, Int64(lBias) * 600000000);
  PInt64(@ft)^ := llTime;
  Result := FileTimeToSystemTime(ft, lpLocalTime^);
end;

function TzSpecificLocalTimeToSystemTime(
    const lpTimeZoneInformation: PTimeZoneInformation;
    const lpLocalTime: PSystemTime; lpUniversalTime: PSystemTime): BOOL;
var
  ft: TFileTime;
  lBias: LongInt;
  t: Int64;
  tzinfo: TTimeZoneInformation;
begin
  if (lpTimeZoneInformation <> nil) then
    tzinfo := lpTimeZoneInformation^
  else
    if (GetTimeZoneInformation(tzinfo) = TIME_ZONE_ID_INVALID) then
    begin
      Result := False;
      Exit;
    end;

  if (not SystemTimeToFileTime(lpLocalTime^, ft)) then
  begin
    Result := False;
    Exit;
  end;
  t := PInt64(@ft)^;
  if (not GetTimezoneBias(@tzinfo, @ft, True, @lBias)) then
  begin
    Result := False;
    Exit;
  end;
  (* convert minutes to 100-nanoseconds-ticks *)
  inc(t, Int64(lBias) * 600000000);
  PInt64(@ft)^ := t;
  Result := FileTimeToSystemTime(ft, lpUniversalTime^);
end;
{$ELSE}
function TzSpecificLocalTimeToSystemTime(
  lpTimeZoneInformation: PTimeZoneInformation;
  lpLocalTime, lpUniversalTime: PSystemTime): BOOL; stdcall; external 'kernel32.dll';

function SystemTimeToTzSpecificLocalTime(
  lpTimeZoneInformation: PTimeZoneInformation;
  lpUniversalTime, lpLocalTime: PSystemTime): BOOL; stdcall; external 'kernel32.dll';
{$ENDIF}

function JavaToDelphiDateTime(const dt: int64): TDateTime;
var
  t: TSystemTime;
begin
  DateTimeToSystemTime(25569 + (dt / 86400000), t);
  SystemTimeToTzSpecificLocalTime(nil, @t, @t);
  Result := SystemTimeToDateTime(t);
end;

function DelphiToJavaDateTime(const dt: TDateTime): int64;
var
  t: TSystemTime;
begin
  DateTimeToSystemTime(dt, t);
  TzSpecificLocalTimeToSystemTime(nil, @t, @t);
  Result := Round((SystemTimeToDateTime(t) - 25569) * 86400000)
end;
{$ENDIF}

function ISO8601DateToJavaDateTime(const str: SOString; var ms: Int64): Boolean;
type
  TState = (
    stStart, stYear, stMonth, stWeek, stWeekDay, stDay, stDayOfYear,
    stHour, stMin, stSec, stMs, stUTC, stGMTH, stGMTM,
    stGMTend, stEnd);

  TPerhaps = (yes, no, perhaps);
  TDateTimeInfo = record
    year: Word;
    month: Word;
    week: Word;
    weekday: Word;
    day: Word;
    dayofyear: Integer;
    hour: Word;
    minute: Word;
    second: Word;
    ms: Word;
    bias: Integer;
  end;

var
  p: PSOChar;
  state: TState;
  pos, v: Word;
  sep: TPerhaps;
  inctz, havetz, havedate: Boolean;
  st: TDateTimeInfo;
  DayTable: PDayTable;

  function get(var v: Word; c: SOChar): Boolean; {$IFDEF HAVE_INLINE} inline;{$ENDIF}
  begin
    if (c < #256) and (AnsiChar(c) in ['0'..'9']) then
    begin
      Result := True;
      v := v * 10 + Ord(c) - Ord('0');
    end else
      Result := False;
  end;

label
  error;
begin
  p := PSOChar(str);
  sep := perhaps;
  state := stStart;
  pos := 0;
  FillChar(st, SizeOf(st), 0);
  havedate := True;
  inctz := False;
  havetz := False;

  while true do
  case state of
    stStart:
      case p^ of
        '0'..'9': state := stYear;
        'T', 't':
          begin
            state := stHour;
            pos := 0;
            inc(p);
            havedate := False;
          end;
      else
        goto error;
      end;
    stYear:
      case pos of
        0..1,3:
              if get(st.year, p^) then
              begin
                Inc(pos);
                Inc(p);
              end else
                goto error;
        2:    case p^ of
                '0'..'9':
                  begin
                    st.year := st.year * 10 + ord(p^) - ord('0');
                    Inc(pos);
                    Inc(p);
                  end;
                ':':
                  begin
                    havedate := false;
                    st.hour := st.year;
                    st.year := 0;
                    inc(p);
                    pos := 0;
                    state := stMin;
                    sep := yes;
                  end;
              else
                goto error;
              end;
        4: case p^ of
             '-': begin
                    pos := 0;
                    Inc(p);
                    sep := yes;
                    state := stMonth;
                  end;
             '0'..'9':
                  begin
                    sep := no;
                    pos := 0;
                    state := stMonth;
                  end;
             'W', 'w' :
                  begin
                    pos := 0;
                    Inc(p);
                    state := stWeek;
                  end;
             'T', 't', ' ':
                  begin
                    state := stHour;
                    pos := 0;
                    inc(p);
                    st.month := 1;
                    st.day := 1;
                  end;
             #0:
                  begin
                    st.month := 1;
                    st.day := 1;
                    state := stEnd;
                  end;
           else
             goto error;
           end;
      end;
    stMonth:
      case pos of
        0:  case p^ of
              '0'..'9':
                begin
                  st.month := ord(p^) - ord('0');
                  Inc(pos);
                  Inc(p);
                end;
              'W', 'w':
                begin
                  pos := 0;
                  Inc(p);
                  state := stWeek;
                end;
            else
              goto error;
            end;
        1:  if get(st.month, p^) then
            begin
              Inc(pos);
              Inc(p);
            end else
              goto error;
        2: case p^ of
             '-':
                  if (sep in [yes, perhaps])  then
                  begin
                    pos := 0;
                    Inc(p);
                    state := stDay;
                    sep := yes;
                  end else
                    goto error;
             '0'..'9':
                  if sep in [no, perhaps] then
                  begin
                    pos := 0;
                    state := stDay;
                    sep := no;
                  end else
                  begin
                    st.dayofyear := st.month * 10 + Ord(p^) - Ord('0');
                    st.month := 0;
                    inc(p);
                    pos := 3;
                    state := stDayOfYear;
                  end;
             'T', 't', ' ':
                  begin
                    state := stHour;
                    pos := 0;
                    inc(p);
                    st.day := 1;
                 end;
             #0:
               begin
                 st.day := 1;
                 state := stEnd;
               end;
           else
             goto error;
           end;
      end;
    stDay:
      case pos of
        0:  if get(st.day, p^) then
            begin
              Inc(pos);
              Inc(p);
            end else
              goto error;
        1:  if get(st.day, p^) then
            begin
              Inc(pos);
              Inc(p);
            end else
            if sep in [no, perhaps] then
            begin
              st.dayofyear := st.month * 10 + st.day;
              st.day := 0;
              st.month := 0;
              state := stDayOfYear;
            end else
              goto error;

        2: case p^ of
             'T', 't', ' ':
                  begin
                    pos := 0;
                    Inc(p);
                    state := stHour;
                  end;
             #0:  state := stEnd;
           else
             goto error;
           end;
      end;
    stDayOfYear:
      begin
        if (st.dayofyear <= 0) then goto error;
        case p^ of
          'T', 't', ' ':
               begin
                 pos := 0;
                 Inc(p);
                 state := stHour;
               end;
          #0:  state := stEnd;
        else
          goto error;
        end;
      end;
    stWeek:
      begin
        case pos of
          0..1: if get(st.week, p^) then
                begin
                  inc(pos);
                  inc(p);
                end else
                  goto error;
          2: case p^ of
               '-': if (sep in [yes, perhaps]) then
                    begin
                      Inc(p);
                      state := stWeekDay;
                      sep := yes;
                    end else
                      goto error;
               '1'..'7':
                    if sep in [no, perhaps] then
                    begin
                      state := stWeekDay;
                      sep := no;
                    end else
                      goto error;
             else
               goto error;
             end;
        end;
      end;
    stWeekDay:
      begin
        if (st.week > 0) and get(st.weekday, p^) then
        begin
          inc(p);
          v := st.year - 1;
          v := ((v * 365) + (v div 4) - (v div 100) + (v div 400)) mod 7 + 1;
          st.dayofyear := (st.weekday - v) + ((st.week) * 7) + 1;
          if v <= 4 then dec(st.dayofyear, 7);
          case p^ of
            'T', 't', ' ':
                 begin
                   pos := 0;
                   Inc(p);
                   state := stHour;
                 end;
            #0:  state := stEnd;
          else
            goto error;
          end;
        end else
          goto error;
      end;
    stHour:
      case pos of
        0:    case p^ of
                '0'..'9':
                    if get(st.hour, p^) then
                    begin
                      inc(pos);
                      inc(p);
                      end else
                        goto error;
                '-':
                  begin
                    inc(p);
                    state := stMin;
                  end;
              else
                goto error;
              end;
        1:    if get(st.hour, p^) then
              begin
                inc(pos);
                inc(p);
              end else
                goto error;
        2: case p^ of
             ':': if sep in [yes, perhaps] then
                  begin
                    sep := yes;
                    pos := 0;
                    Inc(p);
                    state := stMin;
                  end else
                    goto error;
             ',', '.':
                begin
                  Inc(p);
                  state := stMs;
                end;
             '+':
               if havedate then
               begin
                 state := stGMTH;
                 pos := 0;
                 v := 0;
                 inc(p);
               end else
                 goto error;
             '-':
               if havedate then
               begin
                 state := stGMTH;
                 pos := 0;
                 v := 0;
                 inc(p);
                 inctz := True;
               end else
                 goto error;
             'Z', 'z':
                  if havedate then
                    state := stUTC else
                    goto error;
             '0'..'9':
                  if sep in [no, perhaps] then
                  begin
                    pos := 0;
                    state := stMin;
                    sep := no;
                  end else
                    goto error;
             #0:  state := stEnd;
           else
             goto error;
           end;
      end;
    stMin:
      case pos of
        0: case p^ of
             '0'..'9':
                if get(st.minute, p^) then
                begin
                  inc(pos);
                  inc(p);
                end else
                  goto error;
             '-':
                begin
                  inc(p);
                  state := stSec;
                end;
           else
             goto error;
           end;
        1: if get(st.minute, p^) then
           begin
             inc(pos);
             inc(p);
           end else
             goto error;
        2: case p^ of
             ':': if sep in [yes, perhaps] then
                  begin
                    pos := 0;
                    Inc(p);
                    state := stSec;
                    sep := yes;
                  end else
                    goto error;
             ',', '.':
                begin
                  Inc(p);
                  state := stMs;
                end;
             '+':
               if havedate then
               begin
                 state := stGMTH;
                 pos := 0;
                 v := 0;
                 inc(p);
               end else
                 goto error;
             '-':
               if havedate then
               begin
                 state := stGMTH;
                 pos := 0;
                 v := 0;
                 inc(p);
                 inctz := True;
               end else
                 goto error;
             'Z', 'z':
                  if havedate then
                    state := stUTC else
                    goto error;
             '0'..'9':
                  if sep in [no, perhaps] then
                  begin
                    pos := 0;
                    state := stSec;
                  end else
                    goto error;
             #0:  state := stEnd;
           else
             goto error;
           end;
      end;
    stSec:
      case pos of
        0..1: if get(st.second, p^) then
              begin
                inc(pos);
                inc(p);
              end else
                goto error;
        2:    case p^ of
               ',', '.':
                  begin
                    Inc(p);
                    state := stMs;
                  end;
               '+':
                 if havedate then
                 begin
                   state := stGMTH;
                   pos := 0;
                   v := 0;
                   inc(p);
                 end else
                   goto error;
               '-':
                 if havedate then
                 begin
                   state := stGMTH;
                   pos := 0;
                   v := 0;
                   inc(p);
                   inctz := True;
                 end else
                   goto error;
               'Z', 'z':
                    if havedate then
                      state := stUTC else
                      goto error;
               #0: state := stEnd;
              else
               goto error;
              end;
      end;
    stMs:
      case p^ of
        '0'..'9':
        begin
          st.ms := st.ms * 10 + ord(p^) - ord('0');
          inc(p);
        end;
        '+':
          if havedate then
          begin
            state := stGMTH;
            pos := 0;
            v := 0;
            inc(p);
          end else
            goto error;
        '-':
          if havedate then
          begin
            state := stGMTH;
            pos := 0;
            v := 0;
            inc(p);
            inctz := True;
          end else
            goto error;
        'Z', 'z':
             if havedate then
               state := stUTC else
               goto error;
        #0: state := stEnd;
      else
        goto error;
      end;
    stUTC: // = GMT 0
      begin
        havetz := True;
        inc(p);
        if p^ = #0 then
          Break else
          goto error;
      end;
    stGMTH:
      begin
        havetz := True;
        case pos of
          0..1: if get(v, p^) then
                begin
                  inc(p);
                  inc(pos);
                end else
                  goto error;
          2:
            begin
              st.bias := v * 60;
              case p^ of
                ':': if sep in [yes, perhaps] then
                     begin
                       state := stGMTM;
                       inc(p);
                       pos := 0;
                       v := 0;
                       sep := yes;
                     end else
                       goto error;
                '0'..'9':
                     if sep in [no, perhaps] then
                     begin
                       state := stGMTM;
                       pos := 1;
                       sep := no;
                       inc(p);
                       v := ord(p^) - ord('0');
                     end else
                       goto error;
                #0: state := stGMTend;
              else
                goto error;
              end;

            end;
        end;
      end;
    stGMTM:
      case pos of
        0..1:  if get(v, p^) then
               begin
                 inc(p);
                 inc(pos);
               end else
                 goto error;
        2:  case p^ of
              #0:
                begin
                  state := stGMTend;
                  inc(st.Bias, v);
                end;
            else
              goto error;
            end;
      end;
    stGMTend:
      begin
        if not inctz then
          st.Bias := -st.bias;
        Break;
      end;
    stEnd:
    begin

      Break;
    end;
  end;

  if (st.hour >= 24) or (st.minute >= 60) or (st.second >= 60) or (st.ms >= 1000) or (st.week > 53)
    then goto error;

  if not havetz then
    st.bias := GetTimeBias;

  ms := st.ms + st.second * 1000 + (st.minute + st.bias) * 60000 + st.hour * 3600000;
  if havedate then
  begin
    DayTable := @MonthDays[IsLeapYear(st.year)];
    if st.month <> 0 then
    begin
      if not (st.month in [1..12]) or (DayTable^[st.month] < st.day) then
        goto error;

      for v := 1 to  st.month - 1 do
        Inc(ms, DayTable^[v] * 86400000);
    end;
    dec(st.year);
    ms := ms + (int64((st.year * 365) + (st.year div 4) - (st.year div 100) +
      (st.year div 400) + st.day + st.dayofyear - 719163) * 86400000);
  end;

 Result := True;
 Exit;
error:
  Result := False;
end;

function ISO8601DateToDelphiDateTime(const str: SOString; var dt: TDateTime): Boolean;
var
  ms: Int64;
begin
  Result := ISO8601DateToJavaDateTime(str, ms);
  if Result then
    dt := JavaToDelphiDateTime(ms)
end;

function DelphiDateTimeToISO8601Date(dt: TDateTime): SOString;
var
  year, month, day, hour, min, sec, msec: Word;
  tzh: SmallInt;
  tzm: Word;
  sign: SOChar;
  bias: Integer;
begin
  DecodeDate(dt, year, month, day);
  DecodeTime(dt, hour, min, sec, msec);
  bias := GetTimeBias;
  tzh := Abs(bias) div 60;
  tzm := Abs(bias) - tzh * 60;
  if Bias > 0 then
    sign := '-' else
    sign := '+';
  Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2d,%d%s%.2d:%.2d',
    [year, month, day, hour, min, sec, msec, sign, tzh, tzm]);
end;

function TryObjectToDate(const obj: ISuperObject; var dt: TDateTime): Boolean;
var
  i: Int64;
begin
  case ObjectGetType(obj) of
  stInt:
    begin
      dt := JavaToDelphiDateTime(obj.AsInteger);
      Result := True;
    end;
  stString:
    begin
      if ISO8601DateToJavaDateTime(obj.AsString, i) then
      begin
        dt := JavaToDelphiDateTime(i);
        Result := True;
      end else
        Result := TryStrToDateTime(obj.AsString, dt);
    end;
  else
    Result := False;
  end;
end;

function SO(const s: SOString): ISuperObject; overload;
begin
  Result := TSuperObject.ParseString(PSOChar(s), False);
end;

function SA(const Args: array of const): ISuperObject; overload;
type
  TByteArray = array[0..sizeof(integer) - 1] of byte;
  PByteArray = ^TByteArray;
var
  j: Integer;
  intf: IInterface;
begin
  Result := TSuperObject.Create(stArray);
  for j := 0 to length(Args) - 1 do
    with Result.AsArray do
    case TVarRec(Args[j]).VType of
      vtInteger : Add(TSuperObject.Create(TVarRec(Args[j]).VInteger));
      vtInt64   : Add(TSuperObject.Create(TVarRec(Args[j]).VInt64^));
      vtBoolean : Add(TSuperObject.Create(TVarRec(Args[j]).VBoolean));
      vtChar    : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VChar)));
      vtWideChar: Add(TSuperObject.Create(SOChar(TVarRec(Args[j]).VWideChar)));
      vtExtended: Add(TSuperObject.Create(TVarRec(Args[j]).VExtended^));
      vtCurrency: Add(TSuperObject.CreateCurrency(TVarRec(Args[j]).VCurrency^));
      vtString  : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VString^)));
      vtPChar   : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VPChar^)));
      vtAnsiString: Add(TSuperObject.Create(SOString(AnsiString(TVarRec(Args[j]).VAnsiString))));
      vtWideString: Add(TSuperObject.Create(SOString(PWideChar(TVarRec(Args[j]).VWideString))));
      vtInterface:
        if TVarRec(Args[j]).VInterface = nil then
          Add(nil) else
          if IInterface(TVarRec(Args[j]).VInterface).QueryInterface(ISuperObject, intf) = 0 then
            Add(ISuperObject(intf)) else
            Add(nil);
      vtPointer :
        if TVarRec(Args[j]).VPointer = nil then
          Add(nil) else
          Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer)));
      vtVariant:
        Add(SO(TVarRec(Args[j]).VVariant^));
      vtObject:
        if TVarRec(Args[j]).VPointer = nil then
          Add(nil) else
          Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer)));
      vtClass:
        if TVarRec(Args[j]).VPointer = nil then
          Add(nil) else
          Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer)));
{$if declared(vtUnicodeString)}
      vtUnicodeString:
          Add(TSuperObject.Create(SOString(string(TVarRec(Args[j]).VUnicodeString))));
{$ifend}
    else
      assert(false);
    end;
end;

function SO(const Args: array of const): ISuperObject; overload;
var
  j: Integer;
  arr: ISuperObject;
begin
  Result := TSuperObject.Create(stObject);
  arr := SA(Args);
  with arr.AsArray do
    for j := 0 to (Length div 2) - 1 do
      Result.AsObject.PutO(O[j*2].AsString, O[(j*2) + 1]);
end;

function SO(const value: Variant): ISuperObject; overload;
begin
  with TVarData(value) do
  case VType of
    varNull:     Result := nil;
    varEmpty:    Result := nil;
    varSmallInt: Result := TSuperObject.Create(VSmallInt);
    varInteger:  Result := TSuperObject.Create(VInteger);
    varSingle:   Result := TSuperObject.Create(VSingle);
    varDouble:   Result := TSuperObject.Create(VDouble);
    varCurrency: Result := TSuperObject.CreateCurrency(VCurrency);
    varDate:     Result := TSuperObject.Create(DelphiToJavaDateTime(vDate));
    varOleStr:   Result := TSuperObject.Create(SOString(VOleStr));
    varBoolean:  Result := TSuperObject.Create(VBoolean);
    varShortInt: Result := TSuperObject.Create(VShortInt);
    varByte:     Result := TSuperObject.Create(VByte);
    varWord:     Result := TSuperObject.Create(VWord);
    varLongWord: Result := TSuperObject.Create(VLongWord);
    varInt64:    Result := TSuperObject.Create(VInt64);
    varString:   Result := TSuperObject.Create(SOString(AnsiString(VString)));
{$if declared(varUString)}
  {$IFDEF FPC}
    varUString:  Result := TSuperObject.Create(SOString(UnicodeString(VString)));
  {$ELSE}
    varUString:  Result := TSuperObject.Create(SOString(string(VUString)));
  {$ENDIF}
{$ifend}
  else
    raise Exception.CreateFmt('Unsuported variant data type: %d', [VType]);
  end;
end;

function ObjectIsError(obj: TSuperObject): boolean;
begin
  Result := PtrUInt(obj) > PtrUInt(-4000);
end;

function ObjectIsType(const obj: ISuperObject; typ: TSuperType): boolean;
begin
  if obj <> nil then
    Result := typ = obj.DataType else
    Result := typ = stNull;
end;

function ObjectGetType(const obj: ISuperObject): TSuperType;
begin
  if obj <> nil then
    Result := obj.DataType else
    Result := stNull;
end;

function ObjectIsNull(const obj: ISuperObject): Boolean;
begin
  Result := ObjectIsType(obj, stNull);
end;

function ObjectFindFirst(const obj: ISuperObject; var F: TSuperObjectIter): boolean;
var
  i: TSuperAvlEntry;
begin
  if ObjectIsType(obj, stObject) then
  begin
    F.Ite := TSuperAvlIterator.Create(obj.AsObject);
    F.Ite.First;
    i := F.Ite.GetIter;
    if i <> nil then
    begin
      f.key := i.Name;
      f.val := i.Value;
      Result := true;
    end else
      Result := False;
  end else
    Result := False;
end;

function ObjectFindNext(var F: TSuperObjectIter): boolean;
var
  i: TSuperAvlEntry;
begin
  F.Ite.Next;
  i := F.Ite.GetIter;
  if i <> nil then
  begin
    f.key := i.FName;
    f.val := i.Value;
    Result := true;
  end else
    Result := False;
end;

procedure ObjectFindClose(var F: TSuperObjectIter);
begin
  F.Ite.Free;
  F.val := nil;
end;

function UuidFromString(p: PSOChar; Uuid: PGUID): Boolean;
const
  hex2bin: array[48..102] of Byte = (
     0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0,
     0,10,11,12,13,14,15, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     0,10,11,12,13,14,15);
type
  TState = (stEatSpaces, stStart, stHEX, stBracket, stEnd);
  TUUID = record
    case byte of
      0: (guid: TGUID);
      1: (bytes: array[0..15] of Byte);
      2: (words: array[0..7] of Word);
      3: (ints: array[0..3] of Cardinal);
      4: (i64s: array[0..1] of UInt64);
  end;

  function ishex(const c: SOChar): Boolean; {$IFDEF HAVE_INLINE} inline;{$ENDIF}
  begin
    result := (c < #256) and (AnsiChar(c) in ['0'..'9', 'a'..'z', 'A'..'Z'])
  end;
var
  pos: Byte;
  state, saved: TState;
  bracket, separator: Boolean;
label
  redo;
begin
  FillChar(Uuid^, SizeOf(TGUID), 0);
  saved := stStart;
  state := stEatSpaces;
  bracket := false;
  separator := false;
  pos := 0;
  while true do
redo:
  case state of
    stEatSpaces:
      begin
        while true do
          case p^ of
            ' ', #13, #10, #9: inc(p);
          else
            state := saved;
            goto redo;
          end;
      end;
    stStart:
      case p^ of
        '{':
          begin
            bracket := true;
            inc(p);
            state := stEatSpaces;
            saved := stHEX;
            pos := 0;
          end;
      else
        state := stHEX;
      end;
    stHEX:
      case pos of
        0..7:
          if ishex(p^) then
          begin
            Uuid^.D1 := (Uuid^.D1 * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        8:
          if (p^ = '-') then
          begin
            separator := true;
            inc(p);
            inc(pos)
          end else
            inc(pos);
        13,18,23:
           if separator then
           begin
             if p^ <> '-' then
             begin
               Result := False;
               Exit;
             end;
             inc(p);
             inc(pos);
           end else
             inc(pos);
        9..12:
          if ishex(p^) then
          begin
            TUUID(Uuid^).words[2] := (TUUID(Uuid^).words[2] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        14..17:
          if ishex(p^) then
          begin
            TUUID(Uuid^).words[3] := (TUUID(Uuid^).words[3] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        19..20:
          if ishex(p^) then
          begin
            TUUID(Uuid^).bytes[8] := (TUUID(Uuid^).bytes[8] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        21..22:
          if ishex(p^) then
          begin
            TUUID(Uuid^).bytes[9] := (TUUID(Uuid^).bytes[9] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        24..25:
          if ishex(p^) then
          begin
            TUUID(Uuid^).bytes[10] := (TUUID(Uuid^).bytes[10] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        26..27:
          if ishex(p^) then
          begin
            TUUID(Uuid^).bytes[11] := (TUUID(Uuid^).bytes[11] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        28..29:
          if ishex(p^) then
          begin
            TUUID(Uuid^).bytes[12] := (TUUID(Uuid^).bytes[12] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        30..31:
          if ishex(p^) then
          begin
            TUUID(Uuid^).bytes[13] := (TUUID(Uuid^).bytes[13] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        32..33:
          if ishex(p^) then
          begin
            TUUID(Uuid^).bytes[14] := (TUUID(Uuid^).bytes[14] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        34..35:
          if ishex(p^) then
          begin
            TUUID(Uuid^).bytes[15] := (TUUID(Uuid^).bytes[15] * 16) + hex2bin[Ord(p^)];
            inc(p);
            inc(pos);
          end else
          begin
            Result := False;
            Exit;
          end;
        36: if bracket then
            begin
              state := stEatSpaces;
              saved := stBracket;
            end else
            begin
              state := stEatSpaces;
              saved := stEnd;
            end;
      end;
    stBracket:
      begin
        if p^ <> '}' then
        begin
          Result := False;
          Exit;
        end;
        inc(p);
        state := stEatSpaces;
        saved := stEnd;
      end;
    stEnd:
      begin
        if p^ <> #0 then
        begin
          Result := False;
          Exit;
        end;
        Break;
      end;
  end;
  Result := True;
end;

function UUIDToString(const g: TGUID): SOString;
begin
  Result := format('%.8x%.4x%.4x%.2x%.2x%.2x%.2x%.2x%.2x%.2x%.2x',
    [g.D1, g.D2, g.D3,
     g.D4[0], g.D4[1], g.D4[2],
     g.D4[3], g.D4[4], g.D4[5],
     g.D4[6], g.D4[7]]);
end;

function StringToUUID(const str: SOString; var g: TGUID): Boolean;
begin
  Result := UuidFromString(PSOChar(str), @g);
end;

{$IFDEF HAVE_RTTI}

function serialtoboolean(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject;
begin
  Result := TSuperObject.Create(TValueData(value).FAsSLong <> 0);
end;

function serialtodatetime(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject;
begin
  Result := TSuperObject.Create(DelphiToJavaDateTime(TValueData(value).FAsDouble));
end;

function serialtoguid(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject;
var
  g: TGUID;
begin
  value.ExtractRawData(@g);
  Result := TSuperObject.Create(
    format('%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x',
              [g.D1, g.D2, g.D3,
               g.D4[0], g.D4[1], g.D4[2],
               g.D4[3], g.D4[4], g.D4[5],
               g.D4[6], g.D4[7]])
  );
end;

function serialfromboolean(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;
var
  o: ISuperObject;
begin
  case ObjectGetType(obj) of
  stBoolean:
    begin
      TValueData(Value).FAsSLong := obj.AsInteger;
      Result := True;
    end;
  stInt:
    begin
      TValueData(Value).FAsSLong := ord(obj.AsInteger <> 0);
      Result := True;
    end;
  stString:
    begin
      o := SO(obj.AsString);
      if not ObjectIsType(o, stString) then
        Result := serialfromboolean(ctx, SO(obj.AsString), Value) else
        Result := False;
    end;
  else
    Result := False;
  end;
end;

function serialfromdatetime(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;
var
  dt: TDateTime;
  i: Int64;
begin
  case ObjectGetType(obj) of
  stInt:
    begin
      TValueData(Value).FAsDouble := JavaToDelphiDateTime(obj.AsInteger);
      Result := True;
    end;
  stString:
    begin
      if ISO8601DateToJavaDateTime(obj.AsString, i) then
      begin
        TValueData(Value).FAsDouble := JavaToDelphiDateTime(i);
        Result := True;
      end else
      if TryStrToDateTime(obj.AsString, dt) then
      begin
        TValueData(Value).FAsDouble := dt;
        Result := True;
      end else
        Result := False;
    end;
  else
    Result := False;
  end;
end;

function serialfromguid(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;
begin
  case ObjectGetType(obj) of
    stNull:
      begin
        FillChar(Value.GetReferenceToRawData^, SizeOf(TGUID), 0);
        Result := True;
      end;
    stString: Result := UuidFromString(PSOChar(obj.AsString), Value.GetReferenceToRawData);
  else
    Result := False;
  end;
end;

function SOInvoke(const obj: TValue; const method: string; const params: ISuperObject; ctx: TSuperRttiContext): ISuperObject; overload;
var
  owned: Boolean;
begin
  if ctx = nil then
  begin
    ctx := TSuperRttiContext.Create;
    owned := True;
  end else
    owned := False;
  try
    if TrySOInvoke(ctx, obj, method, params, Result) <> irSuccess then
      raise Exception.Create('Invalid method call');
  finally
    if owned then
      ctx.Free;
  end;
end;

function SOInvoke(const obj: TValue; const method: string; const params: string; ctx: TSuperRttiContext): ISuperObject; overload;
begin
  Result := SOInvoke(obj, method, so(params), ctx)
end;

function TrySOInvoke(var ctx: TSuperRttiContext; const obj: TValue;
  const method: string; const params: ISuperObject;
  var Return: ISuperObject): TSuperInvokeResult;
var
  t: TRttiInstanceType;
  m: TRttiMethod;
  a: TArray<TValue>;
  ps: TArray<TRttiParameter>;
  v: TValue;
  index: ISuperObject;

  function GetParams: Boolean;
  var
    i: Integer;
  begin
    case ObjectGetType(params) of
      stArray:
        for i := 0 to Length(ps) - 1 do
          if (pfOut in ps[i].Flags) then
            TValue.Make(nil, ps[i].ParamType.Handle, a[i]) else
            if not ctx.FromJson(ps[i].ParamType.Handle, params.AsArray[i], a[i]) then
              Exit(False);
      stObject:
        for i := 0 to Length(ps) - 1 do
          if (pfOut in ps[i].Flags) then
            TValue.Make(nil, ps[i].ParamType.Handle, a[i]) else
            if not ctx.FromJson(ps[i].ParamType.Handle, params.AsObject[ps[i].Name], a[i]) then
              Exit(False);
      stNull: ;
    else
      Exit(False);
    end;
    Result := True;
  end;

  procedure SetParams;
  var
    i: Integer;
  begin
    case ObjectGetType(params) of
      stArray:
        for i := 0 to Length(ps) - 1 do
          if (ps[i].Flags * [pfVar, pfOut]) <> [] then
            params.AsArray[i] := ctx.ToJson(a[i], index);
      stObject:
        for i := 0 to Length(ps) - 1 do
          if (ps[i].Flags * [pfVar, pfOut]) <> [] then
            params.AsObject[ps[i].Name] := ctx.ToJson(a[i], index);
    end;
  end;

begin
  Result := irSuccess;
  index := SO;
  case obj.Kind of
    tkClass:
      begin
        t := TRttiInstanceType(ctx.Context.GetType(obj.AsObject.ClassType));
        m := t.GetMethod(method);
        if m = nil then Exit(irMethothodError);
        ps := m.GetParameters;
        SetLength(a, Length(ps));
        if not GetParams then Exit(irParamError);
        if m.IsClassMethod then
        begin
          v := m.Invoke(obj.AsObject.ClassType, a);
          Return := ctx.ToJson(v, index);
          SetParams;
        end else
        begin
          v := m.Invoke(obj, a);
          Return := ctx.ToJson(v, index);
          SetParams;
        end;
      end;
    tkClassRef:
      begin
        t := TRttiInstanceType(ctx.Context.GetType(obj.AsClass));
        m := t.GetMethod(method);
        if m = nil then Exit(irMethothodError);
        ps := m.GetParameters;
        SetLength(a, Length(ps));

        if not GetParams then Exit(irParamError);
        if m.IsClassMethod then
        begin
          v := m.Invoke(obj, a);
          Return := ctx.ToJson(v, index);
          SetParams;
        end else
          Exit(irError);
      end;
  else
    Exit(irError);
  end;
end;

{$ENDIF}

{ TSuperEnumerator }

constructor TSuperEnumerator.Create(const obj: ISuperObject);
begin
  FObj := obj;
  FCount := -1;
  if ObjectIsType(FObj, stObject) then
    FObjEnum := FObj.AsObject.GetEnumerator else
    FObjEnum := nil;
end;

destructor TSuperEnumerator.Destroy;
begin
  if FObjEnum <> nil then
    FObjEnum.Free;
end;

function TSuperEnumerator.MoveNext: Boolean;
begin
  case ObjectGetType(FObj) of
    stObject: Result := FObjEnum.MoveNext;
    stArray:
      begin
        inc(FCount);
        if FCount < FObj.AsArray.Length then
          Result := True else
          Result := False;
      end;
  else
    Result := false;
  end;
end;

function TSuperEnumerator.GetCurrent: ISuperObject;
begin
  case ObjectGetType(FObj) of
    stObject: Result := FObjEnum.Current.Value;
    stArray: Result := FObj.AsArray.GetO(FCount);
  else
    Result := FObj;
  end;
end;

{ TSuperObject }

constructor TSuperObject.Create(jt: TSuperType);
begin
  inherited Create;
{$IFDEF DEBUG}
  InterlockedIncrement(debugcount);
{$ENDIF}

  FProcessing := false;
  FDataPtr := nil;
  FDataType := jt;
  case FDataType of
    stObject: FO.c_object := TSuperTableString.Create;
    stArray: FO.c_array := TSuperArray.Create;
    stString: FOString := '';
  else
    FO.c_object := nil;
  end;
end;

constructor TSuperObject.Create(b: boolean);
begin
  Create(stBoolean);
  FO.c_boolean := b;
end;

constructor TSuperObject.Create(i: SuperInt);
begin
  Create(stInt);
  FO.c_int := i;
end;

constructor TSuperObject.Create(d: double);
begin
  Create(stDouble);
  FO.c_double := d;
end;

constructor TSuperObject.CreateCurrency(c: Currency);
begin
  Create(stCurrency);
  FO.c_currency := c;
end;

destructor TSuperObject.Destroy;
begin
{$IFDEF DEBUG}
  InterlockedDecrement(debugcount);
{$ENDIF}
  case FDataType of
    stObject: FO.c_object.Free;
    stArray: FO.c_array.Free;
  end;
  inherited;
end;

function TSuperObject.Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer;
function DoEscape(str: PSOChar; len: Integer): Integer;
var
  pos, start_offset: Integer;
  c: SOChar;
  buf: array[0..5] of SOChar;
type
  TByteChar = record
  case integer of
    0: (a, b: Byte);
    1: (c: WideChar);
  end;
  begin
    if str = nil then
    begin
      Result := 0;
      exit;
    end;
    pos := 0; start_offset := 0;
    with writer do
    while pos < len do
    begin
      c := str[pos];
      case c of
        #8,#9,#10,#12,#13,'"','\','/':
          begin
            if(pos - start_offset > 0) then
              Append(str + start_offset, pos - start_offset);

            if(c = #8) then Append(ESC_BS, 2)
            else if (c = #9) then Append(ESC_TAB, 2)
            else if (c = #10) then Append(ESC_LF, 2)
            else if (c = #12) then Append(ESC_FF, 2)
            else if (c = #13) then Append(ESC_CR, 2)
            else if (c = '"') then Append(ESC_QUOT, 2)
            else if (c = '\') then Append(ESC_SL, 2)
            else if (c = '/') then Append(ESC_SR, 2);
            inc(pos);
            start_offset := pos;
          end;
      else
        if (SOIChar(c) > 255) then
        begin
          if(pos - start_offset > 0) then
            Append(str + start_offset, pos - start_offset);
          buf[0] := '\';
          buf[1] := 'u';
          buf[2] := super_hex_chars[TByteChar(c).b shr 4];
          buf[3] := super_hex_chars[TByteChar(c).b and $f];
          buf[4] := super_hex_chars[TByteChar(c).a shr 4];
          buf[5] := super_hex_chars[TByteChar(c).a and $f];
          Append(@buf, 6);
          inc(pos);
          start_offset := pos;
        end else
        if (c < #32) or (c > #127) then
        begin
          if(pos - start_offset > 0) then
            Append(str + start_offset, pos - start_offset);
          buf[0] := '\';
          buf[1] := 'u';
          buf[2] := '0';
          buf[3] := '0';
          buf[4] := super_hex_chars[ord(c) shr 4];
          buf[5] := super_hex_chars[ord(c) and $f];
          Append(buf, 6);
          inc(pos);
          start_offset := pos;
        end else
          inc(pos);
      end;
    end;
    if(pos - start_offset > 0) then
      writer.Append(str + start_offset, pos - start_offset);
    Result := 0;
  end;

function DoMinimalEscape(str: PSOChar; len: Integer): Integer;
var
  pos, start_offset: Integer;
  c: SOChar;
type
  TByteChar = record
  case integer of
    0: (a, b: Byte);
    1: (c: WideChar);
  end;
  begin
    if str = nil then
    begin
      Result := 0;
      exit;
    end;
    pos := 0; start_offset := 0;
    with writer do
    while pos < len do
    begin
      c := str[pos];
      case c of
        #0:
          begin
            if(pos - start_offset > 0) then
              Append(str + start_offset, pos - start_offset);
            Append(ESC_ZERO, 6);
            inc(pos);
            start_offset := pos;
          end;
        '"':
          begin
            if(pos - start_offset > 0) then
              Append(str + start_offset, pos - start_offset);
            Append(ESC_QUOT, 2);
            inc(pos);
            start_offset := pos;
          end;
        '\':
          begin
            if(pos - start_offset > 0) then
              Append(str + start_offset, pos - start_offset);
            Append(ESC_SL, 2);
            inc(pos);
            start_offset := pos;
          end;
      else
        inc(pos);
      end;
    end;
    if(pos - start_offset > 0) then
      writer.Append(str + start_offset, pos - start_offset);
    Result := 0;
  end;


  procedure _indent(i: shortint; r: boolean);
  begin
    inc(level, i);
    if r then
      with writer do
      begin
{$IFDEF MSWINDOWS}
        Append(TOK_CRLF, 2);
{$ELSE}
        Append(TOK_LF, 1);
{$ENDIF}
        for i := 0 to level - 1 do
          Append(TOK_SP, 1);
      end;
  end;
var
  k,j: Integer;
  iter: TSuperObjectIter;
  st: AnsiString;
  val: ISuperObject;
const
  ENDSTR_A: PSOChar = '": ';
  ENDSTR_B: PSOChar = '":';
begin

  if FProcessing then
  begin
    Result := writer.Append(TOK_NULL, 4);
    Exit;
  end;

  FProcessing := true;
  with writer do
  try
    case FDataType of
      stObject:
        if FO.c_object.FCount > 0 then
        begin
          k := 0;
          Append(TOK_CBL, 1);
          if indent then _indent(1, false);
          if ObjectFindFirst(Self, iter) then
          repeat
  {$IFDEF SUPER_METHOD}
            if (iter.val = nil) or not ObjectIsType(iter.val, stMethod) then
            begin
  {$ENDIF}
              if (iter.val = nil) or (not iter.val.Processing) then
              begin
                if(k <> 0) then
                  Append(TOK_COM, 1);
                if indent then _indent(0, true);
                Append(TOK_DQT, 1);
                if escape then
                  doEscape(PSOChar(iter.key), Length(iter.key)) else
                  DoMinimalEscape(PSOChar(iter.key), Length(iter.key));
                if indent then
                  Append(ENDSTR_A, 3) else
                  Append(ENDSTR_B, 2);
                if(iter.val = nil) then
                  Append(TOK_NULL, 4) else
                  iter.val.write(writer, indent, escape, level);
                inc(k);
              end;
  {$IFDEF SUPER_METHOD}
            end;
  {$ENDIF}
          until not ObjectFindNext(iter);
          ObjectFindClose(iter);
          if indent then _indent(-1, true);
          Result := Append(TOK_CBR, 1);
        end else
          Result := Append(TOK_OBJ, 2);
      stBoolean:
        begin
          if (FO.c_boolean) then
            Result := Append(TOK_TRUE, 4) else
            Result := Append(TOK_FALSE, 5);
        end;
      stInt:
        begin
          str(FO.c_int, st);
          Result := Append(PSOChar(SOString(st)));
        end;
      stDouble:
        Result := Append(PSOChar(FloatToJson(FO.c_double)));
      stCurrency:
        begin
          Result := Append(PSOChar(CurrToJson(FO.c_currency)));
        end;
      stString:
        begin
          Append(TOK_DQT, 1);
          if escape then
            doEscape(PSOChar(FOString), Length(FOString)) else
            DoMinimalEscape(PSOChar(FOString), Length(FOString));
          Append(TOK_DQT, 1);
          Result := 0;
        end;
      stArray:
        if FO.c_array.FLength > 0 then
        begin
          Append(TOK_ARL, 1);
          if indent then _indent(1, true);
          k := 0;
          j := 0;
          while k < FO.c_array.FLength do
          begin

            val :=  FO.c_array.GetO(k);
  {$IFDEF SUPER_METHOD}
            if not ObjectIsType(val, stMethod) then
            begin
  {$ENDIF}
              if (val = nil) or (not val.Processing) then
              begin
                if (j <> 0) then
                  Append(TOK_COM, 1);
                if(val = nil) then
                  Append(TOK_NULL, 4) else
                  val.write(writer, indent, escape, level);
                inc(j);
              end;
  {$IFDEF SUPER_METHOD}
            end;
  {$ENDIF}
            inc(k);
          end;
          if indent then _indent(-1, false);
          Result := Append(TOK_ARR, 1);
        end else
          Result := Append(TOK_ARRAY, 2);
      stNull:
          Result := Append(TOK_NULL, 4);
    else
      Result := 0;
    end;
  finally
    FProcessing := false;
  end;
end;

function TSuperObject.IsType(AType: TSuperType): boolean;
begin
  Result := AType = FDataType;
end;

function TSuperObject.AsBoolean: boolean;
begin
  case FDataType of
    stBoolean: Result := FO.c_boolean;
    stInt: Result := (FO.c_int <> 0);
    stDouble: Result := (FO.c_double <> 0);
    stCurrency: Result := (FO.c_currency <> 0);
    stString: Result := (Length(FOString) <> 0);
    stNull: Result := False;
  else
    Result := True;
  end;
end;

function TSuperObject.AsInteger: SuperInt;
var
  code: integer;
  cint: SuperInt;
begin
  case FDataType of
    stInt: Result := FO.c_int;
    stDouble: Result := round(FO.c_double);
    stCurrency: Result := round(FO.c_currency);
    stBoolean: Result := ord(FO.c_boolean);
    stString:
      begin
        Val(FOString, cint, code);
        if code = 0 then
          Result := cint else
          Result := 0;
      end;
  else
    Result := 0;
  end;
end;

function TSuperObject.AsDouble: Double;
var
  code: integer;
  cdouble: double;
begin
  case FDataType of
    stDouble: Result := FO.c_double;
    stCurrency: Result := FO.c_currency;
    stInt: Result := FO.c_int;
    stBoolean: Result := ord(FO.c_boolean);
    stString:
      begin
        Val(FOString, cdouble, code);
        if code = 0 then
          Result := cdouble else
          Result := 0.0;
      end;
  else
    Result := 0.0;
  end;
end;

function TSuperObject.AsCurrency: Currency;
var
  code: integer;
  cdouble: double;
begin
  case FDataType of
    stDouble: Result := FO.c_double;
    stCurrency: Result := FO.c_currency;
    stInt: Result := FO.c_int;
    stBoolean: Result := ord(FO.c_boolean);
    stString:
      begin
        Val(FOString, cdouble, code);
        if code = 0 then
          Result := cdouble else
          Result := 0.0;
      end;
  else
    Result := 0.0;
  end;
end;

function TSuperObject.AsString: SOString;
begin
  case FDataType of
    stString: Result := FOString;
    stNull: Result := '';
  else
    Result := AsJSon(false, false);
  end;
end;

function TSuperObject.GetEnumerator: TSuperEnumerator;
begin
  Result := TSuperEnumerator.Create(Self);
end;

procedure TSuperObject.AfterConstruction;
begin
  InterlockedDecrement(FRefCount);
end;

procedure TSuperObject.BeforeDestruction;
begin
  if RefCount <> 0 then
    raise Exception.Create('Invalid pointer');
end;

function TSuperObject.AsArray: TSuperArray;
begin
  if FDataType = stArray then
    Result := FO.c_array else
    Result := nil;
end;

function TSuperObject.AsObject: TSuperTableString;
begin
  if FDataType = stObject then
    Result := FO.c_object else
    Result := nil;
end;

function TSuperObject.AsJSon(indent, escape: boolean): SOString;
var
  pb: TSuperWriterString;
begin
  pb := TSuperWriterString.Create;
  try
    if(Write(pb, indent, escape, 0) < 0) then
    begin
      Result := '';
      Exit;
    end;
    if pb.FBPos > 0 then
      Result := pb.FBuf else
      Result := '';
  finally
    pb.Free;
  end;
end;

class function TSuperObject.ParseString(s: PSOChar; strict: Boolean; partial: boolean; const this: ISuperObject;
  options: TSuperFindOptions; const put: ISuperObject; dt: TSuperType): ISuperObject;
var
  tok: TSuperTokenizer;
  obj: ISuperObject;
begin
  tok := TSuperTokenizer.Create;
  obj := ParseEx(tok, s, -1, strict, this, options, put, dt);
  if(tok.err <> teSuccess) or (not partial and (s[tok.char_offset] <> #0)) then
    Result := nil else
    Result := obj;
  tok.Free;
end;

class function TSuperObject.ParseStream(stream: TStream; strict: Boolean;
  partial: boolean; const this: ISuperObject; options: TSuperFindOptions;
   const put: ISuperObject; dt: TSuperType): ISuperObject;
const
  BUFFER_SIZE = 10240;
var
  tok: TSuperTokenizer;
  buffera: array[0..BUFFER_SIZE-1] of AnsiChar;
  bufferw: array[0..BUFFER_SIZE-1] of SOChar;
  bom: array[0..1] of byte;
  unicode: boolean;
  j, size: Integer;
  st: string;
begin
  st := '';
  tok := TSuperTokenizer.Create;

  if (stream.Read(bom, sizeof(bom)) = 2) and (bom[0] = $FF) and (bom[1] = $FE) then
  begin
    unicode := true;
    size := stream.Read(bufferw, BUFFER_SIZE * SizeOf(SoChar)) div SizeOf(SoChar);
  end else
    begin
      unicode := false;
      stream.Seek(0, soFromBeginning);
      size := stream.Read(buffera, BUFFER_SIZE);
    end;

  while size > 0 do
  begin
    if not unicode then
      for j := 0 to size - 1 do
        bufferw[j] := SOChar(buffera[j]);
    ParseEx(tok, bufferw, size, strict, this, options, put, dt);

    if tok.err = teContinue then
      begin
        if not unicode then
          size := stream.Read(buffera, BUFFER_SIZE) else
          size := stream.Read(bufferw, BUFFER_SIZE * SizeOf(SoChar)) div SizeOf(SoChar);
      end else
      Break;
  end;
  if(tok.err <> teSuccess) or (not partial and (st[tok.char_offset] <> #0)) then
    Result := nil else
    Result := tok.stack[tok.depth].current;
  tok.Free;
end;

class function TSuperObject.ParseFile(const FileName: string; strict: Boolean;
  partial: boolean; const this: ISuperObject; options: TSuperFindOptions;
  const put: ISuperObject; dt: TSuperType): ISuperObject;
var
  stream: TFileStream;
begin
  stream := TFileStream.Create(FileName, fmOpenRead, fmShareDenyNone);
  try
    Result := ParseStream(stream, strict, partial, this, options, put, dt);
  finally
    stream.Free;
  end;
end;

class function TSuperObject.ParseEx(tok: TSuperTokenizer; str: PSOChar; len: integer;
  strict: Boolean; const this: ISuperObject; options: TSuperFindOptions; const put: ISuperObject; dt: TSuperType): ISuperObject;

const
  spaces = [#32,#8,#9,#10,#12,#13];
  delimiters = ['"', '.', '[', ']', '{', '}', '(', ')', ',', ':', #0];
  reserved = delimiters + spaces;
  path = ['a'..'z', 'A'..'Z', '.', '_'];

  function hexdigit(x: SOChar): byte; {$IFDEF HAVE_INLINE} inline;{$ENDIF}
  begin
    if x <= '9' then
      Result := byte(x) - byte('0') else
      Result := (byte(x) and 7) + 9;
  end;
  function min(v1, v2: integer): integer;{$IFDEF HAVE_INLINE} inline;{$ENDIF}
  begin if v1 < v2 then result := v1 else result := v2 end;

var
  obj: ISuperObject;
  v: SOChar;
{$IFDEF SUPER_METHOD}
  sm: TSuperMethod;
{$ENDIF}
  numi: SuperInt;
  numd: Double;
  code: integer;
  TokRec: PSuperTokenerSrec;
  evalstack: integer;
  p: PSOChar;

  function IsEndDelimiter(v: AnsiChar): Boolean;
  begin
    if tok.depth > 0 then
      case tok.stack[tok.depth - 1].state of
        tsArrayAdd: Result := v in [',', ']', #0];
        tsObjectValueAdd: Result := v in [',', '}', #0];
      else
        Result := v = #0;
      end else
        Result := v = #0;
  end;

label out, redo_char;
begin
  evalstack := 0;
  obj := nil;
  Result := nil;
  TokRec := @tok.stack[tok.depth];

  tok.char_offset := 0;
  tok.err := teSuccess;

  repeat
    if (tok.char_offset = len) then
    begin
      if (tok.depth = 0) and (TokRec^.state = tsEatws) and
         (TokRec^.saved_state = tsFinish) then
        tok.err := teSuccess else
        tok.err := teContinue;
      goto out;
    end;

    v := str^;

    case v of
    #10:
      begin
        inc(tok.line);
        tok.col := 0;
      end;
    #9: inc(tok.col, 4);
    else
      inc(tok.col);
    end;

redo_char:
    case TokRec^.state of
    tsEatws:
      begin
        if (SOIChar(v) < 256) and (AnsiChar(v) in spaces) then {nop} else
        if (v = '/') then
        begin
          tok.pb.Reset;
          tok.pb.Append(@v, 1);
          TokRec^.state := tsCommentStart;
        end else begin
          TokRec^.state := TokRec^.saved_state;
          goto redo_char;
        end
      end;

    tsStart:
      case v of
      '"',
      '''':
        begin
          TokRec^.state := tsString;
          tok.pb.Reset;
          tok.quote_char := v;
        end;
      '-':
        begin
          TokRec^.state := tsNumber;
          tok.pb.Reset;
          tok.is_double := 0;
          tok.floatcount := -1;
          goto redo_char;
        end;

      '0'..'9':
        begin
          if (tok.depth = 0) then
            case ObjectGetType(this) of
            stObject:
              begin
                TokRec^.state := tsIdentifier;
                TokRec^.current := this;
                goto redo_char;
              end;
          end;
          TokRec^.state := tsNumber;
          tok.pb.Reset;
          tok.is_double := 0;
          tok.floatcount := -1;
          goto redo_char;
        end;
      '{':
        begin
          TokRec^.state := tsEatws;
          TokRec^.saved_state := tsObjectFieldStart;
          TokRec^.current := TSuperObject.Create(stObject);
        end;
      '[':
        begin
          TokRec^.state := tsEatws;
          TokRec^.saved_state := tsArray;
          TokRec^.current := TSuperObject.Create(stArray);
        end;
{$IFDEF SUPER_METHOD}
      '(':
        begin
          if (tok.depth = 0) and ObjectIsType(this, stMethod) then
          begin
            TokRec^.current := this;
            TokRec^.state := tsParamValue;
          end;
        end;
{$ENDIF}
      'N',
      'n':
        begin
          TokRec^.state := tsNull;
          tok.pb.Reset;
          tok.st_pos := 0;
          goto redo_char;
        end;
      'T',
      't',
      'F',
      'f':
        begin
          TokRec^.state := tsBoolean;
          tok.pb.Reset;
          tok.st_pos := 0;
          goto redo_char;
        end;
      else
        TokRec^.state := tsIdentifier;
        tok.pb.Reset;
        goto redo_char;
      end;

    tsFinish:
      begin
        if(tok.depth = 0) then goto out;
        obj := TokRec^.current;
        tok.ResetLevel(tok.depth);
        dec(tok.depth);
        TokRec := @tok.stack[tok.depth];
        goto redo_char;
      end;

    tsNull:
      begin
        tok.pb.Append(@v, 1);
        if (StrLComp(TOK_NULL, PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 4)) = 0) then
        begin
          if (tok.st_pos = 4) then
          if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then
            TokRec^.state := tsIdentifier else
          begin
            TokRec^.current := TSuperObject.Create(stNull);
            TokRec^.saved_state := tsFinish;
            TokRec^.state := tsEatws;
            goto redo_char;
          end;
        end else
        begin
          TokRec^.state := tsIdentifier;
          tok.pb.FBuf[tok.st_pos] := #0;
          dec(tok.pb.FBPos);
          goto redo_char;
        end;
        inc(tok.st_pos);
      end;

    tsCommentStart:
      begin
        if(v = '*') then
        begin
          TokRec^.state := tsComment;
        end else
        if (v = '/') then
        begin
          TokRec^.state := tsCommentEol;
        end else
        begin
          tok.err := teParseComment;
          goto out;
        end;
        tok.pb.Append(@v, 1);
      end;

    tsComment:
      begin
        if(v = '*') then
          TokRec^.state := tsCommentEnd;
        tok.pb.Append(@v, 1);
      end;

    tsCommentEol:
      begin
        if (v = #10) then
          TokRec^.state := tsEatws else
          tok.pb.Append(@v, 1);
      end;

    tsCommentEnd:
      begin
        tok.pb.Append(@v, 1);
        if (v = '/') then
          TokRec^.state := tsEatws else
          TokRec^.state := tsComment;
      end;

    tsString:
      begin
        if (v = tok.quote_char) then
        begin
          TokRec^.current := TSuperObject.Create(SOString(tok.pb.GetString));
          TokRec^.saved_state := tsFinish;
          TokRec^.state := tsEatws;
        end else
        if (v = '\') then
        begin
          TokRec^.saved_state := tsString;
          TokRec^.state := tsStringEscape;
        end else
        begin
          tok.pb.Append(@v, 1);
        end
      end;

    tsEvalProperty:
      begin
        if (TokRec^.current = nil) and (foCreatePath in options) then
        begin
          TokRec^.current := TSuperObject.Create(stObject);
          TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current)
        end else
        if not ObjectIsType(TokRec^.current, stObject) then
        begin
          tok.err := teEvalObject;
          goto out;
        end;
        tok.pb.Reset;
        TokRec^.state := tsIdentifier;
        goto redo_char;
      end;

    tsEvalArray:
      begin
        if (TokRec^.current = nil) and (foCreatePath in options) then
        begin
          TokRec^.current := TSuperObject.Create(stArray);
          TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current)
        end else
        if not ObjectIsType(TokRec^.current, stArray) then
        begin
          tok.err := teEvalArray;
          goto out;
        end;
        tok.pb.Reset;
        TokRec^.state := tsParamValue;
        goto redo_char;
      end;
{$IFDEF SUPER_METHOD}
    tsEvalMethod:
      begin
        if ObjectIsType(TokRec^.current, stMethod) and assigned(TokRec^.current.AsMethod) then
        begin
          tok.pb.Reset;
          TokRec^.obj := TSuperObject.Create(stArray);
          TokRec^.state := tsMethodValue;
          goto redo_char;
        end else
        begin
          tok.err := teEvalMethod;
          goto out;
        end;
      end;

    tsMethodValue:
      begin
        case v of
        ')':
            TokRec^.state := tsIdentifier;
        else
          if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then
          begin
            tok.err := teDepth;
            goto out;
          end;
          inc(evalstack);
          TokRec^.state := tsMethodPut;
          inc(tok.depth);
          tok.ResetLevel(tok.depth);
          TokRec := @tok.stack[tok.depth];
          goto redo_char;
        end;
      end;

    tsMethodPut:
      begin
        TokRec^.obj.AsArray.Add(obj);
        case v of
          ',':
            begin
              tok.pb.Reset;
              TokRec^.saved_state := tsMethodValue;
              TokRec^.state := tsEatws;
            end;
          ')':
            begin
              if TokRec^.obj.AsArray.Length = 1 then
                TokRec^.obj := TokRec^.obj.AsArray.GetO(0);
              dec(evalstack);
              tok.pb.Reset;
              TokRec^.saved_state := tsIdentifier;
              TokRec^.state := tsEatws;
            end;
        else
          tok.err := teEvalMethod;
          goto out;
        end;
      end;
{$ENDIF}
    tsParamValue:
      begin
        case v of
        ']':
            TokRec^.state := tsIdentifier;
        else
          if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then
          begin
            tok.err := teDepth;
            goto out;
          end;
          inc(evalstack);
          TokRec^.state := tsParamPut;
          inc(tok.depth);
          tok.ResetLevel(tok.depth);
          TokRec := @tok.stack[tok.depth];
          goto redo_char;
        end;
      end;

    tsParamPut:
      begin
        dec(evalstack);
        TokRec^.obj := obj;
        tok.pb.Reset;
        TokRec^.saved_state := tsIdentifier;
        TokRec^.state := tsEatws;
        if v <> ']' then
        begin
          tok.err := teEvalArray;
          goto out;
        end;
      end;

    tsIdentifier:
      begin
        if (this = nil) then
        begin
          if (SOIChar(v) < 256) and IsEndDelimiter(AnsiChar(v)) then
          begin
            if not strict then
            begin
              tok.pb.TrimRight;
              TokRec^.current := TSuperObject.Create(tok.pb.Fbuf);
              TokRec^.saved_state := tsFinish;
              TokRec^.state := tsEatws;
              goto redo_char;
            end else
            begin
              tok.err := teParseString;
              goto out;
            end;
          end else
          if (v = '\') then
          begin
            TokRec^.saved_state := tsIdentifier;
            TokRec^.state := tsStringEscape;
          end else
            tok.pb.Append(@v, 1);
        end else
        begin
         if (SOIChar(v) < 256) and (AnsiChar(v) in reserved) then
         begin
           TokRec^.gparent := TokRec^.parent;
           if TokRec^.current = nil then
             TokRec^.parent := this else
             TokRec^.parent := TokRec^.current;

             case ObjectGetType(TokRec^.parent) of
               stObject:
                 case v of
                   '.':
                     begin
                       TokRec^.state := tsEvalProperty;
                       if tok.pb.FBPos > 0 then
                         TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);
                     end;
                   '[':
                     begin
                       TokRec^.state := tsEvalArray;
                       if tok.pb.FBPos > 0 then
                         TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);
                     end;
                   '(':
                     begin
                       TokRec^.state := tsEvalMethod;
                       if tok.pb.FBPos > 0 then
                         TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);
                     end;
                 else
                   if tok.pb.FBPos > 0 then
                     TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);
                   if (foPutValue in options) and (evalstack = 0) then
                   begin
                     TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, put);
                     TokRec^.current := put
                   end else
                   if (foDelete in options) and (evalstack = 0) then
                   begin
                     TokRec^.current := TokRec^.parent.AsObject.Delete(tok.pb.Fbuf);
                   end else
                   if (TokRec^.current = nil) and (foCreatePath in options) then
                   begin
                     TokRec^.current := TSuperObject.Create(dt);
                     TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current);
                   end;
                   TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);
                   TokRec^.state := tsFinish;
                   goto redo_char;
                 end;
               stArray:
                 begin
                   if TokRec^.obj <> nil then
                   begin
                     if not ObjectIsType(TokRec^.obj, stInt) or (TokRec^.obj.AsInteger < 0) then
                     begin
                       tok.err := teEvalInt;
                       TokRec^.obj := nil;
                       goto out;
                     end;
                     numi := TokRec^.obj.AsInteger;
                     TokRec^.obj := nil;

                     TokRec^.current := TokRec^.parent.AsArray.GetO(numi);
                     case v of
                       '.':
                         if (TokRec^.current = nil) and (foCreatePath in options) then
                         begin
                           TokRec^.current := TSuperObject.Create(stObject);
                           TokRec^.parent.AsArray.PutO(numi, TokRec^.current);
                         end else
                         if (TokRec^.current = nil) then
                         begin
                           tok.err := teEvalObject;
                           goto out;
                         end;
                       '[':
                         begin
                           if (TokRec^.current = nil) and (foCreatePath in options) then
                           begin
                             TokRec^.current := TSuperObject.Create(stArray);
                             TokRec^.parent.AsArray.Add(TokRec^.current);
                           end else
                           if (TokRec^.current = nil) then
                           begin
                             tok.err := teEvalArray;
                             goto out;
                           end;
                           TokRec^.state := tsEvalArray;
                         end;
                       '(': TokRec^.state := tsEvalMethod;
                     else
                       if (foPutValue in options) and (evalstack = 0) then
                       begin
                         TokRec^.parent.AsArray.PutO(numi, put);
                         TokRec^.current := put;
                       end else
                       if (foDelete in options) and (evalstack = 0) then
                       begin
                         TokRec^.current := TokRec^.parent.AsArray.Delete(numi);
                       end else
                         TokRec^.current := TokRec^.parent.AsArray.GetO(numi);
                       TokRec^.state := tsFinish;
                       goto redo_char
                     end;
                   end else
                   begin
                     case v of
                       '.':
                         begin
                           if (foPutValue in options) then
                           begin
                             TokRec^.current := TSuperObject.Create(stObject);
                             TokRec^.parent.AsArray.Add(TokRec^.current);
                           end else
                             TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1);
                         end;
                       '[':
                         begin
                           if (foPutValue in options) then
                           begin
                             TokRec^.current := TSuperObject.Create(stArray);
                             TokRec^.parent.AsArray.Add(TokRec^.current);
                           end else
                             TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1);
                           TokRec^.state := tsEvalArray;
                         end;
                       '(':
                         begin
                           if not (foPutValue in options) then
                             TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1) else
                             TokRec^.current := nil;

                           TokRec^.state := tsEvalMethod;
                         end;
                     else
                       if (foPutValue in options) and (evalstack = 0) then
                       begin
                         TokRec^.parent.AsArray.Add(put);
                         TokRec^.current := put;
                       end else
                         if tok.pb.FBPos = 0 then
                           TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1);
                       TokRec^.state := tsFinish;
                       goto redo_char
                     end;
                   end;
                 end;
{$IFDEF SUPER_METHOD}
               stMethod:
                 case v of
                   '.':
                     begin
                       TokRec^.current := nil;
                       sm := TokRec^.parent.AsMethod;
                       sm(TokRec^.gparent, TokRec^.obj, TokRec^.current);
                       TokRec^.obj := nil;
                     end;
                   '[':
                     begin
                       TokRec^.current := nil;
                       sm := TokRec^.parent.AsMethod;
                       sm(TokRec^.gparent, TokRec^.obj, TokRec^.current);
                       TokRec^.state := tsEvalArray;
                       TokRec^.obj := nil;
                     end;
                   '(':
                     begin
                       TokRec^.current := nil;
                       sm := TokRec^.parent.AsMethod;
                       sm(TokRec^.gparent, TokRec^.obj, TokRec^.current);
                       TokRec^.state := tsEvalMethod;
                       TokRec^.obj := nil;
                     end;
                 else
                   if not (foPutValue in options) or (evalstack > 0) then
                   begin
                     TokRec^.current := nil;
                     sm := TokRec^.parent.AsMethod;
                     sm(TokRec^.gparent, TokRec^.obj, TokRec^.current);
                     TokRec^.obj := nil;
                     TokRec^.state := tsFinish;
                     goto redo_char
                   end else
                   begin
                     tok.err := teEvalMethod;
                     TokRec^.obj := nil;
                     goto out;
                   end;
                 end;
{$ENDIF}
             end;
          end else
            tok.pb.Append(@v, 1);
        end;
      end;

    tsStringEscape:
      case v of
      'b',
      'n',
      'r',
      't',
      'f':
        begin
          if(v = 'b') then tok.pb.Append(TOK_BS, 1)
          else if(v = 'n') then tok.pb.Append(TOK_LF, 1)
          else if(v = 'r') then tok.pb.Append(TOK_CR, 1)
          else if(v = 't') then tok.pb.Append(TOK_TAB, 1)
          else if(v = 'f') then tok.pb.Append(TOK_FF, 1);
          TokRec^.state := TokRec^.saved_state;
        end;
      'u':
        begin
          tok.ucs_char := 0;
          tok.st_pos := 0;
          TokRec^.state := tsEscapeUnicode;
        end;
      'x':
        begin
          tok.ucs_char := 0;
          tok.st_pos := 0;
          TokRec^.state := tsEscapeHexadecimal;
        end
      else
        tok.pb.Append(@v, 1);
        TokRec^.state := TokRec^.saved_state;
      end;

    tsEscapeUnicode:
      begin
        if ((SOIChar(v) < 256) and (AnsiChar(v) in super_hex_chars_set)) then
        begin
          inc(tok.ucs_char, (Word(hexdigit(v)) shl ((3-tok.st_pos)*4)));
          inc(tok.st_pos);
          if (tok.st_pos = 4) then
          begin
            tok.pb.Append(@tok.ucs_char, 1);
            TokRec^.state := TokRec^.saved_state;
          end
        end else
        begin
          tok.err := teParseString;
          goto out;
        end
      end;
    tsEscapeHexadecimal:
      begin
        if ((SOIChar(v) < 256) and (AnsiChar(v) in super_hex_chars_set)) then
        begin
          inc(tok.ucs_char, (Word(hexdigit(v)) shl ((1-tok.st_pos)*4)));
          inc(tok.st_pos);
          if (tok.st_pos = 2) then
          begin
            tok.pb.Append(@tok.ucs_char, 1);
            TokRec^.state := TokRec^.saved_state;
          end
        end else
        begin
          tok.err := teParseString;
          goto out;
        end
      end;
    tsBoolean:
      begin
        tok.pb.Append(@v, 1);
        if (StrLComp('true', PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 4)) = 0) then
        begin
          if (tok.st_pos = 4) then
          if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then
            TokRec^.state := tsIdentifier else
          begin
            TokRec^.current := TSuperObject.Create(true);
            TokRec^.saved_state := tsFinish;
            TokRec^.state := tsEatws;
            goto redo_char;
          end
        end else
        if (StrLComp('false', PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 5)) = 0) then
        begin
          if (tok.st_pos = 5) then
          if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then
            TokRec^.state := tsIdentifier else
          begin
            TokRec^.current := TSuperObject.Create(false);
            TokRec^.saved_state := tsFinish;
            TokRec^.state := tsEatws;
            goto redo_char;
          end
        end else
        begin
          TokRec^.state := tsIdentifier;
          tok.pb.FBuf[tok.st_pos] := #0;
          dec(tok.pb.FBPos);
          goto redo_char;
        end;
        inc(tok.st_pos);
      end;

    tsNumber:
      begin
        if (SOIChar(v) < 256) and (AnsiChar(v) in super_number_chars_set) then
        begin
          tok.pb.Append(@v, 1);
          if (SOIChar(v) < 256) then
          case v of
          '.': begin
                 tok.is_double := 1;
                 tok.floatcount := 0;
               end;
          'e','E':
            begin
              tok.is_double := 1;
              tok.floatcount := -1;
            end;
          '0'..'9':
            begin

              if (tok.is_double = 1) and (tok.floatcount >= 0) then
              begin
                inc(tok.floatcount);
                if tok.floatcount > 4 then
                  tok.floatcount := -1;
              end;
            end;
          end;
        end else
        begin
          if (tok.is_double = 0) then
          begin
            val(tok.pb.FBuf, numi, code);
            if ObjectIsType(this, stArray) then
            begin
              if (foPutValue in options) and (evalstack = 0) then
              begin
                this.AsArray.PutO(numi, put);
                TokRec^.current := put;
              end else
              if (foDelete in options) and (evalstack = 0) then
                TokRec^.current := this.AsArray.Delete(numi) else
                TokRec^.current := this.AsArray.GetO(numi);
            end else
              TokRec^.current := TSuperObject.Create(numi);

          end else
          if (tok.is_double <> 0) then
          begin
            if tok.floatcount >= 0 then
            begin
              p := tok.pb.FBuf;
              while p^ <> '.' do inc(p);
              for code := 0 to tok.floatcount - 1 do
              begin
                p^ := p[1];
                inc(p);
              end;
              p^ := #0;
              val(tok.pb.FBuf, numi, code);
              case tok.floatcount of
                0: numi := numi * 10000;
                1: numi := numi * 1000;
                2: numi := numi * 100;
                3: numi := numi * 10;
              end;
              TokRec^.current := TSuperObject.CreateCurrency(PCurrency(@numi)^);
            end else
            begin
              val(tok.pb.FBuf, numd, code);
              TokRec^.current := TSuperObject.Create(numd);
            end;
          end else
          begin
            tok.err := teParseNumber;
            goto out;
          end;
          TokRec^.saved_state := tsFinish;
          TokRec^.state := tsEatws;
          goto redo_char;
        end
      end;

    tsArray:
      begin
        if (v = ']') then
        begin
          TokRec^.saved_state := tsFinish;
          TokRec^.state := tsEatws;
        end else
        begin
          if(tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then
          begin
            tok.err := teDepth;
            goto out;
          end;
          TokRec^.state := tsArrayAdd;
          inc(tok.depth);
          tok.ResetLevel(tok.depth);
          TokRec := @tok.stack[tok.depth];
          goto redo_char;
        end
      end;

    tsArrayAdd:
      begin
        TokRec^.current.AsArray.Add(obj);
        TokRec^.saved_state := tsArraySep;
        TokRec^.state := tsEatws;
        goto redo_char;
      end;

    tsArraySep:
      begin
        if (v = ']') then
        begin
          TokRec^.saved_state := tsFinish;
          TokRec^.state := tsEatws;
        end else
        if (v = ',') then
        begin
          TokRec^.saved_state := tsArray;
          TokRec^.state := tsEatws;
        end else
        begin
          tok.err := teParseArray;
          goto out;
        end
      end;

    tsObjectFieldStart:
      begin
        if (v = '}') then
        begin
          TokRec^.saved_state := tsFinish;
          TokRec^.state := tsEatws;
        end else
        if (SOIChar(v) < 256) and (AnsiChar(v) in ['"', '''']) then
        begin
          tok.quote_char := v;
          tok.pb.Reset;
          TokRec^.state := tsObjectField;
        end else
        if not((SOIChar(v) < 256) and ((AnsiChar(v) in reserved) or strict)) then
        begin
          TokRec^.state := tsObjectUnquotedField;
          tok.pb.Reset;
          goto redo_char;
        end else
        begin
          tok.err := teParseObjectKeyName;
          goto out;
        end
      end;

    tsObjectField:
      begin
        if (v = tok.quote_char) then
        begin
          TokRec^.field_name := tok.pb.FBuf;
          TokRec^.saved_state := tsObjectFieldEnd;
          TokRec^.state := tsEatws;
        end else
        if (v = '\') then
        begin
          TokRec^.saved_state := tsObjectField;
          TokRec^.state := tsStringEscape;
        end else
        begin
          tok.pb.Append(@v, 1);
        end
      end;

    tsObjectUnquotedField:
      begin
        if (SOIChar(v) < 256) and (AnsiChar(v) in [':', #0]) then
        begin
          TokRec^.field_name := tok.pb.FBuf;
          TokRec^.saved_state := tsObjectFieldEnd;
          TokRec^.state := tsEatws;
          goto redo_char;
        end else
        if (v = '\') then
        begin
          TokRec^.saved_state := tsObjectUnquotedField;
          TokRec^.state := tsStringEscape;
        end else
          tok.pb.Append(@v, 1);
      end;

    tsObjectFieldEnd:
      begin
        if (v = ':') then
        begin
          TokRec^.saved_state := tsObjectValue;
          TokRec^.state := tsEatws;
        end else
        begin
          tok.err := teParseObjectKeySep;
          goto out;
        end
      end;

    tsObjectValue:
      begin
        if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then
        begin
          tok.err := teDepth;
          goto out;
        end;
        TokRec^.state := tsObjectValueAdd;
        inc(tok.depth);
        tok.ResetLevel(tok.depth);
        TokRec := @tok.stack[tok.depth];
        goto redo_char;
      end;

    tsObjectValueAdd:
      begin
        TokRec^.current.AsObject.PutO(TokRec^.field_name, obj);
        TokRec^.field_name := '';
        TokRec^.saved_state := tsObjectSep;
        TokRec^.state := tsEatws;
        goto redo_char;
      end;

    tsObjectSep:
      begin
        if (v = '}') then
        begin
          TokRec^.saved_state := tsFinish;
          TokRec^.state := tsEatws;
        end else
        if (v = ',') then
        begin
          TokRec^.saved_state := tsObjectFieldStart;
          TokRec^.state := tsEatws;
        end else
        begin
          tok.err := teParseObjectValueSep;
          goto out;
        end
      end;
    end;
    inc(str);
    inc(tok.char_offset);
  until v = #0;

  if(TokRec^.state <> tsFinish) and
     (TokRec^.saved_state <> tsFinish) then
    tok.err := teParseEof;

 out:
  if(tok.err in [teSuccess]) then
  begin
{$IFDEF SUPER_METHOD}
    if (foCallMethod in options) and ObjectIsType(TokRec^.current, stMethod) and assigned(TokRec^.current.AsMethod) then
    begin
      sm := TokRec^.current.AsMethod;
      sm(TokRec^.parent, put, Result);
    end else
{$ENDIF}
    Result := TokRec^.current;
  end else
    Result := nil;
end;

procedure TSuperObject.PutO(const path: SOString; const Value: ISuperObject);
begin
  ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], Value);
end;

procedure TSuperObject.PutB(const path: SOString; Value: Boolean);
begin
  ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value));
end;

procedure TSuperObject.PutD(const path: SOString; Value: Double);
begin
  ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value));
end;

procedure TSuperObject.PutC(const path: SOString; Value: Currency);
begin
  ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.CreateCurrency(Value));
end;

procedure TSuperObject.PutI(const path: SOString; Value: SuperInt);
begin
  ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value));
end;

procedure TSuperObject.PutS(const path: SOString; const Value: SOString);
begin
  ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value));
end;


{$IFDEF FPC}
function TSuperObject.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: tguid; out obj): longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$ELSE}
function TSuperObject.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
{$ENDIF}
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TSuperObject.SaveTo(stream: TStream; indent, escape: boolean): integer;
var
  pb: TSuperWriterStream;
begin
  if escape then
    pb := TSuperAnsiWriterStream.Create(stream) else
    pb := TSuperUnicodeWriterStream.Create(stream);

  if(Write(pb, indent, escape, 0) < 0) then
  begin
    pb.Reset;
    pb.Free;
    Result := 0;
    Exit;
  end;
  Result := stream.Size;
  pb.Free;
end;

function TSuperObject.CalcSize(indent, escape: boolean): integer;
var
  pb: TSuperWriterFake;
begin
  pb := TSuperWriterFake.Create;
  if(Write(pb, indent, escape, 0) < 0) then
  begin
    pb.Free;
    Result := 0;
    Exit;
  end;
  Result := pb.FSize;
  pb.Free;
end;

function TSuperObject.SaveTo(socket: Integer; indent, escape: boolean): integer;
var
  pb: TSuperWriterSock;
begin
  pb := TSuperWriterSock.Create(socket);
  if(Write(pb, indent, escape, 0) < 0) then
  begin
    pb.Free;
    Result := 0;
    Exit;
  end;
  Result := pb.FSize;
  pb.Free;
end;

constructor TSuperObject.Create(const s: SOString);
begin
  Create(stString);
  FOString := s;
end;

procedure TSuperObject.Clear(all: boolean);
begin
  if FProcessing then exit;
  FProcessing := true;
  try
    case FDataType of
      stBoolean: FO.c_boolean := false;
      stDouble: FO.c_double := 0.0;
      stCurrency: FO.c_currency := 0.0;
      stInt: FO.c_int := 0;
      stObject: FO.c_object.Clear(all);
      stArray: FO.c_array.Clear(all);
      stString: FOString := '';
{$IFDEF SUPER_METHOD}
      stMethod: FO.c_method := nil;
{$ENDIF}
    end;
  finally
    FProcessing := false;
  end;
end;

procedure TSuperObject.Pack(all: boolean = false);
begin
  if FProcessing then exit;
  FProcessing := true;
  try
    case FDataType of
      stObject: FO.c_object.Pack(all);
      stArray: FO.c_array.Pack(all);
    end;
  finally
    FProcessing := false;
  end;
end;

function TSuperObject.GetN(const path: SOString): ISuperObject;
begin
  Result := ParseString(PSOChar(path), False, true, self);
  if Result = nil then
    Result := TSuperObject.Create(stNull);
end;

procedure TSuperObject.PutN(const path: SOString; const Value: ISuperObject);
begin
  if Value = nil then
    ParseString(PSOChar(path), False, True, self, [foCreatePath, foPutValue], TSuperObject.Create(stNull)) else
    ParseString(PSOChar(path), False, True, self, [foCreatePath, foPutValue], Value);
end;

function TSuperObject.Delete(const path: SOString): ISuperObject;
begin
  Result := ParseString(PSOChar(path), False, true, self, [foDelete]);
end;

function TSuperObject.Clone: ISuperObject;
var
  ite: TSuperObjectIter;
  arr: TSuperArray;
  j: integer;
begin
  case FDataType of
    stBoolean: Result := TSuperObject.Create(FO.c_boolean);
    stDouble: Result := TSuperObject.Create(FO.c_double);
    stCurrency: Result := TSuperObject.CreateCurrency(FO.c_currency);
    stInt: Result := TSuperObject.Create(FO.c_int);
    stString: Result := TSuperObject.Create(FOString);
{$IFDEF SUPER_METHOD}
    stMethod: Result := TSuperObject.Create(FO.c_method);
{$ENDIF}
    stObject:
      begin
        Result := TSuperObject.Create(stObject);
        if ObjectFindFirst(self, ite) then
        with Result.AsObject do
        repeat
          PutO(ite.key, ite.val.Clone);
        until not ObjectFindNext(ite);
        ObjectFindClose(ite);
      end;
    stArray:
      begin
        Result := TSuperObject.Create(stArray);
        arr := AsArray;
        with Result.AsArray do
        for j := 0 to arr.Length - 1 do
          Add(arr.GetO(j).Clone);
      end;
  else
    Result := nil;
  end;
end;

procedure TSuperObject.Merge(const obj: ISuperObject; reference: boolean);
var
  prop1, prop2: ISuperObject;
  ite: TSuperObjectIter;
  arr: TSuperArray;
  j: integer;
begin
  if ObjectIsType(obj, FDataType) then
  case FDataType of
    stBoolean: FO.c_boolean := obj.AsBoolean;
    stDouble: FO.c_double := obj.AsDouble;
    stCurrency: FO.c_currency := obj.AsCurrency;
    stInt: FO.c_int := obj.AsInteger;
    stString: FOString := obj.AsString;
{$IFDEF SUPER_METHOD}
    stMethod: FO.c_method := obj.AsMethod;
{$ENDIF}
    stObject:
      begin
        if ObjectFindFirst(obj, ite) then
        with FO.c_object do
        repeat
          prop1 := FO.c_object.GetO(ite.key);
          if (prop1 <> nil) and (ite.val <> nil) and (prop1.DataType = ite.val.DataType) then
            prop1.Merge(ite.val) else
            if reference then
              PutO(ite.key, ite.val) else
              if ite.val <> nil then
                PutO(ite.key, ite.val.Clone) else
                PutO(ite.key, nil)

        until not ObjectFindNext(ite);
        ObjectFindClose(ite);
      end;
    stArray:
      begin
        arr := obj.AsArray;
        with FO.c_array do
        for j := 0 to arr.Length - 1 do
        begin
          prop1 := GetO(j);
          prop2 := arr.GetO(j);
          if (prop1 <> nil) and (prop2 <> nil) and (prop1.DataType = prop2.DataType) then
            prop1.Merge(prop2) else
            if reference then
              PutO(j, prop2) else
              if prop2 <> nil then
                PutO(j, prop2.Clone) else
                PutO(j, nil);
        end;
      end;
  end;
end;

procedure TSuperObject.Merge(const str: SOString);
begin
  Merge(TSuperObject.ParseString(PSOChar(str), False), true);
end;

class function TSuperObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TSuperObject(Result).FRefCount := 1;
end;

function TSuperObject.ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject;
begin
  Result := ParseString(PSOChar(path), False, True, Self, [foCreatePath], nil, dataType);
end;

function TSuperObject.Format(const str: SOString; BeginSep: SOChar; EndSep: SOChar): SOString;
var
  p1, p2: PSOChar;
begin
  Result := '';
  p2 := PSOChar(str);
  p1 := p2;
  while true do
    if p2^ = BeginSep then
      begin
        if p2 > p1 then
          Result := Result + Copy(p1, 0, p2-p1);
        inc(p2);
        p1 := p2;
        while true do
          if p2^ = EndSep then Break else
          if p2^ = #0     then Exit else
            inc(p2);
        Result := Result + GetS(copy(p1, 0, p2-p1));
        inc(p2);
        p1 := p2;
      end
    else if p2^ = #0 then
      begin
        if p2 > p1 then
          Result := Result + Copy(p1, 0, p2-p1);
        Break;
      end else
        inc(p2);
end;

function TSuperObject.GetO(const path: SOString): ISuperObject;
begin
  Result := ParseString(PSOChar(path), False, True, Self);
end;

function TSuperObject.GetA(const path: SOString): TSuperArray;
var
  obj: ISuperObject;
begin
  obj := ParseString(PSOChar(path), False, True, Self);
  if obj <> nil then
    Result := obj.AsArray else
    Result := nil;
end;

function TSuperObject.GetB(const path: SOString): Boolean;
var
  obj: ISuperObject;
begin
  obj := GetO(path);
  if obj <> nil then
    Result := obj.AsBoolean else
    Result := false;
end;

function TSuperObject.GetD(const path: SOString): Double;
var
  obj: ISuperObject;
begin
  obj := GetO(path);
  if obj <> nil then
    Result := obj.AsDouble else
    Result := 0.0;
end;

function TSuperObject.GetC(const path: SOString): Currency;
var
  obj: ISuperObject;
begin
  obj := GetO(path);
  if obj <> nil then
    Result := obj.AsCurrency else
    Result := 0.0;
end;

function TSuperObject.GetI(const path: SOString): SuperInt;
var
  obj: ISuperObject;
begin
  obj := GetO(path);
  if obj <> nil then
    Result := obj.AsInteger else
    Result := 0;
end;

function TSuperObject.GetDataPtr: Pointer;
begin
  Result := FDataPtr;
end;

function TSuperObject.GetDataType: TSuperType;
begin
  Result := FDataType
end;

function TSuperObject.GetS(const path: SOString): SOString;
var
  obj: ISuperObject;
begin
  obj := GetO(path);
  if obj <> nil then
    Result := obj.AsString else
    Result := '';
end;

function TSuperObject.SaveTo(const FileName: string; indent, escape: boolean): integer;
var
  stream: TFileStream;
begin
  stream := TFileStream.Create(FileName, fmCreate);
  try
    Result := SaveTo(stream, indent, escape);
  finally
    stream.Free;
  end;
end;

function TSuperObject.Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean;
begin
  Result := Validate(TSuperObject.ParseString(PSOChar(rules), False), TSuperObject.ParseString(PSOChar(defs), False), callback, sender);
end;

function TSuperObject.Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean;
type
  TDataType = (dtUnknown, dtStr, dtInt, dtFloat, dtNumber, dtText, dtBool,
               dtMap, dtSeq, dtScalar, dtAny);
var
  datatypes: ISuperObject;
  names: ISuperObject;

  function FindInheritedProperty(const prop: PSOChar; p: ISuperObject): ISuperObject;
  var
    o: ISuperObject;
    e: TSuperAvlEntry;
  begin
    o := p[prop];
    if o <> nil then
      result := o else
      begin
        o := p['inherit'];
        if (o <> nil) and ObjectIsType(o, stString) then
          begin
            e := names.AsObject.Search(o.AsString);
            if (e <> nil) then
              Result := FindInheritedProperty(prop, e.Value) else
              Result := nil;
          end else
            Result := nil;
      end;
  end;

  function FindDataType(o: ISuperObject): TDataType;
  var
    e: TSuperAvlEntry;
    obj: ISuperObject;
  begin
    obj := FindInheritedProperty('type', o);
    if obj <> nil then
    begin
      e := datatypes.AsObject.Search(obj.AsString);
      if  e <> nil then
        Result := TDataType(e.Value.AsInteger) else
        Result := dtUnknown;
    end else
      Result := dtUnknown;
  end;

  procedure GetNames(o: ISuperObject);
  var
    obj: ISuperObject;
    f: TSuperObjectIter;
  begin
    obj := o['name'];
    if ObjectIsType(obj, stString) then
      names[obj.AsString] := o;

    case FindDataType(o) of
      dtMap:
        begin
          obj := o['mapping'];
          if ObjectIsType(obj, stObject) then
          begin
            if ObjectFindFirst(obj, f) then
            repeat
              if ObjectIsType(f.val, stObject) then
                GetNames(f.val);
            until not ObjectFindNext(f);
            ObjectFindClose(f);
          end;
        end;
      dtSeq:
        begin
          obj := o['sequence'];
          if ObjectIsType(obj, stObject) then
            GetNames(obj);
        end;
    end;
  end;

  function FindInheritedField(const prop: SOString; p: ISuperObject): ISuperObject;
  var
    o: ISuperObject;
    e: TSuperAvlEntry;
  begin
    o := p['mapping'];
    if ObjectIsType(o, stObject) then
    begin
      o := o.AsObject.GetO(prop);
      if o <> nil then
      begin
        Result := o;
        Exit;
      end;
    end;

    o := p['inherit'];
    if ObjectIsType(o, stString) then
    begin
      e := names.AsObject.Search(o.AsString);
      if (e <> nil) then
        Result := FindInheritedField(prop, e.Value) else
        Result := nil;
    end else
      Result := nil;
  end;

  function InheritedFieldExist(const obj: ISuperObject; p: ISuperObject; const name: SOString = ''): boolean;
  var
   o: ISuperObject;
   e: TSuperAvlEntry;
   j: TSuperAvlIterator;
  begin
    Result := true;
    o := p['mapping'];
    if ObjectIsType(o, stObject) then
    begin
      j := TSuperAvlIterator.Create(o.AsObject);
      try
        j.First;
        e := j.GetIter;
        while e <> nil do
        begin
          if obj.AsObject.Search(e.Name) = nil then
          begin
            Result := False;
            if assigned(callback) then
              callback(sender, veFieldNotFound, name + '.' + e.Name);
          end;
          j.Next;
          e := j.GetIter;
        end;

      finally
        j.Free;
      end;
    end;

    o := p['inherit'];
    if ObjectIsType(o, stString) then
    begin
      e := names.AsObject.Search(o.AsString);
      if (e <> nil) then
        Result := InheritedFieldExist(obj, e.Value, name) and Result;
    end;
  end;

  function getInheritedBool(f: PSOChar; p: ISuperObject; default: boolean = false): boolean;
  var
    o: ISuperObject;
  begin
    o := FindInheritedProperty(f, p);
    case ObjectGetType(o) of
      stBoolean: Result := o.AsBoolean;
      stNull: Result := Default;
    else
      Result := default;
      if assigned(callback) then
        callback(sender, veRuleMalformated, f);
    end;
  end;

  procedure GetInheritedFieldList(list: ISuperObject; p: ISuperObject);
  var
   o: ISuperObject;
   e: TSuperAvlEntry;
   i: TSuperAvlIterator;
  begin
    Result := true;
    o := p['mapping'];
    if ObjectIsType(o, stObject) then
    begin
      i := TSuperAvlIterator.Create(o.AsObject);
      try
        i.First;
        e := i.GetIter;
        while e <> nil do
        begin
          if list.AsObject.Search(e.Name) = nil then
            list[e.Name] := e.Value;
          i.Next;
          e := i.GetIter;
        end;

      finally
        i.Free;
      end;
    end;

    o := p['inherit'];
    if ObjectIsType(o, stString) then
    begin
      e := names.AsObject.Search(o.AsString);
      if (e <> nil) then
        GetInheritedFieldList(list, e.Value);
    end;
  end;

  function CheckEnum(o: ISuperObject; p: ISuperObject; name: SOString = ''): boolean;
  var
    enum: ISuperObject;
    i: integer;
  begin
    Result := false;
    enum := FindInheritedProperty('enum', p);
    case ObjectGetType(enum) of
      stArray:
        for i := 0 to enum.AsArray.Length - 1 do
          if (o.AsString = enum.AsArray[i].AsString) then
          begin
            Result := true;
            exit;
          end;
      stNull: Result := true;
    else
      Result := false;
      if assigned(callback) then
        callback(sender, veRuleMalformated, '');
      Exit;
    end;

    if (not Result) and assigned(callback) then
      callback(sender, veValueNotInEnum, name);
  end;

  function CheckLength(len: integer; p: ISuperObject; const objpath: SOString): boolean;
  var
    length, o: ISuperObject;
  begin
    result := true;
    length := FindInheritedProperty('length', p);
    case ObjectGetType(length) of
      stObject:
        begin
          o := length.AsObject.GetO('min');
          if (o <> nil) and (o.AsInteger > len) then
          begin
            Result := false;
            if assigned(callback) then
              callback(sender, veInvalidLength, objpath);
          end;
          o := length.AsObject.GetO('max');
          if (o <> nil) and (o.AsInteger < len) then
          begin
            Result := false;
            if assigned(callback) then
              callback(sender, veInvalidLength, objpath);
          end;
          o := length.AsObject.GetO('minex');
          if (o <> nil) and (o.AsInteger >= len) then
          begin
            Result := false;
            if assigned(callback) then
              callback(sender, veInvalidLength, objpath);
          end;
          o := length.AsObject.GetO('maxex');
          if (o <> nil) and (o.AsInteger <= len) then
          begin
            Result := false;
            if assigned(callback) then
              callback(sender, veInvalidLength, objpath);
          end;
        end;
      stNull: ;
    else
      Result := false;
      if assigned(callback) then
        callback(sender, veRuleMalformated, '');
    end;
  end;

  function CheckRange(obj: ISuperObject; p: ISuperObject; const objpath: SOString): boolean;
  var
    length, o: ISuperObject;
  begin
    result := true;
    length := FindInheritedProperty('range', p);
    case ObjectGetType(length) of
      stObject:
        begin
          o := length.AsObject.GetO('min');
          if (o <> nil) and (o.Compare(obj) = cpGreat) then
          begin
            Result := false;
            if assigned(callback) then
              callback(sender, veInvalidRange, objpath);
          end;
          o := length.AsObject.GetO('max');
          if (o <> nil) and (o.Compare(obj) = cpLess) then
          begin
            Result := false;
            if assigned(callback) then
              callback(sender, veInvalidRange, objpath);
          end;
          o := length.AsObject.GetO('minex');
          if (o <> nil) and (o.Compare(obj) in [cpGreat, cpEqu]) then
          begin
            Result := false;
            if assigned(callback) then
              callback(sender, veInvalidRange, objpath);
          end;
          o := length.AsObject.GetO('maxex');
          if (o <> nil) and (o.Compare(obj) in [cpLess, cpEqu]) then
          begin
            Result := false;
            if assigned(callback) then
              callback(sender, veInvalidRange, objpath);
          end;
        end;
      stNull: ;
    else
      Result := false;
      if assigned(callback) then
        callback(sender, veRuleMalformated, '');
    end;
  end;


  function process(o: ISuperObject; p: ISuperObject; objpath: SOString = ''): boolean;
  var
    ite: TSuperAvlIterator;
    ent: TSuperAvlEntry;
    p2, o2, sequence: ISuperObject;
    s: SOString;
    i: integer;
    uniquelist, fieldlist: ISuperObject;
  begin
    Result := true;
    if (o = nil) then
    begin
      if getInheritedBool('required', p) then
      begin
        if assigned(callback) then
          callback(sender, veFieldIsRequired, objpath);
        result := false;
      end;
    end else
      case FindDataType(p) of
        dtStr:
          case ObjectGetType(o) of
            stString:
              begin
                Result := Result and CheckLength(Length(o.AsString), p, objpath);
                Result := Result and CheckRange(o, p, objpath);
              end;
          else
            if assigned(callback) then
              callback(sender, veInvalidDataType, objpath);
            result := false;
          end;
        dtBool:
          case ObjectGetType(o) of
            stBoolean:
              begin
                Result := Result and CheckRange(o, p, objpath);
              end;
          else
            if assigned(callback) then
              callback(sender, veInvalidDataType, objpath);
            result := false;
          end;
        dtInt:
          case ObjectGetType(o) of
            stInt:
              begin
                Result := Result and CheckRange(o, p, objpath);
              end;
          else
            if assigned(callback) then
              callback(sender, veInvalidDataType, objpath);
            result := false;
          end;
        dtFloat:
          case ObjectGetType(o) of
            stDouble, stCurrency:
              begin
                Result := Result and CheckRange(o, p, objpath);
              end;
          else
            if assigned(callback) then
              callback(sender, veInvalidDataType, objpath);
            result := false;
          end;
        dtMap:
          case ObjectGetType(o) of
            stObject:
              begin
                // all objects have and match a rule ?
                ite := TSuperAvlIterator.Create(o.AsObject);
                try
                  ite.First;
                  ent := ite.GetIter;
                  while ent <> nil do
                  begin
                    p2 :=  FindInheritedField(ent.Name, p);
                    if ObjectIsType(p2, stObject) then
                      result := process(ent.Value, p2, objpath + '.' + ent.Name) and result else
                    begin
                      if assigned(callback) then
                        callback(sender, veUnexpectedField, objpath + '.' + ent.Name);
                      result := false; // field have no rule
                    end;
                    ite.Next;
                    ent := ite.GetIter;
                  end;
                finally
                  ite.Free;
                end;

                // all expected field exists ?
                Result :=  InheritedFieldExist(o, p, objpath) and Result;
              end;
            stNull: {nop};
          else
            result := false;
            if assigned(callback) then
              callback(sender, veRuleMalformated, objpath);
          end;
        dtSeq:
          case ObjectGetType(o) of
            stArray:
              begin
                sequence := FindInheritedProperty('sequence', p);
                if sequence <> nil then
                case ObjectGetType(sequence) of
                  stObject:
                    begin
                      for i := 0 to o.AsArray.Length - 1 do
                        result := process(o.AsArray.GetO(i), sequence, objpath + '[' + IntToStr(i) + ']') and result;
                      if getInheritedBool('unique', sequence) then
                      begin
                        // type is unique ?
                        uniquelist := TSuperObject.Create(stObject);
                        try
                          for i := 0 to o.AsArray.Length - 1 do
                          begin
                            s := o.AsArray.GetO(i).AsString;
                            if (s <> '') then
                            begin
                              if uniquelist.AsObject.Search(s) = nil then
                                uniquelist[s] := nil else
                                begin
                                  Result := False;
                                  if Assigned(callback) then
                                    callback(sender, veDuplicateEntry, objpath + '[' + IntToStr(i) + ']');
                                end;
                            end;
                          end;
                        finally
                          uniquelist := nil;
                        end;
                      end;

                      // field is unique ?
                      if (FindDataType(sequence) = dtMap) then
                      begin
                        fieldlist := TSuperObject.Create(stObject);
                        try
                          GetInheritedFieldList(fieldlist, sequence);
                          ite := TSuperAvlIterator.Create(fieldlist.AsObject);
                          try
                            ite.First;
                            ent := ite.GetIter;
                            while ent <> nil do
                            begin
                              if getInheritedBool('unique', ent.Value) then
                              begin
                                uniquelist := TSuperObject.Create(stObject);
                                try
                                  for i := 0 to o.AsArray.Length - 1 do
                                  begin
                                    o2 := o.AsArray.GetO(i);
                                    if o2 <> nil then
                                    begin
                                      s := o2.AsObject.GetO(ent.Name).AsString;
                                      if (s <> '') then
                                      if uniquelist.AsObject.Search(s) = nil then
                                        uniquelist[s] := nil else
                                        begin
                                          Result := False;
                                          if Assigned(callback) then
                                            callback(sender, veDuplicateEntry, objpath + '[' + IntToStr(i) + '].' + ent.name);
                                        end;
                                    end;
                                  end;
                                finally
                                  uniquelist := nil;
                                end;
                              end;
                              ite.Next;
                              ent := ite.GetIter;
                            end;
                          finally
                            ite.Free;
                          end;
                        finally
                          fieldlist := nil;
                        end;
                      end;


                    end;
                  stNull: {nop};
                else
                  result := false;
                  if assigned(callback) then
                    callback(sender, veRuleMalformated, objpath);
                end;
                Result := Result and CheckLength(o.AsArray.Length, p, objpath);

              end;
          else
            result := false;
            if assigned(callback) then
              callback(sender, veRuleMalformated, objpath);
          end;
        dtNumber:
          case ObjectGetType(o) of
            stInt,
            stDouble, stCurrency:
              begin
                Result := Result and CheckRange(o, p, objpath);
              end;
          else
            if assigned(callback) then
              callback(sender, veInvalidDataType, objpath);
            result := false;
          end;
        dtText:
          case ObjectGetType(o) of
            stInt,
            stDouble,
            stCurrency,
            stString:
              begin
                result := result and CheckLength(Length(o.AsString), p, objpath);
                Result := Result and CheckRange(o, p, objpath);
              end;
          else
            if assigned(callback) then
              callback(sender, veInvalidDataType, objpath);
            result := false;
          end;
        dtScalar:
          case ObjectGetType(o) of
            stBoolean,
            stDouble,
            stCurrency,
            stInt,
            stString:
              begin
                result := result and CheckLength(Length(o.AsString), p, objpath);
                Result := Result and CheckRange(o, p, objpath);
              end;
          else
            if assigned(callback) then
              callback(sender, veInvalidDataType, objpath);
            result := false;
          end;
        dtAny:;
      else
        if assigned(callback) then
          callback(sender, veRuleMalformated, objpath);
        result := false;
      end;
      Result := Result and CheckEnum(o, p, objpath)

  end;
var
  j: integer;

begin
  Result := False;
  datatypes := TSuperObject.Create(stObject);
  names := TSuperObject.Create;
  try
    datatypes.I['str'] := ord(dtStr);
    datatypes.I['int'] := ord(dtInt);
    datatypes.I['float'] := ord(dtFloat);
    datatypes.I['number'] := ord(dtNumber);
    datatypes.I['text'] := ord(dtText);
    datatypes.I['bool'] := ord(dtBool);
    datatypes.I['map'] := ord(dtMap);
    datatypes.I['seq'] := ord(dtSeq);
    datatypes.I['scalar'] := ord(dtScalar);
    datatypes.I['any'] := ord(dtAny);

    if ObjectIsType(defs, stArray) then
      for j := 0 to defs.AsArray.Length - 1 do
        if ObjectIsType(defs.AsArray[j], stObject) then
          GetNames(defs.AsArray[j]) else
          begin
            if assigned(callback) then
              callback(sender, veRuleMalformated, '');
            Exit;
          end;


    if ObjectIsType(rules, stObject) then
      GetNames(rules) else
      begin
        if assigned(callback) then
          callback(sender, veRuleMalformated, '');
        Exit;
      end;

    Result := process(self, rules);

  finally
    datatypes := nil;
    names := nil;
  end;
end;

function TSuperObject._AddRef: Integer; stdcall;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TSuperObject._Release: Integer; stdcall;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

function TSuperObject.Compare(const str: SOString): TSuperCompareResult;
begin
  Result := Compare(TSuperObject.ParseString(PSOChar(str), False));
end;

function TSuperObject.Compare(const obj: ISuperObject): TSuperCompareResult;
  function GetIntCompResult(const i: int64): TSuperCompareResult;
  begin
    if i < 0 then result := cpLess else
    if i = 0 then result := cpEqu else
      Result := cpGreat;
  end;

  function GetDblCompResult(const d: double): TSuperCompareResult;
  begin
    if d < 0 then result := cpLess else
    if d = 0 then result := cpEqu else
      Result := cpGreat;
  end;

begin
  case DataType of
    stBoolean:
      case ObjectGetType(obj) of
        stBoolean: Result := GetIntCompResult(ord(FO.c_boolean) - ord(obj.AsBoolean));
        stDouble:  Result := GetDblCompResult(ord(FO.c_boolean) - obj.AsDouble);
        stCurrency:Result := GetDblCompResult(ord(FO.c_boolean) - obj.AsCurrency);
        stInt:     Result := GetIntCompResult(ord(FO.c_boolean) - obj.AsInteger);
        stString:  Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));
      else
        Result := cpError;
      end;
    stDouble:
      case ObjectGetType(obj) of
        stBoolean: Result := GetDblCompResult(FO.c_double - ord(obj.AsBoolean));
        stDouble:  Result := GetDblCompResult(FO.c_double - obj.AsDouble);
        stCurrency:Result := GetDblCompResult(FO.c_double - obj.AsCurrency);
        stInt:     Result := GetDblCompResult(FO.c_double - obj.AsInteger);
        stString:  Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));
      else
        Result := cpError;
      end;
    stCurrency:
      case ObjectGetType(obj) of
        stBoolean: Result := GetDblCompResult(FO.c_currency - ord(obj.AsBoolean));
        stDouble:  Result := GetDblCompResult(FO.c_currency - obj.AsDouble);
        stCurrency:Result := GetDblCompResult(FO.c_currency - obj.AsCurrency);
        stInt:     Result := GetDblCompResult(FO.c_currency - obj.AsInteger);
        stString:  Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));
      else
        Result := cpError;
      end;
    stInt:
      case ObjectGetType(obj) of
        stBoolean: Result := GetIntCompResult(FO.c_int - ord(obj.AsBoolean));
        stDouble:  Result := GetDblCompResult(FO.c_int - obj.AsDouble);
        stCurrency:Result := GetDblCompResult(FO.c_int - obj.AsCurrency);
        stInt:     Result := GetIntCompResult(FO.c_int - obj.AsInteger);
        stString:  Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));
      else
        Result := cpError;
      end;
    stString:
      case ObjectGetType(obj) of
        stBoolean,
        stDouble,
        stCurrency,
        stInt,
        stString:  Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));
      else
        Result := cpError;
      end;
  else
    Result := cpError;
  end;
end;

{$IFDEF SUPER_METHOD}
function TSuperObject.AsMethod: TSuperMethod;
begin
  if FDataType = stMethod then
    Result := FO.c_method else
    Result := nil;
end;
{$ENDIF}

{$IFDEF SUPER_METHOD}
constructor TSuperObject.Create(m: TSuperMethod);
begin
  Create(stMethod);
  FO.c_method := m;
end;
{$ENDIF}

{$IFDEF SUPER_METHOD}
function TSuperObject.GetM(const path: SOString): TSuperMethod;
var
  v: ISuperObject;
begin
  v := ParseString(PSOChar(path), False, True, Self);
  if (v <> nil) and (ObjectGetType(v) = stMethod) then
    Result := v.AsMethod else
    Result := nil;
end;
{$ENDIF}

{$IFDEF SUPER_METHOD}
procedure TSuperObject.PutM(const path: SOString; Value: TSuperMethod);
begin
  ParseString(PSOChar(path), False, True, Self, [foCreatePath, foPutValue], TSuperObject.Create(Value));
end;
{$ENDIF}

{$IFDEF SUPER_METHOD}
function TSuperObject.call(const path: SOString; const param: ISuperObject): ISuperObject;
begin
  Result := ParseString(PSOChar(path), False, True, Self, [foCallMethod], param);
end;
{$ENDIF}

{$IFDEF SUPER_METHOD}
function TSuperObject.call(const path, param: SOString): ISuperObject;
begin
  Result := ParseString(PSOChar(path), False, True, Self, [foCallMethod], TSuperObject.ParseString(PSOChar(param), False));
end;
{$ENDIF}

function TSuperObject.GetProcessing: boolean;
begin
  Result := FProcessing;
end;

procedure TSuperObject.SetDataPtr(const Value: Pointer);
begin
  FDataPtr := Value;
end;

procedure TSuperObject.SetProcessing(value: boolean);
begin
  FProcessing := value;
end;

{ TSuperArray }

function TSuperArray.Add(const Data: ISuperObject): Integer;
begin
  Result := FLength;
  PutO(Result, data);
end;

function TSuperArray.Add(Data: SuperInt): Integer;
begin
  Result := Add(TSuperObject.Create(Data));
end;

function TSuperArray.Add(const Data: SOString): Integer;
begin
  Result := Add(TSuperObject.Create(Data));
end;

function TSuperArray.Add(Data: Boolean): Integer;
begin
  Result := Add(TSuperObject.Create(Data));
end;

function TSuperArray.Add(Data: Double): Integer;
begin
  Result := Add(TSuperObject.Create(Data));
end;

function TSuperArray.AddC(const Data: Currency): Integer;
begin
  Result := Add(TSuperObject.CreateCurrency(Data));
end;

function TSuperArray.Delete(index: Integer): ISuperObject;
begin
  if (Index >= 0) and (Index < FLength) then
  begin
    Result := FArray^[index];
    FArray^[index] := nil;
    Dec(FLength);
    if Index < FLength then
    begin
      Move(FArray^[index + 1], FArray^[index],
        (FLength - index) * SizeOf(Pointer));
      Pointer(FArray^[FLength]) := nil;
    end;
  end;
end;

procedure TSuperArray.Insert(index: Integer; const value: ISuperObject);
begin
  if (Index >= 0) then
  if (index < FLength) then
  begin
    if FLength = FSize then
      Expand(index);
    if Index < FLength then
      Move(FArray^[index], FArray^[index + 1],
        (FLength - index) * SizeOf(Pointer));
    Pointer(FArray^[index]) := nil;
    FArray^[index] := value;
    Inc(FLength);
  end else
    PutO(index, value);
end;

procedure TSuperArray.Clear(all: boolean);
var
  j: Integer;
begin
  for j := 0 to FLength - 1 do
    if FArray^[j] <> nil then
    begin
      if all then
        FArray^[j].Clear(all);
      FArray^[j] := nil;
    end;
  FLength := 0;
end;

procedure TSuperArray.Pack(all: boolean);
var
  PackedCount, StartIndex, EndIndex, j: Integer;
begin
  if FLength > 0 then
  begin
    PackedCount := 0;
    StartIndex := 0;
    repeat
      while (StartIndex < FLength) and (FArray^[StartIndex] = nil) do
        Inc(StartIndex);
      if StartIndex < FLength then
        begin
          EndIndex := StartIndex;
          while (EndIndex < FLength) and  (FArray^[EndIndex] <> nil) do
            Inc(EndIndex);

          Dec(EndIndex);

          if StartIndex > PackedCount then
            Move(FArray^[StartIndex], FArray^[PackedCount], (EndIndex - StartIndex + 1) * SizeOf(Pointer));

          Inc(PackedCount, EndIndex - StartIndex + 1);
          StartIndex := EndIndex + 1;
        end;
    until StartIndex >= FLength;
    FillChar(FArray^[PackedCount], (FLength - PackedCount) * sizeof(Pointer), 0);
    FLength := PackedCount;
    if all then
      for j := 0 to FLength - 1 do
        FArray^[j].Pack(all);
  end;
end;

constructor TSuperArray.Create;
begin
  inherited Create;
  FSize := SUPER_ARRAY_LIST_DEFAULT_SIZE;
  FLength := 0;
  GetMem(FArray, sizeof(Pointer) * FSize);
  FillChar(FArray^, sizeof(Pointer) * FSize, 0);
end;

destructor TSuperArray.Destroy;
begin
  Clear;
  FreeMem(FArray);
  inherited;
end;

procedure TSuperArray.Expand(max: Integer);
var
  new_size: Integer;
begin
  if (max < FSize) then
    Exit;
  if max < (FSize shl 1) then
    new_size := (FSize shl 1) else
    new_size := max + 1;
  ReallocMem(FArray, new_size * sizeof(Pointer));
  FillChar(FArray^[FSize], (new_size - FSize) * sizeof(Pointer), 0);
  FSize := new_size;
end;

function TSuperArray.GetO(const index: Integer): ISuperObject;
begin
  if(index >= FLength) then
    Result := nil else
    Result := FArray^[index];
end;

function TSuperArray.GetB(const index: integer): Boolean;
var
  obj: ISuperObject;
begin
  obj := GetO(index);
  if obj <> nil then
    Result := obj.AsBoolean else
    Result := false;
end;

function TSuperArray.GetD(const index: integer): Double;
var
  obj: ISuperObject;
begin
  obj := GetO(index);
  if obj <> nil then
    Result := obj.AsDouble else
    Result := 0.0;
end;

function TSuperArray.GetI(const index: integer): SuperInt;
var
  obj: ISuperObject;
begin
  obj := GetO(index);
  if obj <> nil then
    Result := obj.AsInteger else
    Result := 0;
end;

function TSuperArray.GetS(const index: integer): SOString;
var
  obj: ISuperObject;
begin
  obj := GetO(index);
  if obj <> nil then
    Result := obj.AsString else
    Result := '';
end;

procedure TSuperArray.PutO(const index: Integer; const Value: ISuperObject);
begin
  Expand(index);
  FArray^[index] := value;
  if(FLength <= index) then FLength := index + 1;
end;

function TSuperArray.GetN(const index: integer): ISuperObject;
begin
  Result := GetO(index);
  if Result = nil then
    Result := TSuperObject.Create(stNull);
end;

procedure TSuperArray.PutN(const index: integer; const Value: ISuperObject);
begin
  if Value <> nil then
    PutO(index, Value) else
    PutO(index, TSuperObject.Create(stNull));
end;

procedure TSuperArray.PutB(const index: integer; Value: Boolean);
begin
  PutO(index, TSuperObject.Create(Value));
end;

procedure TSuperArray.PutD(const index: integer; Value: Double);
begin
  PutO(index, TSuperObject.Create(Value));
end;

function TSuperArray.GetC(const index: integer): Currency;
var
  obj: ISuperObject;
begin
  obj := GetO(index);
  if obj <> nil then
    Result := obj.AsCurrency else
    Result := 0.0;
end;

procedure TSuperArray.PutC(const index: integer; Value: Currency);
begin
  PutO(index, TSuperObject.CreateCurrency(Value));
end;

procedure TSuperArray.PutI(const index: integer; Value: SuperInt);
begin
  PutO(index, TSuperObject.Create(Value));
end;

procedure TSuperArray.PutS(const index: integer; const Value: SOString);
begin
  PutO(index, TSuperObject.Create(Value));
end;

{$IFDEF SUPER_METHOD}
function TSuperArray.GetM(const index: integer): TSuperMethod;
var
  v: ISuperObject;
begin
  v := GetO(index);
  if (ObjectGetType(v) = stMethod) then
    Result := v.AsMethod else
    Result := nil;
end;
{$ENDIF}

{$IFDEF SUPER_METHOD}
procedure TSuperArray.PutM(const index: integer; Value: TSuperMethod);
begin
  PutO(index, TSuperObject.Create(Value));
end;
{$ENDIF}

{ TSuperWriterString }

function TSuperWriterString.Append(buf: PSOChar; Size: Integer): Integer;
  function max(a, b: Integer): integer; begin if a > b then  Result := a else Result := b end;
begin
  Result := size;
  if Size > 0 then
  begin
    if (FSize - FBPos <= size) then
    begin
      FSize := max(FSize * 2, FBPos + size + 8);
      ReallocMem(FBuf, FSize * SizeOf(SOChar));
    end;
    // fast move
    case size of
    1: FBuf[FBPos] := buf^;
    2: PInteger(@FBuf[FBPos])^ := PInteger(buf)^;
    4: PInt64(@FBuf[FBPos])^ := PInt64(buf)^;
    else
      move(buf^, FBuf[FBPos], size * SizeOf(SOChar));
    end;
    inc(FBPos, size);
    FBuf[FBPos] := #0;
  end;
end;

function TSuperWriterString.Append(buf: PSOChar): Integer;
begin
  Result := Append(buf, strlen(buf));
end;

constructor TSuperWriterString.Create;
begin
  inherited;
  FSize := 32;
  FBPos := 0;
  GetMem(FBuf, FSize * SizeOf(SOChar));
end;

destructor TSuperWriterString.Destroy;
begin
  inherited;
  if FBuf <> nil then
    FreeMem(FBuf)
end;

function TSuperWriterString.GetString: SOString;
begin
  SetString(Result, FBuf, FBPos);
end;

procedure TSuperWriterString.Reset;
begin
  FBuf[0] := #0;
  FBPos := 0;
end;

procedure TSuperWriterString.TrimRight;
begin
  while (FBPos > 0) and (FBuf[FBPos-1] < #256) and (AnsiChar(FBuf[FBPos-1]) in [#32, #13, #10]) do
  begin
    dec(FBPos);
    FBuf[FBPos] := #0;
  end;
end;

{ TSuperWriterStream }

function TSuperWriterStream.Append(buf: PSOChar): Integer;
begin
  Result := Append(buf, StrLen(buf));
end;

constructor TSuperWriterStream.Create(AStream: TStream);
begin
  inherited Create;
  FStream := AStream;
end;

procedure TSuperWriterStream.Reset;
begin
  FStream.Size := 0;
end;

{ TSuperWriterStream }

function TSuperAnsiWriterStream.Append(buf: PSOChar; Size: Integer): Integer;
var
  Buffer: array[0..1023] of AnsiChar;
  pBuffer: PAnsiChar;
  i: Integer;
begin
  if Size = 1 then
    Result := FStream.Write(buf^, Size) else
  begin
    if Size > SizeOf(Buffer) then
      GetMem(pBuffer, Size) else
      pBuffer := @Buffer;
    try
      for i :=  0 to Size - 1 do
        pBuffer[i] := AnsiChar(buf[i]);
      Result := FStream.Write(pBuffer^, Size);
    finally
      if pBuffer <> @Buffer then
        FreeMem(pBuffer);
    end;
  end;
end;

{ TSuperUnicodeWriterStream }

function TSuperUnicodeWriterStream.Append(buf: PSOChar; Size: Integer): Integer;
begin
  Result := FStream.Write(buf^, Size * 2);
end;

{ TSuperWriterFake }

function TSuperWriterFake.Append(buf: PSOChar; Size: Integer): Integer;
begin
  inc(FSize, Size);
  Result := FSize;
end;

function TSuperWriterFake.Append(buf: PSOChar): Integer;
begin
  inc(FSize, Strlen(buf));
  Result := FSize;
end;

constructor TSuperWriterFake.Create;
begin
  inherited Create;
  FSize := 0;
end;

procedure TSuperWriterFake.Reset;
begin
  FSize := 0;
end;

{ TSuperWriterSock }

function TSuperWriterSock.Append(buf: PSOChar; Size: Integer): Integer;
var
  Buffer: array[0..1023] of AnsiChar;
  pBuffer: PAnsiChar;
  i: Integer;
begin
  if Size = 1 then
{$IFDEF FPC}
    Result := fpsend(FSocket, buf, size, 0) else
{$ELSE}
    Result := send(FSocket, buf^, size, 0) else
{$ENDIF}
  begin
    if Size > SizeOf(Buffer) then
      GetMem(pBuffer, Size) else
      pBuffer := @Buffer;
    try
      for i :=  0 to Size - 1 do
        pBuffer[i] := AnsiChar(buf[i]);
{$IFDEF FPC}
      Result := fpsend(FSocket, pBuffer, size, 0);
{$ELSE}
      Result := send(FSocket, pBuffer^, size, 0);
{$ENDIF}
    finally
      if pBuffer <> @Buffer then
        FreeMem(pBuffer);
    end;
  end;
  inc(FSize, Result);
end;

function TSuperWriterSock.Append(buf: PSOChar): Integer;
begin
  Result := Append(buf, StrLen(buf));
end;

constructor TSuperWriterSock.Create(ASocket: Integer);
begin
  inherited Create;
  FSocket := ASocket;
  FSize := 0;
end;

procedure TSuperWriterSock.Reset;
begin
  FSize := 0;
end;

{ TSuperTokenizer }

constructor TSuperTokenizer.Create;
begin
  pb := TSuperWriterString.Create;
  line := 1;
  col := 0;
  Reset;
end;

destructor TSuperTokenizer.Destroy;
begin
  Reset;
  pb.Free;
  inherited;
end;

procedure TSuperTokenizer.Reset;
var
  i: integer;
begin
  for i := depth downto 0 do
    ResetLevel(i);
  depth := 0;
  err := teSuccess;
end;

procedure TSuperTokenizer.ResetLevel(adepth: integer);
begin
  stack[adepth].state := tsEatws;
  stack[adepth].saved_state := tsStart;
  stack[adepth].current := nil;
  stack[adepth].field_name := '';
  stack[adepth].obj := nil;
  stack[adepth].parent := nil;
  stack[adepth].gparent := nil;
end;

{ TSuperAvlTree }

constructor TSuperAvlTree.Create;
begin
  FRoot := nil;
  FCount := 0;
end;

destructor TSuperAvlTree.Destroy;
begin
  Clear;
  inherited;
end;

function TSuperAvlTree.IsEmpty: boolean;
begin
  result := FRoot = nil;
end;

function TSuperAvlTree.balance(bal: TSuperAvlEntry): TSuperAvlEntry;
var
  deep, old: TSuperAvlEntry;
  bf: integer;
begin
  if (bal.FBf > 0) then
  begin
    deep := bal.FGt;
    if (deep.FBf < 0) then
    begin
      old := bal;
      bal := deep.FLt;
      old.FGt := bal.FLt;
      deep.FLt := bal.FGt;
      bal.FLt := old;
      bal.FGt := deep;
      bf := bal.FBf;
      if (bf <> 0) then
      begin
        if (bf > 0) then
        begin
          old.FBf := -1;
          deep.FBf := 0;
        end else
        begin
          deep.FBf := 1;
          old.FBf := 0;
        end;
        bal.FBf := 0;
      end else
      begin
        old.FBf := 0;
        deep.FBf := 0;
      end;
    end else
    begin
      bal.FGt := deep.FLt;
      deep.FLt := bal;
      if (deep.FBf = 0) then
      begin
        deep.FBf := -1;
        bal.FBf := 1;
      end else
      begin
        deep.FBf := 0;
        bal.FBf := 0;
      end;
      bal := deep;
    end;
  end else
  begin
    (* "Less than" subtree is deeper. *)

    deep := bal.FLt;
    if (deep.FBf > 0) then
    begin
      old := bal;
      bal := deep.FGt;
      old.FLt := bal.FGt;
      deep.FGt := bal.FLt;
      bal.FGt := old;
      bal.FLt := deep;

      bf := bal.FBf;
      if (bf <> 0) then
      begin
        if (bf < 0) then
        begin
          old.FBf := 1;
          deep.FBf := 0;
        end else
        begin
          deep.FBf := -1;
          old.FBf := 0;
        end;
        bal.FBf := 0;
      end else
      begin
        old.FBf := 0;
        deep.FBf := 0;
      end;
    end else
    begin
      bal.FLt := deep.FGt;
      deep.FGt := bal;
      if (deep.FBf = 0) then
      begin
        deep.FBf := 1;
        bal.FBf := -1;
      end else
      begin
        deep.FBf := 0;
        bal.FBf := 0;
      end;
      bal := deep;
    end;
  end;
  Result := bal;
end;

function TSuperAvlTree.Insert(h: TSuperAvlEntry): TSuperAvlEntry;
var
  unbal, parentunbal, hh, parent: TSuperAvlEntry;
  depth, unbaldepth: longint;
  cmp: integer;
  unbalbf: integer;
  branch: TSuperAvlBitArray;
  p: Pointer;
begin
  inc(FCount);
  h.FLt := nil;
  h.FGt := nil;
  h.FBf := 0;
  branch := [];

  if (FRoot = nil) then
    FRoot := h
  else
  begin
    unbal := nil;
    parentunbal := nil;
    depth := 0;
    unbaldepth := 0;
    hh := FRoot;
    parent := nil;
    repeat
      if (hh.FBf <> 0) then
      begin
        unbal := hh;
        parentunbal := parent;
        unbaldepth := depth;
      end;
      if hh.FHash <> h.FHash then
      begin
        if hh.FHash < h.FHash then cmp := -1 else
        if hh.FHash > h.FHash then cmp := 1 else
          cmp := 0;
      end else
        cmp := CompareNodeNode(h, hh);
      if (cmp = 0) then
      begin
        Result := hh;
        //exchange data
        p := hh.Ptr;
        hh.FPtr := h.Ptr;
        h.FPtr := p;
        doDeleteEntry(h, false);
        dec(FCount);
        exit;
      end;
      parent := hh;
      if (cmp > 0) then
      begin
        hh := hh.FGt;
        include(branch, depth);
      end else
      begin
        hh := hh.FLt;
        exclude(branch, depth);
      end;
      inc(depth);
    until (hh = nil);

    if (cmp < 0) then
      parent.FLt := h else
      parent.FGt := h;

    depth := unbaldepth;

    if (unbal = nil) then
      hh := FRoot
    else
    begin
      if depth in branch then
        cmp := 1 else
        cmp := -1;
      inc(depth);
      unbalbf := unbal.FBf;
      if (cmp < 0) then
        dec(unbalbf) else
        inc(unbalbf);
      if cmp < 0 then
        hh := unbal.FLt else
        hh := unbal.FGt;
      if ((unbalbf <> -2) and (unbalbf <> 2)) then
      begin
        unbal.FBf := unbalbf;
        unbal := nil;
      end;
    end;

    if (hh <> nil) then
      while (h <> hh) do
      begin
        if depth in branch then
          cmp := 1 else
          cmp := -1;
        inc(depth);
        if (cmp < 0) then
        begin
          hh.FBf := -1;
          hh := hh.FLt;
        end else (* cmp > 0 *)
        begin
          hh.FBf := 1;
          hh := hh.FGt;
        end;
      end;

    if (unbal <> nil) then
    begin
      unbal := balance(unbal);
      if (parentunbal = nil) then
        FRoot := unbal
      else
      begin
        depth := unbaldepth - 1;
        if depth in branch then
          cmp := 1 else
          cmp := -1;
        if (cmp < 0) then
          parentunbal.FLt := unbal else
          parentunbal.FGt := unbal;
      end;
    end;
  end;
  result := h;
end;

function TSuperAvlTree.Search(const k: SOString; st: TSuperAvlSearchTypes): TSuperAvlEntry;
var
  cmp, target_cmp: integer;
  match_h, h: TSuperAvlEntry;
  ha: Cardinal;
begin
  ha := TSuperAvlEntry.Hash(k);

  match_h := nil;
  h := FRoot;

  if (stLess in st) then
    target_cmp := 1 else
    if (stGreater in st) then
      target_cmp := -1 else
      target_cmp := 0;

  while (h <> nil) do
  begin
    if h.FHash < ha then cmp := -1 else
    if h.FHash > ha then cmp := 1 else
      cmp := 0;

    if cmp = 0 then
      cmp := CompareKeyNode(PSOChar(k), h);
    if (cmp = 0) then
    begin
      if (stEqual in st) then
      begin
        match_h := h;
        break;
      end;
      cmp := -target_cmp;
    end
    else
    if (target_cmp <> 0) then
      if ((cmp xor target_cmp) and SUPER_AVL_MASK_HIGH_BIT) = 0 then
        match_h := h;
    if cmp < 0 then
      h := h.FLt else
      h := h.FGt;
  end;
  result := match_h;
end;

function TSuperAvlTree.Delete(const k: SOString): ISuperObject;
var
  depth, rm_depth: longint;
  branch: TSuperAvlBitArray;
  h, parent, child, path, rm, parent_rm: TSuperAvlEntry;
  cmp, cmp_shortened_sub_with_path, reduced_depth, bf: integer;
  ha: Cardinal;
begin
  ha := TSuperAvlEntry.Hash(k);
  cmp_shortened_sub_with_path := 0;
  branch := [];

  depth := 0;
  h := FRoot;
  parent := nil;
  while true do
  begin
    if (h = nil) then
      exit;
    if h.FHash < ha then cmp := -1 else
    if h.FHash > ha then cmp := 1 else
      cmp := 0;

    if cmp = 0 then
      cmp := CompareKeyNode(k, h);
    if (cmp = 0) then
      break;
    parent := h;
    if (cmp > 0) then
    begin
      h := h.FGt;
      include(branch, depth)
    end else
    begin
      h := h.FLt;
      exclude(branch, depth)
    end;
    inc(depth);
    cmp_shortened_sub_with_path := cmp;
  end;
  rm := h;
  parent_rm := parent;
  rm_depth := depth;

  if (h.FBf < 0) then
  begin
    child := h.FLt;
    exclude(branch, depth);
    cmp := -1;
  end else
  begin
    child := h.FGt;
    include(branch, depth);
    cmp := 1;
  end;
  inc(depth);

  if (child <> nil) then
  begin
    cmp := -cmp;
    repeat
      parent := h;
      h := child;
      if (cmp < 0) then
      begin
        child := h.FLt;
        exclude(branch, depth);
      end else
      begin
        child := h.FGt;
        include(branch, depth);
      end;
      inc(depth);
    until (child = nil);

    if (parent = rm) then
      cmp_shortened_sub_with_path := -cmp else
      cmp_shortened_sub_with_path := cmp;

    if cmp > 0 then
      child := h.FLt else
      child := h.FGt;
  end;

  if (parent = nil) then
    FRoot := child else
    if (cmp_shortened_sub_with_path < 0) then
      parent.FLt := child else
      parent.FGt := child;

  if parent = rm then
    path := h else
    path := parent;

  if (h <> rm) then
  begin
    h.FLt := rm.FLt;
    h.FGt := rm.FGt;
    h.FBf := rm.FBf;
    if (parent_rm = nil) then
      FRoot := h
    else
    begin
      depth := rm_depth - 1;
      if (depth in branch) then
        parent_rm.FGt := h else
        parent_rm.FLt := h;
    end;
  end;

  if (path <> nil) then
  begin
    h := FRoot;
    parent := nil;
    depth := 0;
    while (h <> path) do
    begin
      if (depth in branch) then
      begin
        child := h.FGt;
        h.FGt := parent;
      end else
      begin
        child := h.FLt;
        h.FLt := parent;
      end;
      inc(depth);
      parent := h;
      h := child;
    end;

    reduced_depth := 1;
    cmp := cmp_shortened_sub_with_path;
    while true do
    begin
      if (reduced_depth <> 0) then
      begin
        bf := h.FBf;
        if (cmp < 0) then
          inc(bf) else
          dec(bf);
        if ((bf = -2) or (bf = 2)) then
        begin
          h := balance(h);
          bf := h.FBf;
        end else
          h.FBf := bf;
        reduced_depth := integer(bf = 0);
      end;
      if (parent = nil) then
        break;
      child := h;
      h := parent;
      dec(depth);
      if depth in branch then
        cmp := 1 else
        cmp := -1;
      if (cmp < 0) then
      begin
        parent := h.FLt;
        h.FLt := child;
      end else
      begin
        parent := h.FGt;
        h.FGt := child;
      end;
    end;
    FRoot := h;
  end;
  if rm <> nil then
  begin
    Result := rm.GetValue;
    doDeleteEntry(rm, false);
    dec(FCount);
  end;
end;

procedure TSuperAvlTree.Pack(all: boolean);
var
  node1, node2: TSuperAvlEntry;
  list: TList;
  i: Integer;
begin
  node1 := FRoot;
  list := TList.Create;
  while node1 <> nil do
  begin
    if (node1.FLt = nil) then
    begin
      node2 := node1.FGt;
      if (node1.FPtr = nil) then
        list.Add(node1) else
        if all then
          node1.Value.Pack(all);
    end
    else
    begin
      node2 := node1.FLt;
      node1.FLt := node2.FGt;
      node2.FGt := node1;
    end;
    node1 := node2;
  end;
  for i := 0 to list.Count - 1 do
    Delete(TSuperAvlEntry(list[i]).FName);
  list.Free;
end;

procedure TSuperAvlTree.Clear(all: boolean);
var
  node1, node2: TSuperAvlEntry;
begin
  node1 := FRoot;
  while node1 <> nil do
  begin
    if (node1.FLt = nil) then
    begin
      node2 := node1.FGt;
      doDeleteEntry(node1, all);
    end
    else
    begin
      node2 := node1.FLt;
      node1.FLt := node2.FGt;
      node2.FGt := node1;
    end;
    node1 := node2;
  end;
  FRoot := nil;
  FCount := 0;
end;

function TSuperAvlTree.CompareKeyNode(const k: SOString; h: TSuperAvlEntry): integer;
begin
  Result := StrComp(PSOChar(k), PSOChar(h.FName));
end;

function TSuperAvlTree.CompareNodeNode(node1, node2: TSuperAvlEntry): integer;
begin
  Result := StrComp(PSOChar(node1.FName), PSOChar(node2.FName));
end;

{ TSuperAvlIterator }

(* Initialize depth to invalid value, to indicate iterator is
** invalid.   (Depth is zero-base.)  It's not necessary to initialize
** iterators prior to passing them to the "start" function.
*)

constructor TSuperAvlIterator.Create(tree: TSuperAvlTree);
begin
  FDepth := not 0;
  FTree := tree;
end;

procedure TSuperAvlIterator.Search(const k: SOString; st: TSuperAvlSearchTypes);
var
  h: TSuperAvlEntry;
  d: longint;
  cmp, target_cmp: integer;
  ha: Cardinal;
begin
  ha := TSuperAvlEntry.Hash(k);
  h := FTree.FRoot;
  d := 0;
  FDepth := not 0;
  if (h = nil) then
    exit;

  if (stLess in st) then
    target_cmp := 1 else
      if (stGreater in st) then
        target_cmp := -1 else
          target_cmp := 0;

  while true do
  begin
    if h.FHash < ha then cmp := -1 else
    if h.FHash > ha then cmp := 1 else
      cmp := 0;

    if cmp = 0 then
      cmp := FTree.CompareKeyNode(k, h);
    if (cmp = 0) then
    begin
      if (stEqual in st) then
      begin
        FDepth := d;
        break;
      end;
      cmp := -target_cmp;
    end
    else
    if (target_cmp <> 0) then
      if ((cmp xor target_cmp) and SUPER_AVL_MASK_HIGH_BIT) = 0 then
        FDepth := d;
    if cmp < 0 then
      h := h.FLt else
      h := h.FGt;
    if (h = nil) then
      break;
    if (cmp > 0) then
      include(FBranch, d) else
      exclude(FBranch, d);
    FPath[d] := h;
    inc(d);
  end;
end;

procedure TSuperAvlIterator.First;
var
  h: TSuperAvlEntry;
begin
  h := FTree.FRoot;
  FDepth := not 0;
  FBranch := [];
  while (h <> nil) do
  begin
    if (FDepth <> not 0) then
      FPath[FDepth] := h;
    inc(FDepth);
    h := h.FLt;
  end;
end;

procedure TSuperAvlIterator.Last;
var
  h: TSuperAvlEntry;
begin
  h := FTree.FRoot;
  FDepth := not 0;
  FBranch := [0..SUPER_AVL_MAX_DEPTH - 1];
  while (h <> nil) do
  begin
    if (FDepth <> not 0) then
      FPath[FDepth] := h;
    inc(FDepth);
    h := h.FGt;
  end;
end;

function TSuperAvlIterator.MoveNext: boolean;
begin
  if FDepth = not 0 then
    First else
    Next;
  Result := GetIter <> nil;
end;

function TSuperAvlIterator.GetIter: TSuperAvlEntry;
begin
  if (FDepth = not 0) then
  begin
    result := nil;
    exit;
  end;
  if FDepth = 0 then
    Result := FTree.FRoot else
    Result := FPath[FDepth - 1];
end;

procedure TSuperAvlIterator.Next;
var
  h: TSuperAvlEntry;
begin
  if (FDepth <> not 0) then
  begin
    if FDepth = 0 then
      h := FTree.FRoot.FGt else
      h := FPath[FDepth - 1].FGt;

    if (h = nil) then
      repeat
        if (FDepth = 0) then
        begin
          FDepth := not 0;
          break;
        end;
        dec(FDepth);
      until (not (FDepth in FBranch))
    else
    begin
      include(FBranch, FDepth);
      FPath[FDepth] := h;
      inc(FDepth);
      while true do
      begin
        h := h.FLt;
        if (h = nil) then
          break;
        exclude(FBranch, FDepth);
        FPath[FDepth] := h;
        inc(FDepth);
      end;
    end;
  end;
end;

procedure TSuperAvlIterator.Prior;
var
  h: TSuperAvlEntry;
begin
  if (FDepth <> not 0) then
  begin
    if FDepth = 0 then
      h := FTree.FRoot.FLt else
      h := FPath[FDepth - 1].FLt;
    if (h = nil) then
      repeat
        if (FDepth = 0) then
        begin
          FDepth := not 0;
          break;
        end;
        dec(FDepth);
      until (FDepth in FBranch)
    else
    begin
      exclude(FBranch, FDepth);
      FPath[FDepth] := h;
      inc(FDepth);
      while true do
      begin
        h := h.FGt;
        if (h = nil) then
          break;
        include(FBranch, FDepth);
        FPath[FDepth] := h;
        inc(FDepth);
      end;
    end;
  end;
end;

procedure TSuperAvlTree.doDeleteEntry(Entry: TSuperAvlEntry; all: boolean);
begin
  Entry.Free;
end;

function TSuperAvlTree.GetEnumerator: TSuperAvlIterator;
begin
  Result := TSuperAvlIterator.Create(Self);
end;

{ TSuperAvlEntry }

constructor TSuperAvlEntry.Create(const AName: SOString; Obj: Pointer);
begin
  FName := AName;
  FPtr := Obj;
  FHash := Hash(FName);
end;

function TSuperAvlEntry.GetValue: ISuperObject;
begin
  Result := ISuperObject(FPtr)
end;

class function TSuperAvlEntry.Hash(const k: SOString): Cardinal;
var
  h: cardinal;
  i: Integer;
begin
  h := 0;
  for i := 1 to Length(k) do
    h := h*129 + ord(k[i]) + $9e370001;
  Result := h;
end;

procedure TSuperAvlEntry.SetValue(const val: ISuperObject);
begin
  ISuperObject(FPtr) := val;
end;

{ TSuperTableString }

function TSuperTableString.GetValues: ISuperObject;
var
  ite: TSuperAvlIterator;
  obj: TSuperAvlEntry;
begin
  Result := TSuperObject.Create(stArray);
  ite := TSuperAvlIterator.Create(Self);
  try
    ite.First;
    obj := ite.GetIter;
    while obj <> nil do
    begin
      Result.AsArray.Add(obj.Value);
      ite.Next;
      obj := ite.GetIter;
    end;
  finally
    ite.Free;
  end;
end;

function TSuperTableString.GetNames: ISuperObject;
var
  ite: TSuperAvlIterator;
  obj: TSuperAvlEntry;
begin
  Result := TSuperObject.Create(stArray);
  ite := TSuperAvlIterator.Create(Self);
  try
    ite.First;
    obj := ite.GetIter;
    while obj <> nil do
    begin
      Result.AsArray.Add(TSuperObject.Create(obj.FName));
      ite.Next;
      obj := ite.GetIter;
    end;
  finally
    ite.Free;
  end;
end;

procedure TSuperTableString.doDeleteEntry(Entry: TSuperAvlEntry; all: boolean);
begin
  if Entry.Ptr <> nil then
  begin
    if all then Entry.Value.Clear(true);
    Entry.Value := nil;
  end;
  inherited;
end;

function TSuperTableString.Find(const k: SOString; var value: ISuperObject): Boolean;
var
  e: TSuperAvlEntry;
begin
  e := Search(k);
  if e <> nil then
  begin
    value := e.Value;
    Result := True;
  end else
    Result := False;
end;

function TSuperTableString.Exists(const k: SOString): Boolean;
begin
  Result := Search(k) <> nil;
end;

function TSuperTableString.GetO(const k: SOString): ISuperObject;
var
  e: TSuperAvlEntry;
begin
  e := Search(k);
  if e <> nil then
    Result := e.Value else
    Result := nil
end;

procedure TSuperTableString.PutO(const k: SOString; const value: ISuperObject);
var
  entry: TSuperAvlEntry;
begin
  entry := Insert(TSuperAvlEntry.Create(k, Pointer(value)));
  if entry.FPtr <> nil then
    ISuperObject(entry.FPtr)._AddRef;
end;

procedure TSuperTableString.PutS(const k: SOString; const value: SOString);
begin
  PutO(k, TSuperObject.Create(Value));
end;

function TSuperTableString.GetS(const k: SOString): SOString;
var
  obj: ISuperObject;
begin
 obj := GetO(k);
 if obj <> nil then
   Result := obj.AsString else
   Result := '';
end;

procedure TSuperTableString.PutI(const k: SOString; value: SuperInt);
begin
  PutO(k, TSuperObject.Create(Value));
end;

function TSuperTableString.GetI(const k: SOString): SuperInt;
var
  obj: ISuperObject;
begin
 obj := GetO(k);
 if obj <> nil then
   Result := obj.AsInteger else
   Result := 0;
end;

procedure TSuperTableString.PutD(const k: SOString; value: Double);
begin
  PutO(k, TSuperObject.Create(Value));
end;

procedure TSuperTableString.PutC(const k: SOString; value: Currency);
begin
  PutO(k, TSuperObject.CreateCurrency(Value));
end;

function TSuperTableString.GetC(const k: SOString): Currency;
var
  obj: ISuperObject;
begin
 obj := GetO(k);
 if obj <> nil then
   Result := obj.AsCurrency else
   Result := 0.0;
end;

function TSuperTableString.GetD(const k: SOString): Double;
var
  obj: ISuperObject;
begin
 obj := GetO(k);
 if obj <> nil then
   Result := obj.AsDouble else
   Result := 0.0;
end;

procedure TSuperTableString.PutB(const k: SOString; value: Boolean);
begin
  PutO(k, TSuperObject.Create(Value));
end;

function TSuperTableString.GetB(const k: SOString): Boolean;
var
  obj: ISuperObject;
begin
 obj := GetO(k);
 if obj <> nil then
   Result := obj.AsBoolean else
   Result := False;
end;

{$IFDEF SUPER_METHOD}
procedure TSuperTableString.PutM(const k: SOString; value: TSuperMethod);
begin
  PutO(k, TSuperObject.Create(Value));
end;
{$ENDIF}

{$IFDEF SUPER_METHOD}
function TSuperTableString.GetM(const k: SOString): TSuperMethod;
var
  obj: ISuperObject;
begin
 obj := GetO(k);
 if obj <> nil then
   Result := obj.AsMethod else
   Result := nil;
end;
{$ENDIF}

procedure TSuperTableString.PutN(const k: SOString; const value: ISuperObject);
begin
  if value <> nil then
    PutO(k, TSuperObject.Create(stNull)) else
    PutO(k, value);
end;

function TSuperTableString.GetN(const k: SOString): ISuperObject;
var
  obj: ISuperObject;
begin
 obj := GetO(k);
 if obj <> nil then
   Result := obj else
   Result := TSuperObject.Create(stNull);
end;


{$IFDEF HAVE_RTTI}

{ TSuperAttribute }

constructor TSuperAttribute.Create(const AName: string);
begin
  FName := AName;
end;

{ TSuperRttiContext }

constructor TSuperRttiContext.Create;
begin
  Context := TRttiContext.Create;
  SerialFromJson := TDictionary<PTypeInfo, TSerialFromJson>.Create;
  SerialToJson := TDictionary<PTypeInfo, TSerialToJson>.Create;

  SerialFromJson.Add(TypeInfo(Boolean), serialfromboolean);
  SerialFromJson.Add(TypeInfo(TDateTime), serialfromdatetime);
  SerialFromJson.Add(TypeInfo(TGUID), serialfromguid);
  SerialToJson.Add(TypeInfo(Boolean), serialtoboolean);
  SerialToJson.Add(TypeInfo(TDateTime), serialtodatetime);
  SerialToJson.Add(TypeInfo(TGUID), serialtoguid);
end;

destructor TSuperRttiContext.Destroy;
begin
  SerialFromJson.Free;
  SerialToJson.Free;
  Context.Free;
end;

class function TSuperRttiContext.GetFieldName(r: TRttiField): string;
var
  o: TCustomAttribute;
begin
  for o in r.GetAttributes do
    if o is SOName then
      Exit(SOName(o).Name);
  Result := r.Name;
end;

class function TSuperRttiContext.GetFieldDefault(r: TRttiField; const obj: ISuperObject): ISuperObject;
var
  o: TCustomAttribute;
begin
  if not ObjectIsType(obj, stNull) then Exit(obj);
  for o in r.GetAttributes do
    if o is SODefault then
      Exit(SO(SODefault(o).Name));
  Result := obj;
end;

function TSuperRttiContext.AsType<T>(const obj: ISuperObject): T;
var
  ret: TValue;
begin
  if FromJson(TypeInfo(T), obj, ret) then
    Result := ret.AsType<T> else
    raise exception.Create('Marshalling error');
end;

function TSuperRttiContext.AsJson<T>(const obj: T; const index: ISuperObject = nil): ISuperObject;
var
  v: TValue;
begin
  TValue.Make(@obj, TypeInfo(T), v);
  if index <> nil then
    Result := ToJson(v, index) else
    Result := ToJson(v, so);
end;

function TSuperRttiContext.FromJson(TypeInfo: PTypeInfo; const obj: ISuperObject;
  var Value: TValue): Boolean;

  procedure FromChar;
  begin
    if ObjectIsType(obj, stString) and (Length(obj.AsString) = 1) then
      begin
        Value := string(AnsiString(obj.AsString)[1]);
        Result := True;
      end else
        Result := False;
  end;

  procedure FromWideChar;
  begin
    if ObjectIsType(obj, stString) and (Length(obj.AsString) = 1) then
    begin
      Value := obj.AsString[1];
      Result := True;
    end else
      Result := False;
  end;

  procedure FromInt64;
  var
    i: Int64;
  begin
    case ObjectGetType(obj) of
    stInt:
      begin
        TValue.Make(nil, TypeInfo, Value);
        TValueData(Value).FAsSInt64 := obj.AsInteger;
        Result := True;
      end;
    stString:
      begin
        if TryStrToInt64(obj.AsString, i) then
        begin
          TValue.Make(nil, TypeInfo, Value);
          TValueData(Value).FAsSInt64 := i;
          Result := True;
        end else
          Result := False;
      end;
    else
      Result := False;
    end;
  end;

  procedure FromInt(const obj: ISuperObject);
  var
    TypeData: PTypeData;
    i: Integer;
    o: ISuperObject;
  begin
    case ObjectGetType(obj) of
    stInt, stBoolean:
      begin
        i := obj.AsInteger;
        TypeData := GetTypeData(TypeInfo);
        if TypeData.MaxValue > TypeData.MinValue then
          Result := (i >= TypeData.MinValue) and (i <= TypeData.MaxValue) else
          Result := (i >= TypeData.MinValue) and (i <= Int64(PCardinal(@TypeData.MaxValue)^));
        if Result then
          TValue.Make(@i, TypeInfo, Value);
      end;
    stString:
      begin
        o := SO(obj.AsString);
        if not ObjectIsType(o, stString) then
          FromInt(o) else
          Result := False;
      end;
    else
      Result := False;
    end;
  end;

  procedure fromSet;
  var
    i: Integer;
  begin
    case ObjectGetType(obj) of
    stInt:
      begin
        TValue.Make(nil, TypeInfo, Value);
        TValueData(Value).FAsSLong := obj.AsInteger;
        Result := True;
      end;
    stString:
      begin
        if TryStrToInt(obj.AsString, i) then
        begin
          TValue.Make(nil, TypeInfo, Value);
          TValueData(Value).FAsSLong := i;
          Result := True;
        end else
          Result := False;
      end;
    else
      Result := False;
    end;
  end;

  procedure FromFloat(const obj: ISuperObject);
  var
    o: ISuperObject;
  begin
    case ObjectGetType(obj) of
    stInt, stDouble, stCurrency:
      begin
        TValue.Make(nil, TypeInfo, Value);
        case GetTypeData(TypeInfo).FloatType of
          ftSingle: TValueData(Value).FAsSingle := obj.AsDouble;
          ftDouble: TValueData(Value).FAsDouble := obj.AsDouble;
          ftExtended: TValueData(Value).FAsExtended := obj.AsDouble;
          ftComp: TValueData(Value).FAsSInt64 := obj.AsInteger;
          ftCurr: TValueData(Value).FAsCurr := obj.AsCurrency;
        end;
        Result := True;
      end;
    stString:
      begin
        o := SO(obj.AsString);
        if not ObjectIsType(o, stString) then
          FromFloat(o) else
          Result := False;
      end
    else
       Result := False;
    end;
  end;

  procedure FromString;
  begin
    case ObjectGetType(obj) of
    stObject, stArray:
      Result := False;
    stnull:
      begin
        Value := '';
        Result := True;
      end;
    else
      Value := obj.AsString;
      Result := True;
    end;
  end;

  procedure FromClass;
  var
    f: TRttiField;
    v: TValue;
  begin
    case ObjectGetType(obj) of
      stObject:
        begin
          Result := True;
          if Value.Kind <> tkClass then
            Value := GetTypeData(TypeInfo).ClassType.Create;
          for f in Context.GetType(Value.AsObject.ClassType).GetFields do
            if f.FieldType <> nil then
            begin
              v := TValue.Empty;
              Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v);
              if Result then
                f.SetValue(Value.AsObject, v) else
                Exit;
            end;
        end;
      stNull:
        begin
          Value := nil;
          Result := True;
        end
    else
      // error
      Value := nil;
      Result := False;
    end;
  end;

  procedure FromRecord;
  var
    f: TRttiField;
    p: Pointer;
    v: TValue;
  begin
    Result := True;
    TValue.Make(nil, TypeInfo, Value);
    for f in Context.GetType(TypeInfo).GetFields do
    begin
      if ObjectIsType(obj, stObject) and (f.FieldType <> nil) then
      begin
{$IFDEF VER210}
        p := IValueData(TValueData(Value).FHeapData).GetReferenceToRawData;
{$ELSE}
        p := TValueData(Value).FValueData.GetReferenceToRawData;
{$ENDIF}
        Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v);
        if Result then
          f.SetValue(p, v) else
          begin
            //Writeln(f.Name);
            Exit;
          end;
      end else
      begin
        Result := False;
        Exit;
      end;
    end;
  end;

  procedure FromDynArray;
  var
    i: Integer;
    p: Pointer;
    pb: PByte;
    val: TValue;
    typ: PTypeData;
    el: PTypeInfo;
  begin
    case ObjectGetType(obj) of
    stArray:
      begin
        i := obj.AsArray.Length;
        p := nil;
        DynArraySetLength(p, TypeInfo, 1, @i);
        pb := p;
        typ := GetTypeData(TypeInfo);
        if typ.elType <> nil then
          el := typ.elType^ else
          el := typ.elType2^;

        Result := True;
        for i := 0 to i - 1 do
        begin
          Result := FromJson(el, obj.AsArray[i], val);
          if not Result then
            Break;
          val.ExtractRawData(pb);
          val := TValue.Empty;
          Inc(pb, typ.elSize);
        end;
        if Result then
          TValue.MakeWithoutCopy(@p, TypeInfo, Value) else
          DynArrayClear(p, TypeInfo);
      end;
    stNull:
      begin
        TValue.MakeWithoutCopy(nil, TypeInfo, Value);
        Result := True;
      end;
    else
      i := 1;
      p := nil;
      DynArraySetLength(p, TypeInfo, 1, @i);
      pb := p;
      typ := GetTypeData(TypeInfo);
      if typ.elType <> nil then
        el := typ.elType^ else
        el := typ.elType2^;

      Result := FromJson(el, obj, val);
      val.ExtractRawData(pb);
      val := TValue.Empty;

      if Result then
        TValue.MakeWithoutCopy(@p, TypeInfo, Value) else
        DynArrayClear(p, TypeInfo);
    end;
  end;

  procedure FromArray;
  var
    ArrayData: PArrayTypeData;
    idx: Integer;
    function ProcessDim(dim: Byte; const o: ISuperobject): Boolean;
    var
      i: Integer;
      v: TValue;
      a: PTypeData;
    begin
      if ObjectIsType(o, stArray) and (ArrayData.Dims[dim-1] <> nil) then
      begin
        a := @GetTypeData(ArrayData.Dims[dim-1]^).ArrayData;
        if (a.MaxValue - a.MinValue + 1) <> o.AsArray.Length then
        begin
          Result := False;
          Exit;
        end;
        Result := True;
        if dim = ArrayData.DimCount then
          for i := a.MinValue to a.MaxValue do
          begin
            Result := FromJson(ArrayData.ElType^, o.AsArray[i], v);
            if not Result then
              Exit;
            Value.SetArrayElement(idx, v);
            inc(idx);
          end
        else
          for i := a.MinValue to a.MaxValue do
          begin
            Result := ProcessDim(dim + 1, o.AsArray[i]);
            if not Result then
              Exit;
          end;
      end else
        Result := False;
    end;
  var
    i: Integer;
    v: TValue;
  begin
    TValue.Make(nil, TypeInfo, Value);
    ArrayData := @GetTypeData(TypeInfo).ArrayData;
    idx := 0;
    if ArrayData.DimCount = 1 then
    begin
      if ObjectIsType(obj, stArray) and (obj.AsArray.Length = ArrayData.ElCount) then
      begin
        Result := True;
        for i := 0 to ArrayData.ElCount - 1 do
        begin
          Result := FromJson(ArrayData.ElType^, obj.AsArray[i], v);
          if not Result then
            Exit;
          Value.SetArrayElement(idx, v);
          v := TValue.Empty;
          inc(idx);
        end;
      end else
        Result := False;
    end else
      Result := ProcessDim(1, obj);
  end;

  procedure FromClassRef;
  var
    r: TRttiType;
  begin
    if ObjectIsType(obj, stString) then
    begin
      r := Context.FindType(obj.AsString);
      if r <> nil then
      begin
        Value := TRttiInstanceType(r).MetaclassType;
        Result := True;
      end else
        Result := False;
    end else
      Result := False;
  end;

  procedure FromUnknown;
  begin
    case ObjectGetType(obj) of
      stBoolean:
        begin
          Value := obj.AsBoolean;
          Result := True;
        end;
      stDouble:
        begin
          Value := obj.AsDouble;
          Result := True;
        end;
      stCurrency:
        begin
          Value := obj.AsCurrency;
          Result := True;
        end;
      stInt:
        begin
          Value := obj.AsInteger;
          Result := True;
        end;
      stString:
        begin
          Value := obj.AsString;
          Result := True;
        end
    else
      Value := nil;
      Result := False;
    end;
  end;

  procedure FromInterface;
  const soguid: TGuid = '{4B86A9E3-E094-4E5A-954A-69048B7B6327}';
  var
    o: ISuperObject;
  begin
    if CompareMem(@GetTypeData(TypeInfo).Guid, @soguid, SizeOf(TGUID)) then
    begin
      if obj <> nil then
        TValue.Make(@obj, TypeInfo, Value) else
        begin
          o := TSuperObject.Create(stNull);
          TValue.Make(@o, TypeInfo, Value);
        end;
      Result := True;
    end else
      Result := False;
  end;
var
  Serial: TSerialFromJson;
begin

  if TypeInfo <> nil then
  begin
    if not SerialFromJson.TryGetValue(TypeInfo, Serial) then
      case TypeInfo.Kind of
        tkChar: FromChar;
        tkInt64: FromInt64;
        tkEnumeration, tkInteger: FromInt(obj);
        tkSet: fromSet;
        tkFloat: FromFloat(obj);
        tkString, tkLString, tkUString, tkWString: FromString;
        tkClass: FromClass;
        tkMethod: ;
        tkWChar: FromWideChar;
        tkRecord: FromRecord;
        tkPointer: ;
        tkInterface: FromInterface;
        tkArray: FromArray;
        tkDynArray: FromDynArray;
        tkClassRef: FromClassRef;
      else
        FromUnknown
      end else
      begin
        TValue.Make(nil, TypeInfo, Value);
        Result := Serial(Self, obj, Value);
      end;
  end else
    Result := False;
end;

function TSuperRttiContext.ToJson(var value: TValue; const index: ISuperObject): ISuperObject;
  procedure ToInt64;
  begin
    Result := TSuperObject.Create(SuperInt(Value.AsInt64));
  end;

  procedure ToChar;
  begin
    Result := TSuperObject.Create(string(Value.AsType<AnsiChar>));
  end;

  procedure ToInteger;
  begin
    Result := TSuperObject.Create(TValueData(Value).FAsSLong);
  end;

  procedure ToFloat;
  begin
    case Value.TypeData.FloatType of
      ftSingle: Result := TSuperObject.Create(TValueData(Value).FAsSingle);
      ftDouble: Result := TSuperObject.Create(TValueData(Value).FAsDouble);
      ftExtended: Result := TSuperObject.Create(TValueData(Value).FAsExtended);
      ftComp: Result := TSuperObject.Create(TValueData(Value).FAsSInt64);
      ftCurr: Result := TSuperObject.CreateCurrency(TValueData(Value).FAsCurr);
    end;
  end;

  procedure ToString;
  begin
    Result := TSuperObject.Create(string(Value.AsType<string>));
  end;

  procedure ToClass;
  var
    o: ISuperObject;
    f: TRttiField;
    v: TValue;
  begin
    if TValueData(Value).FAsObject <> nil then
    begin
      o := index[IntToStr(Integer(Value.AsObject))];
      if o = nil then
      begin
        Result := TSuperObject.Create(stObject);
        index[IntToStr(Integer(Value.AsObject))] := Result;
        for f in Context.GetType(Value.AsObject.ClassType).GetFields do
          if f.FieldType <> nil then
          begin
            v := f.GetValue(Value.AsObject);
            Result.AsObject[GetFieldName(f)] := ToJson(v, index);
          end
      end else
        Result := o;
    end else
      Result := nil;
  end;

  procedure ToWChar;
  begin
    Result :=  TSuperObject.Create(string(Value.AsType<WideChar>));
  end;

  procedure ToVariant;
  begin
    Result := SO(Value.AsVariant);
  end;

  procedure ToRecord;
  var
    f: TRttiField;
    v: TValue;
  begin
    Result := TSuperObject.Create(stObject);
    for f in Context.GetType(Value.TypeInfo).GetFields do
    begin
{$IFDEF VER210}
      v := f.GetValue(IValueData(TValueData(Value).FHeapData).GetReferenceToRawData);
{$ELSE}
      v := f.GetValue(TValueData(Value).FValueData.GetReferenceToRawData);
{$ENDIF}
      Result.AsObject[GetFieldName(f)] := ToJson(v, index);
    end;
  end;

  procedure ToArray;
  var
    idx: Integer;
    ArrayData: PArrayTypeData;

    procedure ProcessDim(dim: Byte; const o: ISuperObject);
    var
      dt: PTypeData;
      i: Integer;
      o2: ISuperObject;
      v: TValue;
    begin
      if ArrayData.Dims[dim-1] = nil then Exit;
      dt := GetTypeData(ArrayData.Dims[dim-1]^);
      if Dim = ArrayData.DimCount then
        for i := dt.MinValue to dt.MaxValue do
        begin
          v := Value.GetArrayElement(idx);
          o.AsArray.Add(toJSon(v, index));
          inc(idx);
        end
      else
        for i := dt.MinValue to dt.MaxValue do
        begin
          o2 := TSuperObject.Create(stArray);
          o.AsArray.Add(o2);
          ProcessDim(dim + 1, o2);
        end;
    end;
  var
    i: Integer;
    v: TValue;
  begin
    Result := TSuperObject.Create(stArray);
    ArrayData := @Value.TypeData.ArrayData;
    idx := 0;
    if ArrayData.DimCount = 1 then
      for i := 0 to ArrayData.ElCount - 1 do
      begin
        v := Value.GetArrayElement(i);
        Result.AsArray.Add(toJSon(v, index))
      end
    else
      ProcessDim(1, Result);
  end;

  procedure ToDynArray;
  var
    i: Integer;
    v: TValue;
  begin
    Result := TSuperObject.Create(stArray);
    for i := 0 to Value.GetArrayLength - 1 do
    begin
      v := Value.GetArrayElement(i);
      Result.AsArray.Add(toJSon(v, index));
    end;
  end;

  procedure ToClassRef;
  begin
    if TValueData(Value).FAsClass <> nil then
      Result :=  TSuperObject.Create(string(
        TValueData(Value).FAsClass.UnitName + '.' +
        TValueData(Value).FAsClass.ClassName)) else
      Result := nil;
  end;

  procedure ToInterface;
{$IFNDEF VER210}
  var
    intf: IInterface;
{$ENDIF}
  begin
{$IFDEF VER210}
    if TValueData(Value).FHeapData <> nil then
      TValueData(Value).FHeapData.QueryInterface(ISuperObject, Result) else
      Result := nil;
{$ELSE}
    if TValueData(Value).FValueData <> nil then
    begin
      intf := IInterface(PPointer(TValueData(Value).FValueData.GetReferenceToRawData)^);
      if intf <> nil then
        intf.QueryInterface(ISuperObject, Result) else
        Result := nil;
    end else
      Result := nil;
{$ENDIF}
  end;

var
  Serial: TSerialToJson;
begin
  if not SerialToJson.TryGetValue(value.TypeInfo, Serial) then
    case Value.Kind of
      tkInt64: ToInt64;
      tkChar: ToChar;
      tkSet, tkInteger, tkEnumeration: ToInteger;
      tkFloat: ToFloat;
      tkString, tkLString, tkUString, tkWString: ToString;
      tkClass: ToClass;
      tkWChar: ToWChar;
      tkVariant: ToVariant;
      tkRecord: ToRecord;
      tkArray: ToArray;
      tkDynArray: ToDynArray;
      tkClassRef: ToClassRef;
      tkInterface: ToInterface;
    else
      result := nil;
    end else
      Result := Serial(Self, value, index);
end;

{ TSuperObjectHelper }

constructor TSuperObjectHelper.FromJson(const obj: ISuperObject; ctx: TSuperRttiContext = nil);
var
  v: TValue;
  ctxowned: Boolean;
begin
  if ctx = nil then
  begin
    ctx := TSuperRttiContext.Create;
    ctxowned := True;
  end else
    ctxowned := False;
  try
    v := Self;
    if not ctx.FromJson(v.TypeInfo, obj, v) then
      raise Exception.Create('Invalid object');
  finally
    if ctxowned then
      ctx.Free;
  end;
end;

constructor TSuperObjectHelper.FromJson(const str: string; ctx: TSuperRttiContext = nil);
begin
  FromJson(SO(str), ctx);
end;

function TSuperObjectHelper.ToJson(ctx: TSuperRttiContext = nil): ISuperObject;
var
  v: TValue;
  ctxowned: boolean;
begin
  if ctx = nil then
  begin
    ctx := TSuperRttiContext.Create;
    ctxowned := True;
  end else
    ctxowned := False;
  try
    v := Self;
    Result := ctx.ToJson(v, SO);
  finally
    if ctxowned then
      ctx.Free;
  end;
end;

{$ENDIF}

{$IFDEF DEBUG}
initialization

finalization
  //Assert(debugcount = 0, 'Memory leak');
{$ENDIF}
end.