[Runtime] Added some documentation for __ functions

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
// functions used by the compiler

/// <inheritdoc cref="M:XSharp.RuntimeState.StringCompare(System.String,System.String)" />
FUNCTION __StringCompare(strLHS AS STRING, strRHS AS STRING) AS INT
    RETURN RuntimeState.StringCompare(strLHS, strRHS)

    ///
    /// Compare 2 strings. This function is used by the compiler for string comparisons
    ///
    /// <param name="strLHS">The first string .</param>
    /// <param name="strRHS">The second string.</param>
    /// <returns>
    /// TRUE when the strings are equal, FALSE when they are not equal
    /// This function respects SetExact()
    /// </returns>
FUNCTION  __StringEquals(strLHS AS STRING, strRHS AS STRING) AS LOGIC
    LOCAL IsEqual:= FALSE AS LOGIC
    LOCAL lengthRHS AS INT
    IF Object.ReferenceEquals(strLHS, strRHS)
        IsEqual := TRUE
    ELSEIF RuntimeState.Exact
        IsEqual := String.Equals(strLHS , strRHS)
    ELSEIF strLHS != NULL .AND. strRHS != NULL
        lengthRHS := strRHS:Length
        IF lengthRHS == 0
            IsEqual := TRUE        // With SetExact(FALSE) then "aaa" = "" returns TRUE
        ELSEIF lengthRHS <= strLHS:Length

            IsEqual := String.Compare( strLHS, 0, strRHS, 0, lengthRHS, StringComparison.Ordinal ) == 0
        ENDIF
    ELSEIF strLHS == NULL .AND. strRHS == NULL
        IsEqual := TRUE
    ENDIF
    RETURN IsEqual

    ///
    /// Compare 2 strings. This function is used by the compiler for string comparisons
    ///
    /// <param name="strLHS">The first string .</param>
    /// <param name="strRHS">The second string.</param>
    /// <returns>
    /// TRUE when the strings are not equal, FALSE when they are equal
    /// This function respects SetExact()
    /// </returns>
FUNCTION  __StringNotEquals(strLHS AS STRING, strRHS AS STRING) AS LOGIC
    LOCAL notEquals := FALSE AS LOGIC
    LOCAL lengthRHS AS INT
    IF Object.ReferenceEquals(strLHS, strRHS)
        notEquals := FALSE
    ELSEIF RuntimeState.Exact
        notEquals := !String.Equals(strLHS , strRHS)
    ELSEIF strLHS != NULL .AND. strRHS != NULL
        // shortcut: chec first char
        lengthRHS := strRHS:Length
        IF lengthRHS == 0
            notEquals := FALSE        // With SetExact(FALSE) then "aaa" = "" returns TRUE
        ELSEIF lengthRHS <= strLHS:Length
            notEquals := String.Compare( strLHS, 0, strRHS, 0, lengthRHS, StringComparison.Ordinal ) != 0
        ELSE
            notEquals := TRUE
        ENDIF
    ELSEIF strLHS == NULL .AND. strRHS == NULL
        notEquals := FALSE
    ELSE
        notEquals := TRUE
    ENDIF
    RETURN notEquals

/// Assign a value to a field
/// <param name="area">Workarea in which the expression will be evaluated.</param>
/// <param name="fieldName">FieldName to assign.</param>
/// <param name="uValue">Value to assign.</param>
/// <returns>The return value of the is the same as the value that is assigned.</returns>
/// <example>
/// FIELD FirstName
/// ? FirstName
/// ? FIELD->LastName
/// </example>
/// <remarks>This function is automatically called by code generated by the compiler when a field is accessed.</remarks>
FUNCTION __FieldGet( fieldName AS STRING ) AS USUAL
    LOCAL fieldpos := FieldPos( fieldName ) AS DWORD
    LOCAL ret := NULL AS OBJECT
    IF fieldpos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME, __FUNCTION__,  nameof(fieldName), 1, fieldName  )
    ELSE
         _DbThrowErrorOnFailure(__FUNCTION__, CoreDb.FieldGet( fieldpos, REF ret ))
    ENDIF
    RETURN ret

/// Access a value from a field in a workarea.
/// <param name="area">Workarea in which the expression will be evaluated.</param>
/// <param name="fieldName">FieldName to assign.</param>
/// <returns>The return value of the is the same as the value that is assigned.</returns>
/// <example>
/// ? CUSTOMER->FirstName
/// ? (nArea)->LastName
/// </example>
/// <remarks>This function is automatically called by code generated by the compiler when an aliased field is accessed.</remarks>
FUNCTION __FieldGetWa( area AS USUAL, fieldName AS STRING ) AS USUAL
    // XBase defines that 'M' in 'M->Name' means a Memvar
    IF area:IsNil
        RETURN __FieldGet(fieldName)
    ENDIF
    IF area:IsString .AND. ((STRING) area):ToUpper() == "M"
        RETURN __MemVarGet(fieldName)
    ENDIF
    LOCAL ret AS USUAL
    LOCAL newArea := _Select( area ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea
        TRY
            ret := __FieldGet( fieldName )
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, nameof(area), 1, area  )
    ENDIF
    RETURN ret

/// Assign a value to a field
/// <remarks>This function is automatically called by code generated by the compiler when a field is assigned.
/// <param name="area">Workarea in which the expression will be evaluated.</param>
/// <param name="fieldName">FieldName to assign.</param>
/// <param name="uValue">Value to assign.</param>
/// <returns>The return value of the is the same as the value that is assigned.</returns>
/// <example>
/// FIELD FirstName
/// FirstName := "James"
/// FIELD->LastName := "Bond"
/// </example>
FUNCTION __FieldSet( fieldName AS STRING, uValue AS USUAL ) AS USUAL
    LOCAL fieldpos := FieldPos( fieldName ) AS DWORD
    IF fieldpos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME, __FUNCTION__,  nameof(fieldName), 1, fieldName  )
    ELSE
        _DbThrowErrorOnFailure(__FUNCTION__, CoreDb.FieldPut( fieldpos, uValue))
    ENDIF
    // We return the original value to allow chained expressions
    RETURN uValue

/// Assign a value to a field in a workarea.
/// <param name="area">Workarea in which the expression will be evaluated.</param>
/// <param name="fieldName">FieldName to assign.</param>
/// <param name="uValue">Value to assign.</param>
/// <returns>The return value of the is the same as the value that is assigned.</returns>
/// <example>
/// CUSTOMER->Name := "Foo"
/// (nArea)->Name := "Foo"
/// </example>
/// <remarks>This function is automatically called by code generated by the compiler when an aliased field is assigned.</remarks>
FUNCTION __FieldSetWa( area AS USUAL, fieldName AS STRING, uValue AS USUAL ) AS USUAL
    IF area:IsNil
        RETURN __FieldGet(fieldName)
    ENDIF
    IF area:IsString .AND. ((STRING) area):ToUpper() == "M"
        RETURN __MemVarGet(fieldName)
    ENDIF
    LOCAL newArea := _Select( area ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea

        TRY
            __FieldSet( fieldName, uValue )
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, nameof(area),1, area  )
    ENDIF
    // Note: must return the same value passed in, to allow chained assignment expressions
    RETURN uValue

/// Evaluate an expression in a workarea.
/// <param name="area">Workarea in which the expression will be evaluated.</param>
/// <param name="action">Expression to evaluate.</param>
/// <returns>The return value of the expression that was evaluated.</returns>
/// <example>
/// uValue := CUSTOMER->(MyFunction())
/// </example>
/// <remarks>This function is automatically called by code generated by the compiler when an aliased expression is evaluated.</remarks>
FUNCTION __AreaEval<T>(area AS USUAL, action AS @@Func<T>) AS USUAL
    LOCAL newArea := _Select( area ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    LOCAL result  := DEFAULT(T) AS T
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea

        TRY
            result := action()
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, nameof(area),1, area  )
    ENDIF
    RETURN result

/// Evaluate an expression in a workarea.
/// <param name="area">Workarea in which the expression will be evaluated.</param>
/// <param name="action">Expression to evaluate.</param>
/// <returns>True when the expression is succesfully evealuated.</returns>
/// <example>
/// CUSTOMER->(DoSomething())
/// </example>
/// <remarks>This function is automatically called by code generated by the compiler when an aliased void expression is evaluated.</remarks>
FUNCTION __AreaEval(area AS USUAL, action AS System.Action) AS LOGIC
    LOCAL newArea := _Select( area ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    LOCAL result  := FALSE AS LOGIC
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea
        TRY
            action()
            result := TRUE
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, nameof(area),1, area  )
    ENDIF
    RETURN result

/// Access a dynamic variable.
/// <param name="cName">Name of the dynamic variable to assign.</param>
/// <param name="uValue">New value for the field.</param>
/// <example>
/// MEMVAR myName
/// ? MyName
/// </example>
/// <remarks>This function is automatically called by code generated by the compiler when a memvar is read.</remarks>
FUNCTION __MemVarGet(cName AS STRING) AS USUAL
    RETURN XSharp.MemVar.Get(cName)

/// Assign a new valuie to a dynamic variable.
/// <param name="cName">Name of the dynamic variable to assign.</param>
/// <param name="uValue">New value for the field.</param>
/// <example>
/// MEMVAR myName
/// MyName := "James Bond"
/// </example>
/// <remarks>This function is automatically called by code generated by the compiler when when a memvar is written.</remarks>
FUNCTION __MemVarPut(cName AS STRING, uValue AS USUAL) AS USUAL
    RETURN XSharp.MemVar.Put(cName, uValue)

/// Access a field in the current workarea or a dynamic variable.
/// <param name="cName">Name of the field or variable to access.</param>
/// <remarks>This function is automatically called by code generated by the compiler when an undeclared field or variable is read.
/// It may also be called when evaluating index expressions by the macro compiler, such as "Upper(LASTNAME)"
/// </remarks>
/// <example>
/// ? UndeclaredName
/// </example>
FUNCTION __VarGet(cName AS STRING) AS USUAL
    IF FieldPos(cName) > 0
        RETURN __FieldGet(cName)
    ENDIF
    RETURN __MemVarGet(cName)

/// Assign a field in the current workarea or a dynamic variable.
/// <remarks>This function is automatically called by code generated by the compiler when an undeclared field or variable is written.</remarks>
/// <param name="cName">Name of the field or variable to access.</param>
/// <param name="uValue">New value for the field.</param>
/// <example>
/// UndeclaredName := "James Bond"
/// </example>
FUNCTION __VarPut(cName AS STRING, uValue AS USUAL) AS USUAL
    IF FieldPos(cName) > 0
        RETURN __FieldSet(cName, uValue)
    ENDIF
    RETURN __MemVarPut(cName, uValue)

    // ALIAS->(DoSomething())
    // is sometimes translated to
    // __pushWorkarea( alias ) ; DoSomething() ; __popWorkArea()
    // can also be come __AreaEval(..)

/// Switch to a new workarea and store the current workarea on the stack.
/// <param name="alias">New area to select.</param>
/// <remarks>This function may be called by code generated by the compiler when an aliased expression is evaluated.</remarks>
FUNCTION __pushWorkarea( alias AS USUAL ) AS VOID
    LOCAL newArea := SELECT( alias ) AS DWORD
    IF newArea > 0
        RuntimeState.PushCurrentWorkarea( newArea )
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, { alias } )
    ENDIF
    RETURN

/// Restore the current workarea from a stack after an aliased expression has been evaluated.
/// <param name="alias">New area to select.</param>
/// <remarks>This function may be called by code generated by the compiler when an aliased expression is evaluated.</remarks>
FUNCTION __popWorkarea() AS VOID
    RuntimeState.PopCurrentWorkarea()
    RETURN

/// Register the current dept of the privates stack.
/// <returns>The depth of the privates stack. This number must be passed to __MemVarRelease to release the newly created privates.</returns>
/// <remarks>This function is automatically called by code generated by the compiler when a function or method declares private variables.</remarks>
FUNCTION __MemVarInit() AS INT STRICT
	RETURN XSharp.MemVar.InitPrivates()

/// Release private variables declared at a certain level.
/// <param name="nLevel">Level which must be cleared.</param>
/// <returns>Always returns TRUE.</returns>
/// <remarks>This function is automatically called by code generated by the compiler when a function or method ends that has declared new private variables.</remarks>
FUNCTION __MemVarRelease(nLevel AS INT) AS LOGIC  STRICT
	RETURN XSharp.MemVar.ReleasePrivates(nLevel)

/// declare a private or public variable. The private is initialized with NIL, the public variable with FALSE.
/// <param name="name">Name of the variable</param>
/// <param name="_priv">Should the variable be declared as private</param>
/// <example>
/// PUBLIC CustomerName // default value = FALSE
/// PRIVATE OrderNumber // default value = NIL
/// </example>
/// <remarks>This function is automatically called by code generated by the compiler when you use a PUBLIC or PRIVATE statement in your code
FUNCTION __MemVarDecl(name AS STRING, _priv AS LOGIC) AS VOID  STRICT
	XSharp.MemVar.Add(name, _priv)
	RETURN

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
// functions used by the compiler

/// <inheritdoc cref="M:XSharp.RuntimeState.StringCompare(System.String,System.String)" />
FUNCTION __StringCompare(strLHS AS STRING, strRHS AS STRING) AS INT
    RETURN RuntimeState.StringCompare(strLHS, strRHS)

    /// <summary>
    /// Compare 2 strings. This function is used by the compiler for string comparisons
    /// </summary>
    /// <param name="strLHS">The first string .</param>
    /// <param name="strRHS">The second string.</param>
    /// <returns>
    /// TRUE when the strings are equal, FALSE when they are not equal
    /// This function respects SetExact()
    /// </returns>
FUNCTION  __StringEquals(strLHS AS STRING, strRHS AS STRING) AS LOGIC
    LOCAL IsEqual:= FALSE AS LOGIC
    LOCAL lengthRHS AS INT
    IF Object.ReferenceEquals(strLHS, strRHS)
        IsEqual := TRUE
    ELSEIF RuntimeState.Exact
        IsEqual := String.Equals(strLHS , strRHS)
    ELSEIF strLHS != NULL .AND. strRHS != NULL
        lengthRHS := strRHS:Length
        IF lengthRHS == 0
            IsEqual := TRUE        // With SetExact(FALSE) then "aaa" = "" returns TRUE
        ELSEIF lengthRHS <= strLHS:Length

            IsEqual := String.Compare( strLHS, 0, strRHS, 0, lengthRHS, StringComparison.Ordinal ) == 0
        ENDIF
    ELSEIF strLHS == NULL .AND. strRHS == NULL
        IsEqual := TRUE
    ENDIF
    RETURN IsEqual

    /// <summary>
    /// Compare 2 strings. This function is used by the compiler for string comparisons
    /// </summary>
    /// <param name="strLHS">The first string .</param>
    /// <param name="strRHS">The second string.</param>
    /// <returns>
    /// TRUE when the strings are not equal, FALSE when they are equal
    /// This function respects SetExact()
    /// </returns>
FUNCTION  __StringNotEquals(strLHS AS STRING, strRHS AS STRING) AS LOGIC
    LOCAL notEquals := FALSE AS LOGIC
    LOCAL lengthRHS AS INT
    IF Object.ReferenceEquals(strLHS, strRHS)
        notEquals := FALSE
    ELSEIF RuntimeState.Exact
        notEquals := !String.Equals(strLHS , strRHS)
    ELSEIF strLHS != NULL .AND. strRHS != NULL
        // shortcut: chec first char
        lengthRHS := strRHS:Length
        IF lengthRHS == 0
            notEquals := FALSE        // With SetExact(FALSE) then "aaa" = "" returns TRUE
        ELSEIF lengthRHS <= strLHS:Length
            notEquals := String.Compare( strLHS, 0, strRHS, 0, lengthRHS, StringComparison.Ordinal ) != 0
        ELSE
            notEquals := TRUE
        ENDIF
    ELSEIF strLHS == NULL .AND. strRHS == NULL
        notEquals := FALSE
    ELSE
        notEquals := TRUE
    ENDIF
    RETURN notEquals

    // _FIELD->Name
    /// <exclude />
FUNCTION __FieldGet( fieldName AS STRING ) AS USUAL
    LOCAL fieldpos := FieldPos( fieldName ) AS DWORD
    LOCAL ret := NULL AS OBJECT
    IF fieldpos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME, __FUNCTION__,  nameof(fieldName), 1, fieldName  )
    ELSE
         _DbThrowErrorOnFailure(__FUNCTION__, CoreDb.FieldGet( fieldpos, REF ret ))
    ENDIF
    RETURN ret

    // CUSTOMER->NAME
/// <exclude/>
FUNCTION __FieldGetWa( area AS USUAL, fieldName AS STRING ) AS USUAL
    // XBase defines that 'M' in 'M->Name' means a Memvar
    IF area:IsNil
        RETURN __FieldGet(fieldName)
    ENDIF
    IF area:IsString .AND. ((STRING) area):ToUpper() == "M"
        RETURN __MemVarGet(fieldName)
    ENDIF
    LOCAL ret AS USUAL
    LOCAL newArea := _Select( area ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea
        TRY
            ret := __FieldGet( fieldName )
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, nameof(area), 1, area  )
    ENDIF
    RETURN ret

    // _FIELD->Name := "Foo"
/// <exclude/>
FUNCTION __FieldSet( fieldName AS STRING, oValue AS USUAL ) AS USUAL
    LOCAL fieldpos := FieldPos( fieldName ) AS DWORD
    IF fieldpos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME, __FUNCTION__,  nameof(fieldName), 1, fieldName  )
    ELSE
        _DbThrowErrorOnFailure(__FUNCTION__, CoreDb.FieldPut( fieldpos, oValue))
    ENDIF
    // We return the original value to allow chained expressions
    RETURN oValue

    // CUSTOMER->Name := "Foo"
    // (nArea)->Name := "Foo"
/// <exclude/>
FUNCTION __FieldSetWa( area AS USUAL, fieldName AS STRING, uValue AS USUAL ) AS USUAL
    IF area:IsNil
        RETURN __FieldGet(fieldName)
    ENDIF
    IF area:IsString .AND. ((STRING) area):ToUpper() == "M"
        RETURN __MemVarGet(fieldName)
    ENDIF
    LOCAL newArea := _Select( area ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea

        TRY
            __FieldSet( fieldName, uValue )
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, nameof(area),1, area  )
    ENDIF
    // Note: must return the same value passed in, to allow chained assignment expressions
    RETURN uValue

    // (area)->(Expression)
    /// <exclude />
FUNCTION __AreaEval<T>(area AS USUAL, action AS @@Func<T>) AS USUAL
    LOCAL newArea := _Select( area ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    LOCAL result  := DEFAULT(T) AS T
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea

        TRY
            result := action()
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, nameof(area),1, area  )
    ENDIF
    RETURN result

    // (area)->(VoidExpression)
    /// <exclude />
FUNCTION __AreaEval(area AS USUAL, action AS System.Action) AS LOGIC
    LOCAL newArea := _Select( area ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    LOCAL result  := FALSE AS LOGIC
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea
        TRY
            action()
            result := TRUE
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, nameof(area),1, area  )
    ENDIF
    RETURN result

    // MEMVAR myName
    // ? MyName
/// <exclude/>
FUNCTION __MemVarGet(cName AS STRING) AS USUAL
    RETURN XSharp.MemVar.Get(cName)

    // MEMVAR myName
    // MyName := "NewValue"
/// <exclude/>
FUNCTION __MemVarPut(cName AS STRING, uValue AS USUAL) AS USUAL
    RETURN XSharp.MemVar.Put(cName, uValue)

/// <exclude/>
FUNCTION __VarGet(cName AS STRING) AS USUAL
    IF FieldPos(cName) > 0
        RETURN __FieldGet(cName)
    ENDIF
    RETURN __MemVarGet(cName)

/// <exclude/>
FUNCTION __VarPut(cName AS STRING, uValue AS USUAL) AS USUAL
    IF FieldPos(cName) > 0
        RETURN __FieldSet(cName, uValue)
    ENDIF
    RETURN __MemVarPut(cName, uValue)

    // ALIAS->(DoSomething())
    // is sometimes translated to
    // __pushWorkarea( alias ) ; DoSomething() ; __popWorkArea()
    // can also be come __AreaEval(..)

/// <exclude/>
FUNCTION __pushWorkarea( alias AS USUAL ) AS VOID
    LOCAL newArea := SELECT( alias ) AS DWORD
    IF newArea > 0
        RuntimeState.PushCurrentWorkarea( newArea )
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, { alias } )
    ENDIF
    RETURN

    // This is used by the -> operator to restore the previous workarea
/// <exclude/>
FUNCTION __popWorkarea() AS VOID
    RuntimeState.PopCurrentWorkarea()
    RETURN

// this is used to initialize the privates stack at a certain level
/// <exclude/>
FUNCTION __MemVarInit() AS INT STRICT
	RETURN XSharp.MemVar.InitPrivates()

// this is used to release the privates stack
/// <exclude/>
FUNCTION __MemVarRelease(nLevel AS INT) AS LOGIC  STRICT
	RETURN XSharp.MemVar.ReleasePrivates(nLevel)

// this is used to declare a private or public variable. The variable is initialized with NIL.
/// <exclude/>
FUNCTION __MemVarDecl(name AS STRING, _priv AS LOGIC) AS VOID  STRICT
	XSharp.MemVar.Add(name, _priv)
	RETURN


[RDD] Prevent ADS error in Unlock() when no records are locked


implement projectLevel'

implement projectLevel'

import "../src/LangPrelude.prg" (maybeM)

data Thrist :: (l ~> l ~> *) ~> l ~> l ~> * where
  Nil :: Thrist k a a
  Cons :: k a b -> Thrist k b c -> Thrist k a c
 deriving List(t)

data Multiplicity :: *2 where
  Mono :: Multiplicity
  Poly :: Multiplicity

data Lev :: Multiplicity ~> *1 where
  ValueLevel :: Lev Mono
  LevelUp :: Lev m ~> Lev m
  PolyLevel :: Lev Poly -- level n .
 deriving syntax (lev) Nat(ValueLevel, LevelUp)

data Level :: Lev n ~> * where
  ValueLevel :: Level ValueLevel
  LevelUp :: Level l -> Level (LevelUp l)
  PolyLevel :: Level PolyLevel
 deriving syntax (l) Nat(ValueLevel, LevelUp)

data Signature = Sig -- for now

data Iceberg :: * ~> * ~> * where
  Constructor :: Label t -> Level l -> Signature -> Iceberg () ()

data Icename :: Tag ~> Tag ~> * where -- entities with certain name
  NamedConstructor :: Label t -> Level l -> Signature -> Icename t t

data Icelevel :: Lev n ~> Lev n ~> * where -- entities with certain level
  LevelConstructor :: LevelFits l' l => Label t -> Level l -> Signature -> Icelevel l' l'

data TagLev :: Multiplicity ~> *1 where
  TL :: Tag ~> Lev m ~> TagLev m

data Icenamelevel :: TagLev n ~> TagLev n ~> * where -- entities with certain level and name
  NamedLevelConstructor :: LevelFits l' l => Label t -> Level l -> Signature -> Icenamelevel (TL t l') (TL t l')

builtIns :: Thrist Iceberg () ()
builtIns = [ Constructor `Z 0l Sig, Constructor `S 0l Sig, Constructor natPrime 0l Sig
           , Constructor `Z 1l Sig, Constructor `S 1l Sig, Constructor `Nat 2l Sig
           , Constructor starN (LevelUp (LevelUp PolyLevel)) Sig
           , Constructor constraintN (LevelUp (LevelUp PolyLevel)) Sig
           , Constructor `MultValueAndUp PolyLevel Sig]t
  where HideLabel natPrime = newLabel "Nat'"
        HideLabel starN = newLabel "*n"
        HideLabel constraintN = newLabel "#n"

projectName :: Label l -> Thrist Iceberg () () -> Thrist Icename l l
projectName _ []t = []t
projectName l [Constructor l' lev sig; rest]t = case l `sameLabel` l' of
                                                L Eq -> [NamedConstructor l' lev sig; projectName l rest]t
                                                _ -> projectName l rest

projectName' :: Label t -> Thrist Icelevel l l -> Thrist Icenamelevel (TL t l) (TL t l)
projectName' _ []t = []t
projectName' t [LevelConstructor t' lev sig; rest]t = case t `sameLabel` t' of
                                                      L Eq -> [NamedLevelConstructor t' lev sig; projectName' t rest]t
                                                      _ -> projectName' t rest

-- inclusion relation on levels
--
prop LevelFits :: Lev n ~> Lev n' ~> * where
  BothValue :: LevelFits ValueLevel ValueLevel
  BothPoly :: LevelFits PolyLevel PolyLevel
  BothUp :: LevelFits k k' -> LevelFits (LevelUp k) (LevelUp k')
  ValuePoly :: LevelFits ValueLevel PolyLevel
  AbovePoly :: LevelFits (LevelUp k) PolyLevel

-- runtime compute level inclusion
--
fits :: Level l -> Level l' -> Maybe (LevelFits l l')
fits ValueLevel ValueLevel = Just BothValue
fits PolyLevel PolyLevel = Just BothPoly
fits (LevelUp l) (LevelUp l') = do ev <- fits l l'
                                   return $ BothUp ev
                                 where monad maybeM
fits ValueLevel PolyLevel = Just ValuePoly
fits (LevelUp l) PolyLevel = Just AbovePoly
fits _ _ = Nothing

projectLevel :: Level l -> Thrist Iceberg () () -> Thrist Icelevel l l
projectLevel _ []t = []t
projectLevel l [Constructor t l' sig; rest]t = case l `fits` l' of
                                               Just BothValue -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just BothPoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just (BothUp below) -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just ValuePoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just AbovePoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               _ -> projectLevel l rest

projectLevel' :: Level l -> Thrist Icename t t -> Thrist Icenamelevel (TL t l) (TL t l)
projectLevel' _ []t = []t
projectLevel' l [NamedConstructor t l' sig; rest]t = case l `fits` l' of
                                                     Just BothValue -> [NamedLevelConstructor t l' sig; projectLevel' l rest]t
                                                     Just BothPoly -> [NamedLevelConstructor t l' sig; projectLevel' l rest]t
                                                     Just (BothUp below) -> [NamedLevelConstructor t l' sig; projectLevel' l rest]t
                                                     Just ValuePoly -> [NamedLevelConstructor t l' sig; projectLevel' l rest]t
                                                     Just AbovePoly -> [NamedLevelConstructor t l' sig; projectLevel' l rest]t
                                                     _ -> projectLevel' l rest

import "../src/LangPrelude.prg" (maybeM)

data Thrist :: (l ~> l ~> *) ~> l ~> l ~> * where
  Nil :: Thrist k a a
  Cons :: k a b -> Thrist k b c -> Thrist k a c
 deriving List(t)

data Multiplicity :: *2 where
  Mono :: Multiplicity
  Poly :: Multiplicity

data Lev :: Multiplicity ~> *1 where
  ValueLevel :: Lev Mono
  LevelUp :: Lev m ~> Lev m
  PolyLevel :: Lev Poly -- level n .
 deriving syntax (lev) Nat(ValueLevel, LevelUp)

data Level :: Lev n ~> * where
  ValueLevel :: Level ValueLevel
  LevelUp :: Level l -> Level (LevelUp l)
  PolyLevel :: Level PolyLevel
 deriving syntax (l) Nat(ValueLevel, LevelUp)

data Signature = Sig

data Iceberg :: * ~> * ~> * where
  Constructor :: Label t -> Level l -> Signature -> Iceberg () ()

data Icename :: Tag ~> Tag ~> * where -- entities with certain name
  NamedConstructor :: Label t -> Level l -> Signature -> Icename t t

data Icelevel :: Lev n ~> Lev n ~> * where -- entities with certain level
  LevelConstructor :: LevelFits l' l => Label t -> Level l -> Signature -> Icelevel l' l'

data TagLev :: Multiplicity ~> *1 where
  TL :: Tag ~> Lev m ~> TagLev m

data Icenamelevel :: TagLev n ~> TagLev n ~> * where -- entities with certain level and name
  NamedLevelConstructor :: LevelFits l' l => Label t -> Level l -> Signature -> Icenamelevel (TL t l') (TL t l')

builtIns :: Thrist Iceberg () ()
builtIns = [ Constructor `Z 0l Sig, Constructor `S 0l Sig, Constructor natPrime 0l Sig
           , Constructor `Z 1l Sig, Constructor `S 1l Sig, Constructor `Nat 2l Sig
           , Constructor starN (LevelUp (LevelUp PolyLevel)) Sig
           , Constructor constraintN (LevelUp (LevelUp PolyLevel)) Sig
           , Constructor `MultValueAndUp PolyLevel Sig]t
  where HideLabel natPrime = newLabel "Nat'"
        HideLabel starN = newLabel "*n"
        HideLabel constraintN = newLabel "#n"

projectName :: Label l -> Thrist Iceberg () () -> Thrist Icename l l
projectName _ []t = []t
projectName l [Constructor l' lev sig; rest]t = case sameLabel l l' of
                                                L Eq -> [NamedConstructor l' lev sig; projectName l rest]t
                                                _ -> projectName l rest

projectName' :: Label t -> Thrist Icelevel l l -> Thrist Icenamelevel (TL t l) (TL t l)
projectName' _ []t = []t
projectName' t [LevelConstructor t' lev sig; rest]t = case sameLabel t t' of
                                                      L Eq -> [NamedLevelConstructor t' lev sig; projectName' t rest]t
                                                      _ -> projectName' t rest

-- inclusion relation on levels
--
prop LevelFits :: Lev n ~> Lev n' ~> * where
  BothValue :: LevelFits ValueLevel ValueLevel
  BothPoly :: LevelFits PolyLevel PolyLevel
  BothUp :: LevelFits k k' -> LevelFits (LevelUp k) (LevelUp k')
  ValuePoly :: LevelFits ValueLevel PolyLevel
  AbovePoly :: LevelFits (LevelUp k) PolyLevel

-- runtime compute level inclusion
--
fits :: Level l -> Level l' -> Maybe (LevelFits l l')
fits ValueLevel ValueLevel = Just BothValue
fits PolyLevel PolyLevel = Just BothPoly
fits (LevelUp l) (LevelUp l') = do ev <- fits l l'
                                   return $ BothUp ev
                                 where monad maybeM
fits ValueLevel PolyLevel = Just ValuePoly
fits (LevelUp l) PolyLevel = Just AbovePoly
fits _ _ = Nothing

projectLevel :: Level l -> Thrist Iceberg () () -> Thrist Icelevel l l
projectLevel _ []t = []t
projectLevel l [Constructor t l' sig; rest]t = case fits l l' of
                                               Just BothValue -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just BothPoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just (BothUp below) -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just ValuePoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just AbovePoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               _ -> projectLevel l rest


add subdivision, this does not consume any subtree on the left, but produces to the right

-- Modeling Opetopes
-- here is Eric's editor: http://sma.epfl.ch/~finster/opetope/opetope.html
--
-- Note: Kock et al. use a similar scheme, where
--          - dots    <-->   lines
--          - spheres <-->   dots
--          - lines disappear
--          -                spheres appear

-- Note: In Eric's new work (at IAS) there are no
--       dots any more, instead he uses 'outout cards', so
--          - (output) cards   <-->  lines
--          - space between stacked cards <--> output cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/NatList.prg"

-- list kind
--kind List = Ni | Co

-- define the Tree kind, a rose tree
-- note: Ni may only appear in Fork second position (TODO: use GADT!)

kind Tree = Unit | Ni | Fork Tree Tree deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr

-- define a proposition for subtrees

prop Subtree :: Tree ~> Tree ~> * where
  BothUnit :: Subtree ()tr ()tr
  BothNil :: Subtree []tr []tr
  TakeHead :: Subtree head head' -> Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr
  SkipHead :: Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr

-- now we can stack cards

data Stack :: Tree ~> Tree ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr
  Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr

-- remains to define corollas

prop Corolla :: Tree ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

--- OLD IMPLEMENTATION FOLLOWS

-- Node Types

kind NodeType = Regular | Universal

-- Node Labels (parametrized by dimension?)

data NodeLabel = Named (Label n)
               | Comp NodeLabel NodeLabel

-- Node: named faces as inputs and an output (face)

-- Consuming some twig

data Eat :: Twig ~> * where
  NoDot :: Eat None  -- do not extend till next sprouting point
  Sub :: Eat (Sprout l)

-- A connected deck of cards

data Deck :: Twig ~> Twig ~> * where
  Air :: Deck t None
  Card :: Eat t -> Deck subt out -> Deck t (Sprout [out]w)

-- A forest: trees in each dimension up to n
--   o when it ends in a corolla then it is a cell (n-dimensional)
--

--data Forest

-- Idea: each tree must have two type parameters
--       o left: set of nodes from dim (n - 1) is our (tree of) lines
--       o right: my set of nodes is the tree I push to dim n + 1

-- HAH! we have a thrist!

-- trees live at the type level

-- have these forms
--      O  |
--   o  |  o
--      o

--         |
-- List of o starts at O

data List :: *1 where
  No :: List
  Ext :: List ~> Twig ~> List
 deriving LeftList(w)

data Twig :: *1 where
  None :: Twig
  Sprout :: List ~> Twig

-- an Opetope is a LeftThrist of Decks

-- Dimension Zero is always:

dim0 = Card NoDot Air

dim1 = Card Sub Air

upto1 = [dim0, dim1]lt

-- Modeling Opetopes
-- here is Eric's editor: http://sma.epfl.ch/~finster/opetope/opetope.html
--
-- Note: Kock et al. use a similar scheme, where
--          - dots    <-->   lines
--          - spheres <-->   dots
--          - lines disappear
--          -                spheres appear

-- Note: In Eric's new work (at IAS) there are no
--       dots any more, instead he uses 'outout cards', so
--          - (output) cards   <-->  lines
--          - space between stacked cards <--> output cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/NatList.prg"

-- list kind
--kind List = Ni | Co

-- define the Tree kind, a rose tree
-- note: Ni may only appear in Fork second position (TODO: use GADT!)

kind Tree = Unit | Ni | Fork Tree Tree deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr

-- define a proposition for subtrees

prop Subtree :: Tree ~> Tree ~> * where
  BothUnit :: Subtree ()tr ()tr
  BothNil :: Subtree []tr []tr
  TakeHead :: Subtree head head' -> Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr
  SkipHead :: Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr

-- now we can stack cards

data Stack :: Tree ~> Tree ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr

-- remains to define corollas

prop Corolla :: Tree ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

--- OLD IMPLEMENTATION FOLLOWS

-- Node Types

kind NodeType = Regular | Universal

-- Node Labels (parametrized by dimension?)

data NodeLabel = Named (Label n)
               | Comp NodeLabel NodeLabel

-- Node: named faces as inputs and an output (face)

-- Consuming some twig

data Eat :: Twig ~> * where
  NoDot :: Eat None  -- do not extend till next sprouting point
  Sub :: Eat (Sprout l)

-- A connected deck of cards

data Deck :: Twig ~> Twig ~> * where
  Air :: Deck t None
  Card :: Eat t -> Deck subt out -> Deck t (Sprout [out]w)

-- A forest: trees in each dimension up to n
--   o when it ends in a corolla then it is a cell (n-dimensional)
--

--data Forest

-- Idea: each tree must have two type parameters
--       o left: set of nodes from dim (n - 1) is our (tree of) lines
--       o right: my set of nodes is the tree I push to dim n + 1

-- HAH! we have a thrist!

-- trees live at the type level

-- have these forms
--      O  |
--   o  |  o
--      o

--         |
-- List of o starts at O

data List :: *1 where
  No :: List
  Ext :: List ~> Twig ~> List
 deriving LeftList(w)

data Twig :: *1 where
  None :: Twig
  Sprout :: List ~> Twig

-- an Opetope is a LeftThrist of Decks

-- Dimension Zero is always:

dim0 = Card NoDot Air

dim1 = Card Sub Air

upto1 = [dim0, dim1]lt


source/QtMacExtras: updated

source/QtMacExtras: updated

Modified:
source/QtMacExtras/QMacPasteboardMime.prg


codegen/QtGui/QImageIOPlugin.prg: updated

Modified:
codegen/QtGui/QImageIOPlugin.prg

%%
%% Qt4xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 4
%%
%% Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$header

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
REQUEST QIMAGEIOHANDLER
#endif

$beginClassFrom=QObject

   METHOD delete
   METHOD capabilities
   METHOD create
   METHOD keys

$endClass

$destructor

#pragma BEGINDUMP

$includes

$deleteMethod

$prototype=virtual Capabilities capabilities ( QIODevice * device, const QByteArray & format ) const = 0
$virtualMethod=|QImageIOPlugin::Capabilities|capabilities|QIODevice *,const QByteArray &

$prototype=virtual QImageIOHandler * create ( QIODevice * device, const QByteArray & format = QByteArray() ) const = 0
$virtualMethod=|QImageIOHandler *|create|QIODevice *,const QByteArray &=QByteArray()

$prototype=virtual QStringList keys () const = 0
$virtualMethod=|QStringList|keys|

#pragma ENDDUMP

%%
%% Qt4xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 4
%%
%% Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$header

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
REQUEST QIMAGEIOHANDLER
#endif

$beginClassFrom=QObject

   METHOD delete
   METHOD capabilities
   METHOD create
   METHOD keys

$endClass

$destructor

#pragma BEGINDUMP

$includes

$deleteMethod

$prototype=virtual Capabilities capabilities ( QIODevice * device, const QByteArray & format ) const = 0
HB_FUNC_STATIC( QIMAGEIOPLUGIN_CAPABILITIES )
{
  QImageIOPlugin * obj = (QImageIOPlugin *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    hb_retni( (int) obj->capabilities ( PQIODEVICE(1), *PQBYTEARRAY(2) ) );
  }
}

$prototype=virtual QImageIOHandler * create ( QIODevice * device, const QByteArray & format = QByteArray() ) const = 0
HB_FUNC_STATIC( QIMAGEIOPLUGIN_CREATE )
{
  QImageIOPlugin * obj = (QImageIOPlugin *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QByteArray par2 = ISNIL(2)? QByteArray() : *(QByteArray *) hb_itemGetPtr( hb_objSendMsg( hb_param(2, HB_IT_OBJECT ), "POINTER", 0 ) );
    QImageIOHandler * ptr = obj->create ( PQIODEVICE(1), par2 );
    _qt4xhb_createReturnClass ( ptr, "QIMAGEIOHANDLER" );
  }
}

$prototype=virtual QStringList keys () const = 0
$virtualMethod=|QStringList|keys|

#pragma ENDDUMP


looks like we need impedance matching for out'

a type function maybe?

data Dir :: *2 where
  Hor :: name ~> Dir -- these are nodes
  Ver :: name ~> Dir -- can be a tree of names!

data Tree :: Dir ~> *1 where
  Pri :: Tag ~> Tree (Hor Tag)
  Unit :: Tree (Ver name)
  Empty :: Tree (Hor (Wrap name))
  Paste :: Tree (Hor name) ~> Tree (Hor (Wrap name)) ~> Tree (Hor (Wrap name))
 deriving syntax (tr) List(Empty, Paste)
                      Unit(Unit)
                      Item(Pri)

data Tree' :: Tree d ~> * where
  Labeled :: Label tag -> Tree' (tag)tr
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork)
                      Unit(In)
                      Item(Labeled)

kind Wrap a = W a

data Stack :: Tree (d n) ~> Tree (e n) ~> * where
  Cell :: Stack ()tr ()tr
  NicheDone :: Stack ()tr []tr
--Also :: Tree' at -> Stack tr out' -> Stack tr out -> Stack tr [out'; out]tr
  Also :: Tree' out' -> Tree' out' -> Stack tr out -> Stack tr [out'; out]tr
 deriving syntax(z) Record(NicheDone, Also)

--t1 = {(`hey)ar=Cell}z

data Dir :: *2 where
  Hor :: name ~> Dir -- these are nodes
  Ver :: name ~> Dir -- can be a tree of names!

data Tree :: Dir ~> *1 where
  Pri :: Tag ~> Tree (Hor Tag)
  Unit :: Tree (Ver name)
  Empty :: Tree (Hor (Wrap name))
  Paste :: Tree (Hor name) ~> Tree (Hor (Wrap name)) ~> Tree (Hor (Wrap name))
 deriving syntax (tr) List(Empty, Paste)
                      Unit(Unit)
                      Item(Pri)

data Tree' :: Tree d ~> * where
  Labeled :: Label tag -> Tree' (tag)tr
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork)
                      Unit(In)
                      Item(Labeled)

kind Wrap a = W a

data Stack :: Tree (d n) ~> Tree (e n) ~> * where
  Cell :: Stack ()tr ()tr
  NicheDone :: Stack ()tr []tr
  Also :: Tree' at -> Stack tr out' -> Stack tr out -> Stack tr [out'; out]tr
 deriving syntax(z) Record(NicheDone, Also)

--t1 = {(`hey)ar=Cell}z