[Runtime] Renamed parameter to be consistent

//
// 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.
//
// internal functions used by FieldBlock and FieldWBlock

USING XSharp.Rdd.Support
USING XSharp.Rdd
USING System.Linq
USING System.Collections.Generic

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/select/*" />
FUNCTION Select(uWorkArea) AS USUAL CLIPPER
    LOCAL sSelect   AS DWORD
	LOCAL sCurrent  AS DWORD
	sCurrent := VODBGetSelect()
	sSelect := _SELECT(uWorkArea)
	VODBSetSelect(INT(sCurrent))
	RETURN sSelect

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/select/*" />
FUNCTION _SelectString(uWorkArea AS STRING) AS DWORD
    LOCAL nSelect := 0 AS DWORD
    uWorkArea := AllTrim(uWorkArea)
    IF SLen(uWorkArea) = 1
        nSelect := Val(uWorkArea)
		VAR nAsc := Asc( Upper(uWorkArea) )
		IF nAsc > 64 .AND. nAsc < 75
			nSelect := nAsc - 64
		ENDIF
    ENDIF

    IF nSelect > 0 .OR. "0" == uWorkArea
        nSelect := VoDb.SetSelect((INT) nSelect)
    ELSE
        nSelect := (DWORD) VoDb.SymSelect(uWorkArea)
    ENDIF
    RETURN nSelect

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/select/*" />
FUNCTION _Select(uWorkArea) AS USUAL CLIPPER
    LOCAL nSelect           AS DWORD
    LOCAL xType             AS DWORD

    IF uWorkArea:IsNil
        RETURN  (INT) VoDb.GetSelect()
    ENDIF
    xType := UsualType(uWorkArea)
    SWITCH xType
    CASE SYMBOL
        nSelect := (DWORD) VoDb.SymSelect((SYMBOL) uWorkArea)
    CASE STRING
        nSelect := _SelectString(uWorkArea)
    CASE LONG
    CASE FLOAT
        nSelect := VoDb.SetSelect(uWorkArea)
    OTHERWISE
        nSelect := 0
    END SWITCH
    RETURN nSelect

/// <exclude/>
FUNCTION __FieldGetNum( fieldpos AS DWORD ) AS USUAL
    LOCAL ret := NIL AS USUAL
    VoDb.FieldGet( fieldpos, REF ret )
    RETURN ret

/// <exclude/>
FUNCTION __FieldGetWaNum( workarea AS DWORD, fieldpos AS DWORD ) AS USUAL
    LOCAL ret := NIL AS USUAL
    LOCAL curArea AS DWORD
    curArea := RuntimeState.CurrentWorkarea
    TRY
        RuntimeState.CurrentWorkarea := workarea
        VoDb.FieldGet( fieldpos, REF ret )
    FINALLY
        RuntimeState.CurrentWorkarea := curArea
    END TRY
    RETURN ret

/// <exclude/>
FUNCTION __FieldSetNum( fieldpos AS DWORD, uValue AS USUAL ) AS USUAL
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldPut( fieldpos, uValue ))

/// <exclude/>
FUNCTION __FieldSetWaNum( nArea AS DWORD, fieldpos AS DWORD, uValue AS USUAL ) AS USUAL
    LOCAL curArea AS DWORD
    curArea := RuntimeState.CurrentWorkarea
    TRY
        RuntimeState.CurrentWorkarea := nArea
        _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldPut( fieldpos, uValue ) )
    FINALLY
        RuntimeState.CurrentWorkarea := curArea
    END TRY
    RETURN uValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldblock/*" />
FUNCTION FieldBlock(cFieldName AS STRING) AS CODEBLOCK
    LOCAL oCB  := NULL AS CODEBLOCK
    LOCAL nPos := 0    AS DWORD
    IF ! String.IsNullOrEmpty(cFieldName)
        nPos := FieldPos(cFieldName)
        IF nPos != 0
            //oCB := MCompile("{|x| iif( IsNil(x), __FieldGetNum( "+nPos:ToString()+"), __FieldSetNum( "+nPos:ToString()+" , x)")
            oCb := {|x| IIF(x:IsNil, __FieldGetNum(nPos), __FieldSetNum(nPos, x))}
        ENDIF
    ENDIF
    RETURN oCB

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldblocksym/*" />
FUNCTION FieldBlockSym(symFieldName AS SYMBOL) AS CODEBLOCK
    RETURN FieldBlock(symFieldName)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldwblock/*" />
FUNCTION FieldWBlock(cFieldName AS STRING,dwWorkArea AS USUAL) AS CODEBLOCK
    RETURN {|x| IIF( x:IsNil, __FieldGetWa(dwWorkArea, cFieldName), __FieldSetWa(dwWorkArea, cFieldName, x)) }

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldwblocksym/*" />
FUNCTION FieldWBlockSym(symFieldname AS SYMBOL,dwWorkArea AS DWORD) AS CODEBLOCK
    RETURN FieldWBlock(symFieldname, dwWorkArea)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldgetalias/*" />
FUNCTION FieldGetAlias(symAlias AS SYMBOL,symFieldName AS SYMBOL) AS USUAL
    RETURN fieldGetSelect(symAlias, symFieldName)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldgetalias/*" />
FUNCTION FieldGetSelect(symAlias AS USUAL,symFieldName AS SYMBOL) AS USUAL
    LOCAL nArea := RuntimeState.CurrentWorkArea AS DWORD
    LOCAL uValue AS USUAL
    DbSelectArea(symAlias)
    uValue := FieldGetSym(symFieldName)
    VoDb.SetSelect((INT) nArea)
    RETURN uValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldgetsym/*" />
FUNCTION FieldGetSym(symField AS SYMBOL) AS USUAL
    LOCAL dwPos AS DWORD
    dwPos := FieldPosSym(symField)
    IF dwPos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME,  <OBJECT>{symField}  )
    ENDIF
    RETURN FieldGet( dwPos )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldpossym/*" />
FUNCTION FieldPosSym(sFieldName AS SYMBOL) AS DWORD
    RETURN FieldPos( (STRING) sFieldName )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldputalias/*" />
FUNCTION FieldPutAlias(symAlias AS SYMBOL,symField AS SYMBOL,uNewValue AS USUAL) AS USUAL
    RETURN FieldPutSelect(symAlias, symField, uNewValue)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldputsym/*" />
FUNCTION FieldPutSym(symField AS SYMBOL,uNewValue AS USUAL) AS USUAL
    LOCAL dwPos AS DWORD
    dwPos := FieldPosSym(symField)
    IF dwPos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME,  <OBJECT>{symField}  )
    ENDIF
    RETURN FieldPut( dwPos ,uNewValue )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldputselect/*" />
FUNCTION FieldPutSelect(symAlias AS USUAL,symField AS SYMBOL,uNewValue AS USUAL) AS USUAL
    LOCAL nArea AS DWORD
    nArea := SELECT(symAlias )
    RETURN FieldPutArea(nArea, symField, uNewValue)

    *----------------------------------------------------------------------------

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/alias/*" />
FUNCTION Alias(uWorkArea) AS STRING CLIPPER
    IF uWorkArea:IsNil
        RETURN Alias0()
    ENDIF
    IF IsNumeric(uWorkArea)
        RETURN VoDb.Alias(uWorkArea)
    ENDIF
    RETURN (uWorkArea)->Alias()

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/alias0sym/*" />
FUNCTION Alias0Sym() AS SYMBOL
    RETURN (SYMBOL) Alias0()

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbappend/*" />
FUNCTION DbAppend(lReleaseLocks) AS LOGIC CLIPPER
    LOCAL lRetCode  AS LOGIC

    IF lReleaseLocks:IsNil
        lReleaseLocks := .T.
    ENDIF

    lRetCode := VoDb.Append(lReleaseLocks)

    IF !lRetCode
        //    No Error but NetErr gets set for compatibility reasons
        //    lRetCode := DoError("DbAppend")
        NetErr(.T.)
    ENDIF

    RETURN lRetCode

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbclearindex/*" />
FUNCTION DbClearIndex(uOrder, cIndexFile) AS LOGIC CLIPPER
    RETURN OrdListClear(cIndexFile, uOrder)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcreate/*" />
FUNCTION DbCreate (   cTargetFile,  aStruct, cDriver , lNew,  cAlias, cDelim, lOpen, acRDDs ) AS LOGIC CLIPPER
    LOCAL lKeep           AS LOGIC
    LOCAL lRetCode        AS LOGIC

    IF aStruct == NIL
        aStruct := {}
    ENDIF

    IF ! aStruct:IsArray
        RETURN .F.
    ENDIF

    //
    // Get "lNew" and create "lKeep" for VODBUseArea()
    // by Clipper's logic:
    //
    //      .T. -   to open in first available workarea
    //      .F. -   to open in current workarea
    //      NIL -   to close file after creating
    //

    IF lNew == NIL
        lNew    := .T.
        lKeep   := .F.
    ELSE
        lKeep   := .T.
    ENDIF

    IF lOpen == NIL
        lOpen := .F.
    ENDIF

    LOCAL oDriver := cDriver AS OBJECT
    IF oDriver == NULL_OBJECT
        oDriver := RuntimeState.DefaultRDD
    ENDIF
    IF oDriver IS STRING
        lRetCode := VoDbCreate(cTargetFile, aStruct, (STRING) oDriver, lNew, cAlias, cDelim, lKeep, lOpen)
    ELSEIF oDriver IS System.Type
        lRetCode := VoDbCreate(cTargetFile, aStruct, (Type) oDriver, lNew, cAlias, cDelim, lKeep, lOpen )
    ELSE
        THROW Error.DataTypeError( __FUNCTION__, nameof(cDriver ), 3, { cDriver  } )
    ENDIF
    IF ! lRetCode .AND. RuntimeState.LastRDDError != NULL
        THROW RuntimeState.LastRDDError
    ENDIF
    RETURN lRetCode

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcreateindex/*" />
FUNCTION DbCreateIndex(cIndexFile, cKeyValue, cbKeyValue, lUnique) AS LOGIC CLIPPER
    RETURN OrdCreate(cIndexFile, NIL, cKeyValue, cbKeyValue, lUnique)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcreateorder/*" />
FUNCTION DbCreateOrder  (cOrder, cIndexFile, cKeyValue, cbKeyValue, lUnique) AS LOGIC CLIPPER
    RETURN OrdCreate(cIndexFile, cOrder, cKeyValue, cbKeyValue, lUnique)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbdelete/*" />
FUNCTION DbDelete () AS LOGIC STRICT
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Delete() )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbdeleteorder/*" />
FUNCTION DbDeleteOrder(uOrder, cIndexFile) AS LOGIC CLIPPER
    IF uOrder:IsNumeric
        VoDb.OrderInfo(DBOI_NAME,"",uOrder, REF uOrder)
    ENDIF

    RETURN OrdDestroy(uOrder, cIndexFile)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbeval/*" />
FUNCTION DbEval(cbExecute, cbForCondition, cbWhileCondition, nNext, nRecord, lRest) AS LOGIC CLIPPER
    IF lRest:IsNil
        lRest := .F.
    ENDIF
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Eval(VoDb.ValidBlock(cbExecute), VoDb.ValidBlock(cbForCondition), VoDb.ValidBlock(cbWhileCondition), nNext, nRecord, lRest) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbfieldinfo/*" />
FUNCTION DbFieldInfo(kInfoType, nFieldPos, uNewSetting) AS USUAL CLIPPER
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldInfo(kInfoType, nFieldPos, REF uNewSetting))
    RETURN uNewSetting

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbgoto/*" />
FUNCTION DbGoto(uRecID AS USUAL) AS LOGIC
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Goto(uRecId) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbgoto/*" />
FUNCTION DbGoto(uRecID AS USUAL, uArea AS USUAL) AS LOGIC
    RETURN (uArea)->(DbGoto(uRecID))

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbinfo/*" />
FUNCTION DbInfo(kInfoType, uNewSetting) AS USUAL CLIPPER
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Info(kInfoType, REF uNewSetting))
    IF kInfoType == DBI_GETLOCKARRAY .AND. ((OBJECT) uNewSetting) IS INT[]
        LOCAL aLocks AS INT[]
        LOCAL aResult AS ARRAY
        aLocks := (INT[]) uNewSetting
        aResult := ArrayNew()
        FOREACH VAR iLock IN aLocks
            aResult:Add(iLock)
        NEXT
        uNewSetting := aResult
    ENDIF
    RETURN uNewSetting

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dblocate/*" />
FUNCTION DbLocate(cbForCondition, cbWhileCondition, nNext, nRecord, lRest ) AS LOGIC CLIPPER

    LOCAL lRetCode  AS LOGIC

    IF lRest:IsNil
        lRest := .F.
    ENDIF

    IF cbWhileCondition:IsNil
        cbWhileCondition := {|| .T. }
    ELSE
        lRest := .T.
    ENDIF

    IF nNext:IsNil
        nNext := 0
    ENDIF
    lRetCode := _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Locate(VoDb.ValidBlock(cbForCondition), VoDb.ValidBlock(cbWhileCondition), nNext, nRecord, lRest))
    IF lRetCode
        lRetCode := VoDb.Found()
    ENDIF

    RETURN lRetCode

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dborderinfo/*" />
/// <seealso cref='T:XSharp.RDD.Enums.DbOrder_Info'>DbOrder_Info ENUM</seealso>
FUNCTION DbOrderInfo(kInfoType,cIndexFile, uOrder, uNewSetting) AS USUAL CLIPPER
    LOCAL lKeyVal  := FALSE  AS LOGIC

    IF !cIndexFile:IsString
        cIndexFile := ""
    ENDIF

    IF uOrder:IsString
        IF SLen(uOrder) == 0
            uOrder := NIL
        ENDIF
    ENDIF

    IF kInfoType == DBOI_KEYVAL
        lKeyVal  := .T.
        kInfoType := DBOI_EXPRESSION
    ENDIF
    VoDb.OrderInfo(kInfoType, cIndexFile, uOrder, REF uNewSetting)
    IF lKeyVal
        IF uNewSetting:IsString
            IF SLen(uNewSetting) == 0
                uNewSetting := NIL
            ELSE
                uNewSetting := &(uNewSetting)
            ENDIF
        ENDIF
    ENDIF

    RETURN uNewSetting

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrecordinfo/*" />
/// <seealso cref='T:XSharp.RDD.Enums.DbRecordInfo'>DbRecordInfo ENUM</seealso>
FUNCTION DbRecordInfo(kInfoType, uRecId, uNewValue) AS USUAL CLIPPER
    VoDb.RecordInfo(kInfoType, uRecId, REF uNewValue)
    RETURN uNewValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrlock/*" />
FUNCTION DbRLock(uRecId) AS USUAL CLIPPER
    RETURN VoDb.Rlock(uRecId)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrlocklist/*" />
FUNCTION DbRLockList() AS ARRAY STRICT

    LOCAL aLockList := {}   AS ARRAY
    LOCAL uRecords  := NIL AS USUAL

    IF _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Info(DBI_LOCKCOUNT, REF uRecords))
        aLockList := DbInfo(DBI_GETLOCKARRAY)
    ENDIF

    RETURN aLockList

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrselect/*" />
FUNCTION DbRSelect(nRelation) AS DWORD CLIPPER

    DEFAULT( REF nRelation, 0)

    RETURN VoDb.RSelect(nRelation)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrunlock/*" />
FUNCTION DbRUnLock(uRecID) AS LOGIC CLIPPER
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Unlock(uRecId) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbselect/*" />
FUNCTION DbSelect(nNew) AS DWORD CLIPPER

    LOCAL nOld := 0 AS DWORD

    DEFAULT( REF nNew, 0)

    VoDb.Select(nNew, REF nOld)

    RETURN nOld

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbselectarea/*" />
FUNCTION DbSelectArea(uArea) AS LOGIC CLIPPER
    LOCAL sSelect   AS SHORT
    sSelect := _SELECT(uArea)
    _DbThrowErrorOnFailure(__FUNCTION__, sSelect != 0)
    RETURN (sSelect > 0)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsetselect/*" />
FUNCTION DbSetSelect(nNewArea) AS DWORD CLIPPER

    DEFAULT( REF  nNewArea, 0)

    RETURN (DWORD) VoDb.SetSelect(nNewArea)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsymselect/*" />
FUNCTION DbSymSelect(symAlias)  AS DWORD CLIPPER
    IF symAlias:IsNil
        symAlias := Alias0Sym()
    ENDIF
    EnForceType(symAlias, SYMBOL)
    RETURN (DWORD) VoDb.SymSelect(symAlias)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrelation/*" />
FUNCTION DbRelation(nRelation)  AS STRING CLIPPER
    LOCAL cRelText  := "" AS STRING
    DEFAULT(  REF nRelation, 1)
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Relation(nRelation, REF cRelText))
    RETURN cRelText

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsetdriver/*" />
FUNCTION DbSetDriver(cNewSetting) AS STRING CLIPPER
    IF cNewSetting:IsString
        RETURN RddSetDefault(cNewSetting)
    ENDIF
    RETURN RddSetDefault()

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsetfilter/*" />
FUNCTION DbSetFilter(cbCondition, cCondition) AS LOGIC CLIPPER
    LOCAL sCondition AS STRING
    LOCAL cbCond AS CODEBLOCK
    if PCount() == 0 .or. (cbCondition:IsNil .and. cCondition:IsNil)
        return DbClearFilter()
    endif
    // Only one parameter passed and it is a string
    // Move it to the second parameter and clear the first parameter
    IF cbCondition:IsString .and. PCount() == 1
        cCondition  := cbCondition
        cbCondition := NIL
    endif
    // Create Compiled codeblock from String
    IF cbCondition:IsNil
        EnForceType(cCondition, STRING)
        sCondition := cCondition
        sCondition := sCondition:Trim()
        if !sCondition:StartsWith("{||")
            cbCondition := &("{||"+scondition+"}")
        else
            cbCondition := &(cCondition)
        endif
    ENDIF
    // Todo : Extract the string from compiled codeblocks
    if cCondition:IsNil
        local oBlock as Object
        EnForceType(cbCondition, CODEBLOCK)
        oBlock := cbCondition
        // When the codeblock is a macro compiled codeblock
        if oBlock IS XSharp._Codeblock VAR cbMacro
            sCondition := cbMacro:ToString():Trim()
            if sCondition:StartsWith("{||") .and. sCondition:EndsWith("}")
                sCondition := sCondition:Substring(3, sCondition:Length-4):Trim()
            endif
            cCondition := sCondition
        else
            cCondition := "UNKNOWN"
        endif
    ENDIF
    IF cbCondition:IsCodeBlock
        cbCond := cbCondition
    ELSE
        cbCond := NULL
    ENDIF
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.SetFilter(cbCond, cCondition) )

    *----------------------------------------------------------------------------
/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsetrelation/*" />
/// <param name="cName">An optional name for the relation. Defaults to ParentName + "_" + ChildName.</param>
FUNCTION DbSetRelation  (xAlias, cbKey, cKey, cName) AS LOGIC CLIPPER

    LOCAL nSelect   AS DWORD
    LOCAL cAlias    AS STRING
    LOCAL cbRelation AS CODEBLOCK
    DEFAULT(REF cName, "")

    IF xAlias:IsString
        nSelect := Val(xAlias)

        IF nSelect = 0
            cAlias := xAlias
        ELSE
            cAlias := ALIAS(nSelect)
        ENDIF

    ELSE
        cAlias := ALIAS(xAlias)
    ENDIF
    IF cbKey:IsCodeBlock
        cbRelation := cbKey
    ELSE
        cbRelation := NULL
    ENDIF
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.SetRelation(cAlias, cbRelation, cKey, cName) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbskip/*" />
FUNCTION DbSkip (nRecords) AS LOGIC CLIPPER
    IF nRecords:IsNil
        nRecords := 1
    ENDIF
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Skip(nRecords) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbusearea/*" />
FUNCTION DbUseArea (lNewArea, cDriver, cDataFile, cAlias, lShared, lReadOnly, aStruct, cDelim,acRDDs ) AS LOGIC CLIPPER
    LOCAL lRetCode        AS LOGIC
    LOCAL rddList         AS _RddList
    LOCAL nTries          AS LONG
    LOCAL aRdds           AS ARRAY

    DEFAULT( REF lNewArea, .F.)
    DEFAULT( REF cAlias, "")
    DEFAULT( REF lShared, !SetExclusive())
    DEFAULT( REF lReadOnly, .F.)
    DEFAULT( REF cDelim, "")
    nTries := 1
    aRdds   := VoDb.RDDList(cDriver, acRDDs)
    rddList := VoDb.AllocRddList(aRdds)
    DO WHILE .T.

        IF !Empty(aStruct)
            lRetCode := DbCreate ( cDataFile, aStruct, aRdds, lNewArea,cAlias, cDelim, .T.)
        ELSE
            lRetCode := VoDb.UseArea(lNewArea, rddList, cDataFile, cAlias, lShared, lReadOnly)
        ENDIF
        IF lRetCode
            EXIT
        ELSE
            IF ( (INT) DoError(__FUNCTION__, nTries) != E_RETRY )
                EXIT
            ENDIF
            nTries := nTries + 1
        ENDIF
    ENDDO
    RETURN lRetCode

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldput/*" />
FUNCTION FieldPut (nFieldPos AS USUAL, uNewValue  AS USUAL) AS USUAL
    LOCAL lResult AS LOGIC
    IF ! IsNumeric(nFieldPos)
        THROW Error.ArgumentError( __FUNCTION__, nameof(nFieldPos), __CavoStr(VoErrors.ARGNOTNUMERIC), 1 ,<OBJECT>{nFieldPos,uNewValue})
    ENDIF
    lResult  := VoDb.FieldPut(nFieldPos, uNewValue)
    IF ! lResult
        IF RuntimeState.Dialect == XSharpDialect.XPP
            uNewValue := NIL
        ELSE
            DoError(__FUNCTION__)
        ENDIF
    ENDIF
    RETURN uNewValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldget/*" />
FUNCTION FieldGet(nFieldPos) AS USUAL CLIPPER
    LOCAL xRetVal := NIL AS USUAL
    LOCAL lResult AS LOGIC
    IF ! IsNumeric(nFieldPos)
        THROW Error.ArgumentError(__FUNCTION__, nameof(nFieldPos), __CavoStr(VoErrors.ARGNOTNUMERIC), 1 ,<OBJECT> {nFieldPos})
    ENDIF
    lResult  := VoDb.FieldGet(nFieldPos, REF xRetVal)
    IF ! lResult
        IF RuntimeState.Dialect == XSharpDialect.XPP
            xRetVal := NIL
        ELSE
            DoError(__FUNCTION__)
        ENDIF
    ENDIF
    RETURN xRetVal

/// <summary>Read an array of bytes direct from the workarea buffer.</summary>
/// <remarks>This will only work for DBF based workareas (not for Advantage workareas)</remarks>
FUNCTION FieldGetBytes(nFieldPos ) AS BYTE[] CLIPPER
    LOCAL bRetVal := NULL AS BYTE[]
    IF ! IsNumeric(nFieldPos)
        THROW Error.ArgumentError(__FUNCTION__, nameof(nFieldPos), __CavoStr(VoErrors.ARGNOTNUMERIC), 1 ,<OBJECT> {nFieldPos})
    ENDIF
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldGetBytes(nFieldPos, REF bRetVal))
    RETURN bRetVal

/// <summary>Write an array of bytes direct to the workarea buffer.</summary>
/// <remarks>This will only work for DBF based workareas (not for Advantage workareas)</remarks>
FUNCTION FieldPutBytes(nFieldPos AS USUAL, aBytes AS BYTE[]) AS LOGIC
    IF ! IsNumeric(nFieldPos)
        THROW Error.ArgumentError(__FUNCTION__, nameof(nFieldPos), __CavoStr(VoErrors.ARGNOTNUMERIC), 1 ,<OBJECT> {nFieldPos,aBytes})
    ENDIF
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldPutBytes(nFieldPos, aBytes))
    RETURN TRUE

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldgetarea/*" />
FUNCTION FieldGetArea(dwWorkArea AS DWORD, symFieldName AS SYMBOL) AS USUAL
    LOCAL oldArea := VoDbGetSelect() AS DWORD
    LOCAL result := NIL  AS USUAL
    LOCAL dwPos AS DWORD
    TRY
        VoDbSetSelect( (INT) dwWorkArea)
        dwPos := FieldPosSym(symFieldName)
        IF dwPos == 0
           VoDbSetSelect( (INT) oldArea)
           THROW Error.VODBError(EG_ARG, EDB_FIELDNAME, __FUNCTION__, <OBJECT>{symFieldName})
        ELSE
            VODBFieldGet( dwPos, REF result )
        ENDIF
    FINALLY
        VoDbSetSelect( (INT) oldArea)
    END TRY
    RETURN result

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldputarea/*" />
FUNCTION FieldPutArea(dwWorkArea AS DWORD, symField AS SYMBOL, uNewValue AS USUAL) AS USUAL
    LOCAL oldArea := VoDbGetSelect() AS DWORD
    LOCAL dwPos AS DWORD
    TRY
        VoDbSetSelect( (INT) dwWorkArea)
        dwPos := FieldPosSym(symField)
        IF dwPos == 0
           VoDbSetSelect( (INT) oldArea)
           THROW Error.VODBError(EG_ARG, EDB_FIELDNAME, __FUNCTION__, <OBJECT>{symField})
        ELSE
            VODBFieldPut( dwPos, uNewValue)
        ENDIF
    FINALLY
        VoDbSetSelect( (INT) oldArea)
    END TRY
    RETURN uNewValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/lupdate/*" />
FUNCTION LUpdate()  AS DATE STRICT
    RETURN DbInfo(DBI_LASTUPDATE)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/lupdate/*" />
FUNCTION LUpdate(uArea AS USUAL)  AS DATE STRICT
    RETURN (uArea)->(LUpdate())

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rddcount/*" />
FUNCTION RddCount() AS DWORD CLIPPER
    RETURN VoDb.RddCount()

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rddinfo/*" />
FUNCTION RddInfo(kInfoType, uNewSetting) AS USUAL CLIPPER
    VoDb.RDDInfo(kInfoType, REF uNewSetting)
    RETURN uNewSetting

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rddlist/*" />
FUNCTION RddList () AS ARRAY CLIPPER
    LOCAL aRddList := {}    AS ARRAY
    IF VoDb.RddCount() > 0
        VAR aNames := VoDb.RddList()
        FOREACH name AS STRING IN aNames
            AAdd( aRddList, name)
        NEXT
    ENDIF
    RETURN aRddList

 /// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbmemoext/*" />
FUNCTION DbMemoExt      (cDriver) AS STRING CLIPPER
    RETURN VoDb.MemoExt(cDriver)

FUNCTION RddVersion     (nParm) AS USUAL CLIPPER
    IF !nParm:IsNumeric
        nParm := 0
    ENDIF
    RETURN DbInfo(DBI_RDD_VERSION, nParm)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbmemofield/*" />
FUNCTION DbMemoField (uField AS USUAL)  AS USUAL
    LOCAL n,i        AS DWORD
    LOCAL xRet       AS USUAL
    LOCAL nFields    AS DWORD

    IF uField:IsNumeric
        n := uField
    ELSEIF uField:IsSymbol
        n := FieldPosSym(uField)
    ELSEIF uField:IsString
        n := FieldPos(uField)
    ELSE
        nFields := FCount()
        n := 0
        FOR i := 1 TO nFields
            IF DbFieldInfo(i, DBS_TYPE) == "M"
                n := i
                EXIT
            ENDIF
        NEXT
    ENDIF

    xRet := DbInfo( DBI_MEMOFIELD, n )

    RETURN xRet

/// <exclude/>
FUNCTION _DbCreate(cFile1, cFile2, cDriver,lNew, cAlias)      AS LOGIC CLIPPER

    LOCAL aStruct       AS ARRAY
    LOCAL i,n           AS INT
    LOCAL nSelect       AS INT
    LOCAL aField        AS ARRAY

    FIELD field_name, field_type, field_len, field_dec

    nSelect := 0

    DEFAULT( REF lNew, .F.)

    IF ( Used() .AND. !lNew )
        VoDb.CloseArea()
    ENDIF

    TRY
        IF ( Empty(cFile2) )
            DbCreate(cFile1,                ;
            { {"FIELD_NAME", "C", 10, 0},   ;
            {"FIELD_TYPE", "C", 1, 0},      ;
            {"FIELD_LEN", "N", 3, 0},       ;
            {"FIELD_DEC", "N", 3, 0} },     ;
            cDriver,                        ;
            .F.,                            ;
            cAlias)
        ELSE
            DbUseArea(lNew, cDriver, cFile2)
            aStruct := {}
            n := VoDb.LastRec()
            VoDb.GoTop()
            DO WHILE !VoDb.EOF()
                aField := ArrayNew(4)
                aField[DBS_NAME] := AllTrim(fieldGet(1))
                aField[DBS_TYPE] := AllTrim(fieldGet(2))
                aField[DBS_LEN ] := fieldGet(3)
                aField[DBS_DEC ] := fieldGet(4)
                AAdd( aStruct, aField )
                VoDb.Skip(1)
            ENDDO

            VoDb.CloseArea()

            IF lNew
                VoDb.SetSelect(nSelect)
            ENDIF

            FOR i := 1 TO n
                aField := aStruct[i]
                IF aField[ DBS_TYPE] == "C" .AND. aField[DBS_DEC] != 0
                    aField[DBS_LEN] += aField[DBS_DEC] * 256
                ENDIF
            NEXT
            DbCreate(cFile1, aStruct, cDriver, lNew, cAlias )
        ENDIF

    CATCH e AS RddError
        VoDb.CloseArea()
        e:FuncSym := __FUNCTION__
        THROW e
    END TRY

    RETURN ( Used() )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/afields/*" />
FUNCTION AFields(acFieldNames, acTypes, anWidths, anDecimals)  AS DWORD CLIPPER
    LOCAL aStruct           AS ARRAY
    LOCAL siCount           AS DWORD
    LOCAL si                AS DWORD
    LOCAL lNamesOk  := .F.  AS LOGIC
    LOCAL lTypesOk  := .F.  AS LOGIC
    LOCAL lLensOk   := .F.  AS LOGIC
    LOCAL lDecsOk   := .F.  AS LOGIC
    aStruct := DbStruct()
    IF (Empty(aStruct))
        RETURN (0)
    ENDIF

    siCount := ALen(aStruct)

    IF UsualType(acFieldNames) == ARRAY
        siCount := Min(siCount, Len(acFieldNames) )
        lNamesOk := .T.
    ENDIF

    IF UsualType(acTypes) == ARRAY
        siCount := Min( siCount, Len(acTypes) )
        lTypesOk := .T.
    ENDIF

    IF UsualType(anWidths) == ARRAY
        siCount := Min( siCount, Len(anWidths) )
        lLensOk := .T.
    ENDIF

    IF UsualType(anDecimals) == ARRAY
        siCount := Min( siCount, Len(anDecimals) )
        lDecsOk := .T.
    ENDIF

    FOR si := 1 TO siCount

        IF lNamesOk
            acFieldNames[si] := aStruct[si, DBS_NAME]
        ENDIF

        IF lTypesOk
            acTypes[si] := aStruct[si, DBS_TYPE]
        ENDIF

        IF lLensOk
            anWidths[si]  := aStruct[si, DBS_LEN]
        ENDIF

        IF lDecsOk
            anDecimals[si]  := aStruct[si, DBS_DEC]
        ENDIF

    NEXT

    RETURN siCount

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcopystruct/*" />
FUNCTION DbCopyStruct(cTargetFile AS STRING, acStruct := NULL_ARRAY AS ARRAY) AS LOGIC STRICT
    RETURN DBCREATE(cTargetFile, VoDb.FieldList(DbStruct(), acStruct, NULL_ARRAY) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcopyxstruct/*" />
FUNCTION DbCopyXStruct(cTargetFile AS STRING) AS LOGIC STRICT
    LOCAL siSaveSel,n,i AS DWORD
    LOCAL aStruct       AS ARRAY
    LOCAL lRetCode  := FALSE AS LOGIC

    FIELD field_name, field_type, field_len, field_dec

    TRY
        IF !Used()
            THROW VoDb.DBCMDError(__FUNCTION__)
        ENDIF

        aStruct := DbStruct()

        n := Len(aStruct)
        siSaveSel := 0
        VoDb.Select(0, REF siSaveSel)

        _DbCreate(cTargetFile)

        FOR i := 1 TO n

            IF aStruct[i, DBS_TYPE] == "C" .AND. aStruct[i, DBS_LEN] > 255
                aStruct[i, DBS_DEC] := SHORT(aStruct[i, DBS_LEN] / 256)
                aStruct[i, DBS_LEN] := aStruct[i, DBS_LEN] % 256
            ENDIF

            lRetCode := DBAPPEND()

            FieldPutSym(#field_name ,aStruct[i, DBS_NAME])
            FieldPutSym(#field_type ,aStruct[i, DBS_TYPE])
            FieldPutSym(#field_len  ,aStruct[i, DBS_LEN])
            FieldPutSym(#field_dec  , aStruct[i, DBS_DEC])

        NEXT

        IF (VoDb.GetSelect() <> siSaveSel)
            DbCloseArea()
            VoDb.SetSelect(INT(siSaveSel))
        ENDIF

    CATCH e AS RddError
        e:FuncSym := __FUNCTION__
        THROW e
    END TRY

    RETURN (lRetCode)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbstruct/*" />
FUNCTION DbStruct() AS ARRAY PASCAL

    LOCAL aStruct   AS ARRAY
    LOCAL nFCount   AS DWORD
    LOCAL nProps    AS DWORD
    LOCAL i,j       AS DWORD
    LOCAL aField    AS ARRAY

    aStruct := {}
    nFCount := FCount()

    IF !Used()
        THROW VoDb.DbCmdError(__FUNCTION__)
    ELSE
        FOR i := 1 UPTO nFCount
            aField := {}

            LOCAL xNewVal := NIL AS USUAL
            _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldInfo(DBS_PROPERTIES, i, REF xNewVal))
            nProps:= (DWORD)  xNewVal
            FOR j := 1 UPTO nProps
                _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldInfo(j, i, REF xNewVal))
                AAdd(aField, xNewVal)
            NEXT

            AAdd(aStruct, aField)

        NEXT
    ENDIF

    RETURN aStruct

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbstruct/*" />
FUNCTION DbStruct(uArea AS USUAL) AS ARRAY PASCAL
    RETURN (uArea)->(DbStruct())

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/indexhplock/*" />
FUNCTION IndexHPLock(lNewSetting AS USUAL) AS LOGIC
    LOCAL lOld AS LOGIC
    lOld := RuntimeState.HPLocking
    IF lNewSetting:IsLogic
        RuntimeState.HPLocking := (LOGIC) lNewSetting
    ENDIF
    RETURN lOld

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/newindexlock/*" />
FUNCTION NewIndexLock(lNewSetting AS USUAL) AS LOGIC
    LOCAL lOld AS LOGIC
    lOld := RuntimeState.NewIndexLock
    IF lNewSetting:IsLogic
        RuntimeState.NewIndexLock := (LOGIC) lNewSetting
    ENDIF
    RETURN lOld

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/newlocks/*" />
FUNCTION NewLocks() AS LOGIC
    RETURN RuntimeState.NewIndexLock

/// <exclude />
FUNCTION __RDDList(cRddName AS STRING) AS ARRAY
    RETURN VoDb.RDDList(cRddName, {})
/// <exclude />
FUNCTION __RDDList(cRddName AS STRING, aHidden AS ARRAY) AS ARRAY
    RETURN VoDb.RDDList(cRddName, aHidden)

/// <exclude />
FUNCTION _AllocFieldNames(aStruct AS ARRAY) AS _FieldNames
    RETURN VoDb.AllocFieldNames(aStruct)

/// <exclude />
FUNCTION _FreeFieldNames(aNames AS _FieldNames) AS VOID
    RETURN

/// <exclude />
FUNCTION __allocNames(aStruct AS ARRAY) AS _FieldNames
    RETURN VoDb.AllocFieldNames(aStruct)

/// <exclude />
FUNCTION __TargetFields(cAlias AS STRING, aFields AS ARRAY, list OUT _JoinList ) AS ARRAY
    RETURN VoDb.TargetFields(cAlias, aFields, OUT list)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/emptyrecord/*" />
FUNCTION EmptyRecord() AS LOGIC
   LOCAL lRet    AS LOGIC
   LOCAL aRecord AS BYTE[]

   IF Used()
      aRecord := VODBRecordGet()
      lRet := TRUE
      FOREACH VAR b IN aRecord
         IF b != 32
            lRet := FALSE
            EXIT
         ENDIF
      NEXT
   ELSE
        lRet := FALSE
   ENDIF
   RETURN lRet

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/emptyfield/*" />
FUNCTION EmptyField( n AS DWORD ) AS LOGIC
   LOCAL aRecord AS BYTE[]
   LOCAL i       AS DWORD
   LOCAL lRet    AS LOGIC
   LOCAL nOffset AS DWORD
   LOCAL nEnd    AS DWORD
   LOCAL uLen AS USUAL
   IF Used() .AND. n > 0 .AND. n <= FCount()
        lRet := TRUE
        aRecord := VODBRecordGet()
        nOffset := 2        // skip the Deleted flag
        FOR i := 1 UPTO n - 1
            uLen := 0
            VoDbFieldInfo(DBS_LEN, i, REF uLen)
            nOffset += uLen
        NEXT
        uLen := 0
        VoDbFieldInfo(DBS_LEN, n, REF uLen)
        nEnd := uLen + nOffSet -1

        FOR i := nOffset UPTO nEnd
            IF aRecord[i] != 32
                lRet := FALSE
                EXIT
            ENDIF
        NEXT
    ELSE
        lRet := FALSE
    ENDIF
   RETURN lRet

//
// 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.
//
// internal functions used by FieldBlock and FieldWBlock

USING XSharp.Rdd.Support
USING XSharp.Rdd
USING System.Linq
USING System.Collections.Generic

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/select/*" />
FUNCTION Select(uWorkArea) AS USUAL CLIPPER
    LOCAL sSelect   AS DWORD
	LOCAL sCurrent  AS DWORD
	sCurrent := VODBGetSelect()
	sSelect := _SELECT(uWorkArea)
	VODBSetSelect(INT(sCurrent))
	RETURN sSelect

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/select/*" />
FUNCTION _SelectString(uWorkArea AS STRING) AS DWORD
    LOCAL nSelect := 0 AS DWORD
    uWorkArea := AllTrim(uWorkArea)
    IF SLen(uWorkArea) = 1
        nSelect := Val(uWorkArea)
		VAR nAsc := Asc( Upper(uWorkArea) )
		IF nAsc > 64 .AND. nAsc < 75
			nSelect := nAsc - 64
		ENDIF
    ENDIF

    IF nSelect > 0 .OR. "0" == uWorkArea
        nSelect := VoDb.SetSelect((INT) nSelect)
    ELSE
        nSelect := (DWORD) VoDb.SymSelect(uWorkArea)
    ENDIF
    RETURN nSelect

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/select/*" />
FUNCTION _Select(uWorkArea) AS USUAL CLIPPER
    LOCAL nSelect           AS DWORD
    LOCAL xType             AS DWORD

    IF uWorkArea:IsNil
        RETURN  (INT) VoDb.GetSelect()
    ENDIF
    xType := UsualType(uWorkArea)
    SWITCH xType
    CASE SYMBOL
        nSelect := (DWORD) VoDb.SymSelect((SYMBOL) uWorkArea)
    CASE STRING
        nSelect := _SelectString(uWorkArea)
    CASE LONG
    CASE FLOAT
        nSelect := VoDb.SetSelect(uWorkArea)
    OTHERWISE
        nSelect := 0
    END SWITCH
    RETURN nSelect

/// <exclude/>
FUNCTION __FieldGetNum( fieldpos AS DWORD ) AS USUAL
    LOCAL ret := NIL AS USUAL
    VoDb.FieldGet( fieldpos, REF ret )
    RETURN ret

/// <exclude/>
FUNCTION __FieldGetWaNum( workarea AS DWORD, fieldpos AS DWORD ) AS USUAL
    LOCAL ret := NIL AS USUAL
    LOCAL curArea AS DWORD
    curArea := RuntimeState.CurrentWorkarea
    TRY
        RuntimeState.CurrentWorkarea := workarea
        VoDb.FieldGet( fieldpos, REF ret )
    FINALLY
        RuntimeState.CurrentWorkarea := curArea
    END TRY
    RETURN ret

/// <exclude/>
FUNCTION __FieldSetNum( fieldpos AS DWORD, uValue AS USUAL ) AS USUAL
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldPut( fieldpos, uValue ))

/// <exclude/>
FUNCTION __FieldSetWaNum( nArea AS DWORD, fieldpos AS DWORD, uValue AS USUAL ) AS USUAL
    LOCAL curArea AS DWORD
    curArea := RuntimeState.CurrentWorkarea
    TRY
        RuntimeState.CurrentWorkarea := nArea
        _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldPut( fieldpos, uValue ) )
    FINALLY
        RuntimeState.CurrentWorkarea := curArea
    END TRY
    RETURN uValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldblock/*" />
FUNCTION FieldBlock(cFieldName AS STRING) AS CODEBLOCK
    LOCAL oCB  := NULL AS CODEBLOCK
    LOCAL nPos := 0    AS DWORD
    IF ! String.IsNullOrEmpty(cFieldName)
        nPos := FieldPos(cFieldName)
        IF nPos != 0
            //oCB := MCompile("{|x| iif( IsNil(x), __FieldGetNum( "+nPos:ToString()+"), __FieldSetNum( "+nPos:ToString()+" , x)")
            oCb := {|x| IIF(x:IsNil, __FieldGetNum(nPos), __FieldSetNum(nPos, x))}
        ENDIF
    ENDIF
    RETURN oCB

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldblocksym/*" />
FUNCTION FieldBlockSym(symFieldName AS SYMBOL) AS CODEBLOCK
    RETURN FieldBlock(symFieldName)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldwblock/*" />
FUNCTION FieldWBlock(cFieldName AS STRING,dwWorkArea AS USUAL) AS CODEBLOCK
    RETURN {|x| IIF( x:IsNil, __FieldGetWa(dwWorkArea, cFieldName), __FieldSetWa(dwWorkArea, cFieldName, x)) }

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldwblocksym/*" />
FUNCTION FieldWBlockSym(symFieldname AS SYMBOL,dwWorkArea AS DWORD) AS CODEBLOCK
    RETURN FieldWBlock(symFieldname, dwWorkArea)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldgetalias/*" />
FUNCTION FieldGetAlias(symAlias AS SYMBOL,symFieldName AS SYMBOL) AS USUAL
    RETURN fieldGetSelect(symAlias, symFieldName)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldgetalias/*" />
FUNCTION FieldGetSelect(symAlias AS USUAL,symFieldName AS SYMBOL) AS USUAL
    LOCAL nArea := RuntimeState.CurrentWorkArea AS DWORD
    LOCAL uValue AS USUAL
    DbSelectArea(symAlias)
    uValue := FieldGetSym(symFieldName)
    VoDb.SetSelect((INT) nArea)
    RETURN uValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldgetsym/*" />
FUNCTION FieldGetSym(symField AS SYMBOL) AS USUAL
    LOCAL dwPos AS DWORD
    dwPos := FieldPosSym(symField)
    IF dwPos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME,  <OBJECT>{symField}  )
    ENDIF
    RETURN FieldGet( dwPos )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldpossym/*" />
FUNCTION FieldPosSym(sFieldName AS SYMBOL) AS DWORD
    RETURN FieldPos( (STRING) sFieldName )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldputalias/*" />
FUNCTION FieldPutAlias(symAlias AS SYMBOL,symField AS SYMBOL,uNewValue AS USUAL) AS USUAL
    RETURN FieldPutSelect(symAlias, symField, uNewValue)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldputsym/*" />
FUNCTION FieldPutSym(symField AS SYMBOL,uNewValue AS USUAL) AS USUAL
    LOCAL dwPos AS DWORD
    dwPos := FieldPosSym(symField)
    IF dwPos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME,  <OBJECT>{symField}  )
    ENDIF
    RETURN FieldPut( dwPos ,uNewValue )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldputselect/*" />
FUNCTION FieldPutSelect(symAlias AS USUAL,symField AS SYMBOL,uNewValue AS USUAL) AS USUAL
    LOCAL nArea AS DWORD
    nArea := SELECT(symAlias )
    RETURN FieldPutArea(nArea, symField, uNewValue)

    *----------------------------------------------------------------------------

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/alias/*" />
FUNCTION Alias(uWorkArea) AS STRING CLIPPER
    IF uWorkArea:IsNil
        RETURN Alias0()
    ENDIF
    IF IsNumeric(uWorkArea)
        RETURN VoDb.Alias(uWorkArea)
    ENDIF
    RETURN (uWorkArea)->Alias()

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/alias0sym/*" />
FUNCTION Alias0Sym() AS SYMBOL
    RETURN (SYMBOL) Alias0()

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbappend/*" />
FUNCTION DbAppend(lReleaseLocks) AS LOGIC CLIPPER
    LOCAL lRetCode  AS LOGIC

    IF lReleaseLocks:IsNil
        lReleaseLocks := .T.
    ENDIF

    lRetCode := VoDb.Append(lReleaseLocks)

    IF !lRetCode
        //    No Error but NetErr gets set for compatibility reasons
        //    lRetCode := DoError("DbAppend")
        NetErr(.T.)
    ENDIF

    RETURN lRetCode

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbclearindex/*" />
FUNCTION DbClearIndex(uOrder, cIndexFile) AS LOGIC CLIPPER
    RETURN OrdListClear(cIndexFile, uOrder)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcreate/*" />
FUNCTION DbCreate (   cTargetFile,  aStruct, cDriver , lNew,  cAlias, cDelim, lOpen, acRDDs ) AS LOGIC CLIPPER
    LOCAL lKeep           AS LOGIC
    LOCAL lRetCode        AS LOGIC

    IF aStruct == NIL
        aStruct := {}
    ENDIF

    IF ! aStruct:IsArray
        RETURN .F.
    ENDIF

    //
    // Get "lNew" and create "lKeep" for VODBUseArea()
    // by Clipper's logic:
    //
    //      .T. -   to open in first available workarea
    //      .F. -   to open in current workarea
    //      NIL -   to close file after creating
    //

    IF lNew == NIL
        lNew    := .T.
        lKeep   := .F.
    ELSE
        lKeep   := .T.
    ENDIF

    IF lOpen == NIL
        lOpen := .F.
    ENDIF

    LOCAL oDriver := cDriver AS OBJECT
    IF oDriver == NULL_OBJECT
        oDriver := RuntimeState.DefaultRDD
    ENDIF
    IF oDriver IS STRING
        lRetCode := VoDbCreate(cTargetFile, aStruct, (STRING) oDriver, lNew, cAlias, cDelim, lKeep, lOpen)
    ELSEIF oDriver IS System.Type
        lRetCode := VoDbCreate(cTargetFile, aStruct, (Type) oDriver, lNew, cAlias, cDelim, lKeep, lOpen )
    ELSE
        THROW Error.DataTypeError( __FUNCTION__, nameof(cDriver ), 3, { cDriver  } )
    ENDIF
    IF ! lRetCode .AND. RuntimeState.LastRDDError != NULL
        THROW RuntimeState.LastRDDError
    ENDIF
    RETURN lRetCode

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcreateindex/*" />
FUNCTION DbCreateIndex(cIndexFile, cKeyValue, cbKeyValue, lUnique) AS LOGIC CLIPPER
    RETURN OrdCreate(cIndexFile, NIL, cKeyValue, cbKeyValue, lUnique)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcreateorder/*" />
FUNCTION DbCreateOrder  (cOrder, cIndexFile, cKeyValue, cbKeyValue, lUnique) AS LOGIC CLIPPER
    RETURN OrdCreate(cIndexFile, cOrder, cKeyValue, cbKeyValue, lUnique)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbdelete/*" />
FUNCTION DbDelete () AS LOGIC STRICT
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Delete() )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbdeleteorder/*" />
FUNCTION DbDeleteOrder(uOrder, cIndexFile) AS LOGIC CLIPPER
    IF uOrder:IsNumeric
        VoDb.OrderInfo(DBOI_NAME,"",uOrder, REF uOrder)
    ENDIF

    RETURN OrdDestroy(uOrder, cIndexFile)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbeval/*" />
FUNCTION DbEval(cbExecute, cbForCondition, cbWhileCondition, nNext, nRecord, lRest) AS LOGIC CLIPPER
    IF lRest:IsNil
        lRest := .F.
    ENDIF
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Eval(VoDb.ValidBlock(cbExecute), VoDb.ValidBlock(cbForCondition), VoDb.ValidBlock(cbWhileCondition), nNext, nRecord, lRest) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbfieldinfo/*" />
FUNCTION DbFieldInfo(kInfoType, nFieldPos, uNewSetting) AS USUAL CLIPPER
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldInfo(kInfoType, nFieldPos, REF uNewSetting))
    RETURN uNewSetting

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbgoto/*" />
FUNCTION DbGoto(uRecID AS USUAL) AS LOGIC
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Goto(uRecId) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbgoto/*" />
FUNCTION DbGoto(uRecID AS USUAL, uArea AS USUAL) AS LOGIC
    RETURN (uArea)->(DbGoto(uRecID))

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbinfo/*" />
FUNCTION DbInfo(kInfoType, uNewSetting) AS USUAL CLIPPER
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Info(kInfoType, REF uNewSetting))
    IF kInfoType == DBI_GETLOCKARRAY .AND. ((OBJECT) uNewSetting) IS INT[]
        LOCAL aLocks AS INT[]
        LOCAL aResult AS ARRAY
        aLocks := (INT[]) uNewSetting
        aResult := ArrayNew()
        FOREACH VAR iLock IN aLocks
            aResult:Add(iLock)
        NEXT
        uNewSetting := aResult
    ENDIF
    RETURN uNewSetting

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dblocate/*" />
FUNCTION DbLocate(cbForCondition, cbWhileCondition, nNext, nRecord, lRest ) AS LOGIC CLIPPER

    LOCAL lRetCode  AS LOGIC

    IF lRest:IsNil
        lRest := .F.
    ENDIF

    IF cbWhileCondition:IsNil
        cbWhileCondition := {|| .T. }
    ELSE
        lRest := .T.
    ENDIF

    IF nNext:IsNil
        nNext := 0
    ENDIF
    lRetCode := _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Locate(VoDb.ValidBlock(cbForCondition), VoDb.ValidBlock(cbWhileCondition), nNext, nRecord, lRest))
    IF lRetCode
        lRetCode := VoDb.Found()
    ENDIF

    RETURN lRetCode

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dborderinfo/*" />
/// <seealso cref='T:XSharp.RDD.Enums.DbOrder_Info'>DbOrder_Info ENUM</seealso>
FUNCTION DbOrderInfo(kInfoType,cIndexFile, uOrder, uNewSetting) AS USUAL CLIPPER
    LOCAL lKeyVal  := FALSE  AS LOGIC

    IF !cIndexFile:IsString
        cIndexFile := ""
    ENDIF

    IF uOrder:IsString
        IF SLen(uOrder) == 0
            uOrder := NIL
        ENDIF
    ENDIF

    IF kInfoType == DBOI_KEYVAL
        lKeyVal  := .T.
        kInfoType := DBOI_EXPRESSION
    ENDIF
    VoDb.OrderInfo(kInfoType, cIndexFile, uOrder, REF uNewSetting)
    IF lKeyVal
        IF uNewSetting:IsString
            IF SLen(uNewSetting) == 0
                uNewSetting := NIL
            ELSE
                uNewSetting := &(uNewSetting)
            ENDIF
        ENDIF
    ENDIF

    RETURN uNewSetting

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrecordinfo/*" />
/// <seealso cref='T:XSharp.RDD.Enums.DbRecordInfo'>DbRecordInfo ENUM</seealso>
FUNCTION DbRecordInfo(kInfoType, uRecId, uNewValue) AS USUAL CLIPPER
    VoDb.RecordInfo(kInfoType, uRecId, REF uNewValue)
    RETURN uNewValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrlock/*" />
FUNCTION DbRLock(uRecId) AS USUAL CLIPPER
    RETURN VoDb.Rlock(uRecId)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrlocklist/*" />
FUNCTION DbRLockList() AS ARRAY STRICT

    LOCAL aLockList := {}   AS ARRAY
    LOCAL uRecords  := NIL AS USUAL

    IF _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Info(DBI_LOCKCOUNT, REF uRecords))
        aLockList := DbInfo(DBI_GETLOCKARRAY)
    ENDIF

    RETURN aLockList

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrselect/*" />
FUNCTION DbRSelect(nRelation) AS DWORD CLIPPER

    DEFAULT( REF nRelation, 0)

    RETURN VoDb.RSelect(nRelation)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrunlock/*" />
FUNCTION DbRUnLock(uRecID) AS LOGIC CLIPPER
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Unlock(uRecId) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbselect/*" />
FUNCTION DbSelect(nNew) AS DWORD CLIPPER

    LOCAL nOld := 0 AS DWORD

    DEFAULT( REF nNew, 0)

    VoDb.Select(nNew, REF nOld)

    RETURN nOld

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbselectarea/*" />
FUNCTION DbSelectArea(uArea) AS LOGIC CLIPPER
    LOCAL sSelect   AS SHORT
    sSelect := _SELECT(uArea)
    _DbThrowErrorOnFailure(__FUNCTION__, sSelect != 0)
    RETURN (sSelect > 0)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsetselect/*" />
FUNCTION DbSetSelect(nNewArea) AS DWORD CLIPPER

    DEFAULT( REF  nNewArea, 0)

    RETURN (DWORD) VoDb.SetSelect(nNewArea)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsymselect/*" />
FUNCTION DbSymSelect(symAlias)  AS DWORD CLIPPER
    IF symAlias:IsNil
        symAlias := Alias0Sym()
    ENDIF
    EnForceType(symAlias, SYMBOL)
    RETURN (DWORD) VoDb.SymSelect(symAlias)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbrelation/*" />
FUNCTION DbRelation(nRelation)  AS STRING CLIPPER
    LOCAL cRelText  := "" AS STRING
    DEFAULT(  REF nRelation, 1)
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Relation(nRelation, REF cRelText))
    RETURN cRelText

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsetdriver/*" />
FUNCTION DbSetDriver(cNewSetting) AS STRING CLIPPER
    IF cNewSetting:IsString
        RETURN RddSetDefault(cNewSetting)
    ENDIF
    RETURN RddSetDefault()

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsetfilter/*" />
FUNCTION DbSetFilter(cbCondition, cCondition) AS LOGIC CLIPPER
    LOCAL sCondition AS STRING
    LOCAL cbCond AS CODEBLOCK
    if PCount() == 0 .or. (cbCondition:IsNil .and. cCondition:IsNil)
        return DbClearFilter()
    endif
    // Only one parameter passed and it is a string
    // Move it to the second parameter and clear the first parameter
    IF cbCondition:IsString .and. PCount() == 1
        cCondition  := cbCondition
        cbCondition := NIL
    endif
    // Create Compiled codeblock from String
    IF cbCondition:IsNil
        EnForceType(cCondition, STRING)
        sCondition := cCondition
        sCondition := sCondition:Trim()
        if !sCondition:StartsWith("{||")
            cbCondition := &("{||"+scondition+"}")
        else
            cbCondition := &(cCondition)
        endif
    ENDIF
    // Todo : Extract the string from compiled codeblocks
    if cCondition:IsNil
        local oBlock as Object
        EnForceType(cbCondition, CODEBLOCK)
        oBlock := cbCondition
        // When the codeblock is a macro compiled codeblock
        if oBlock IS XSharp._Codeblock VAR cbMacro
            sCondition := cbMacro:ToString():Trim()
            if sCondition:StartsWith("{||") .and. sCondition:EndsWith("}")
                sCondition := sCondition:Substring(3, sCondition:Length-4):Trim()
            endif
            cCondition := sCondition
        else
            cCondition := "UNKNOWN"
        endif
    ENDIF
    IF cbCondition:IsCodeBlock
        cbCond := cbCondition
    ELSE
        cbCond := NULL
    ENDIF
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.SetFilter(cbCond, cCondition) )

    *----------------------------------------------------------------------------
/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbsetrelation/*" />
/// <param name="cName">An optional name for the relation. Defaults to ParentName + "_" + ChildName.</param>
FUNCTION DbSetRelation  (xAlias, cbKey, cKey, cName) AS LOGIC CLIPPER

    LOCAL nSelect   AS DWORD
    LOCAL cAlias    AS STRING
    LOCAL cbRelation AS CODEBLOCK
    DEFAULT(REF cName, "")

    IF xAlias:IsString
        nSelect := Val(xAlias)

        IF nSelect = 0
            cAlias := xAlias
        ELSE
            cAlias := ALIAS(nSelect)
        ENDIF

    ELSE
        cAlias := ALIAS(xAlias)
    ENDIF
    IF cbKey:IsCodeBlock
        cbRelation := cbKey
    ELSE
        cbRelation := NULL
    ENDIF
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.SetRelation(cAlias, cbRelation, cKey, cName) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbskip/*" />
FUNCTION DbSkip (nRecords) AS LOGIC CLIPPER
    IF nRecords:IsNil
        nRecords := 1
    ENDIF
    RETURN _DbThrowErrorOnFailure(__FUNCTION__, VoDb.Skip(nRecords) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbusearea/*" />
FUNCTION DbUseArea (lNewArea, cDriver, cDataFile, cAlias, lShared, lReadOnly, aStruct, cDelim,acRDDs ) AS LOGIC CLIPPER
    LOCAL lRetCode        AS LOGIC
    LOCAL rddList         AS _RddList
    LOCAL nTries          AS LONG
    LOCAL aRdds           AS ARRAY

    DEFAULT( REF lNewArea, .F.)
    DEFAULT( REF cAlias, "")
    DEFAULT( REF lShared, !SetExclusive())
    DEFAULT( REF lReadOnly, .F.)
    DEFAULT( REF cDelim, "")
    nTries := 1
    aRdds   := VoDb.RDDList(cDriver, acRDDs)
    rddList := VoDb.AllocRddList(aRdds)
    DO WHILE .T.

        IF !Empty(aStruct)
            lRetCode := DbCreate ( cDataFile, aStruct, aRdds, lNewArea,cAlias, cDelim, .T.)
        ELSE
            lRetCode := VoDb.UseArea(lNewArea, rddList, cDataFile, cAlias, lShared, lReadOnly)
        ENDIF
        IF lRetCode
            EXIT
        ELSE
            IF ( (INT) DoError(__FUNCTION__, nTries) != E_RETRY )
                EXIT
            ENDIF
            nTries := nTries + 1
        ENDIF
    ENDDO
    RETURN lRetCode

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldput/*" />
FUNCTION FieldPut (nFieldPos AS USUAL, uNewValue  AS USUAL) AS USUAL
    LOCAL lResult AS LOGIC
    IF ! IsNumeric(nFieldPos)
        THROW Error.ArgumentError( __FUNCTION__, nameof(nFieldPos), __CavoStr(VoErrors.ARGNOTNUMERIC), 1 ,<OBJECT>{nFieldPos,uNewValue})
    ENDIF
    lResult  := VoDb.FieldPut(nFieldPos, uNewValue)
    IF ! lResult
        IF RuntimeState.Dialect == XSharpDialect.XPP
            uNewValue := NIL
        ELSE
            DoError(__FUNCTION__)
        ENDIF
    ENDIF
    RETURN uNewValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldget/*" />
FUNCTION FieldGet(nFieldPos) AS USUAL CLIPPER
    LOCAL xRetVal := NIL AS USUAL
    LOCAL lResult AS LOGIC
    IF ! IsNumeric(nFieldPos)
        THROW Error.ArgumentError(__FUNCTION__, nameof(nFieldPos), __CavoStr(VoErrors.ARGNOTNUMERIC), 1 ,<OBJECT> {nFieldPos})
    ENDIF
    lResult  := VoDb.FieldGet(nFieldPos, REF xRetVal)
    IF ! lResult
        IF RuntimeState.Dialect == XSharpDialect.XPP
            xRetVal := NIL
        ELSE
            DoError(__FUNCTION__)
        ENDIF
    ENDIF
    RETURN xRetVal

/// <summary>Read an array of bytes direct from the workarea buffer.</summary>
/// <remarks>This will only work for DBF based workareas (not for Advantage workareas)</remarks>
FUNCTION FieldGetBytes(nPos ) AS BYTE[] CLIPPER
    LOCAL bRetVal := NULL AS BYTE[]
    IF ! IsNumeric(nPos)
        THROW Error.ArgumentError(__FUNCTION__, nameof(nPos), __CavoStr(VoErrors.ARGNOTNUMERIC), 1 ,<OBJECT> {nPos})
    ENDIF
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldGetBytes(nPos, REF bRetVal))
    RETURN bRetVal

/// <summary>Write an array of bytes direct to the workarea buffer.</summary>
/// <remarks>This will only work for DBF based workareas (not for Advantage workareas)</remarks>
FUNCTION FieldPutBytes(nPos AS USUAL, aBytes AS BYTE[]) AS LOGIC
    IF ! IsNumeric(nPos)
        THROW Error.ArgumentError(__FUNCTION__, nameof(nPos), __CavoStr(VoErrors.ARGNOTNUMERIC), 1 ,<OBJECT> {nPos,aBytes})
    ENDIF
    _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldPutBytes(nPos, aBytes))
    RETURN TRUE

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldgetarea/*" />
FUNCTION FieldGetArea(dwWorkArea AS DWORD, symFieldName AS SYMBOL) AS USUAL
    LOCAL oldArea := VoDbGetSelect() AS DWORD
    LOCAL result := NIL  AS USUAL
    LOCAL dwPos AS DWORD
    TRY
        VoDbSetSelect( (INT) dwWorkArea)
        dwPos := FieldPosSym(symFieldName)
        IF dwPos == 0
           VoDbSetSelect( (INT) oldArea)
           THROW Error.VODBError(EG_ARG, EDB_FIELDNAME, __FUNCTION__, <OBJECT>{symFieldName})
        ELSE
            VODBFieldGet( dwPos, REF result )
        ENDIF
    FINALLY
        VoDbSetSelect( (INT) oldArea)
    END TRY
    RETURN result

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/fieldputarea/*" />
FUNCTION FieldPutArea(dwWorkArea AS DWORD, symField AS SYMBOL, uNewValue AS USUAL) AS USUAL
    LOCAL oldArea := VoDbGetSelect() AS DWORD
    LOCAL dwPos AS DWORD
    TRY
        VoDbSetSelect( (INT) dwWorkArea)
        dwPos := FieldPosSym(symField)
        IF dwPos == 0
           VoDbSetSelect( (INT) oldArea)
           THROW Error.VODBError(EG_ARG, EDB_FIELDNAME, __FUNCTION__, <OBJECT>{symField})
        ELSE
            VODBFieldPut( dwPos, uNewValue)
        ENDIF
    FINALLY
        VoDbSetSelect( (INT) oldArea)
    END TRY
    RETURN uNewValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/lupdate/*" />
FUNCTION LUpdate()  AS DATE STRICT
    RETURN DbInfo(DBI_LASTUPDATE)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/lupdate/*" />
FUNCTION LUpdate(uArea AS USUAL)  AS DATE STRICT
    RETURN (uArea)->(LUpdate())

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rddcount/*" />
FUNCTION RddCount() AS DWORD CLIPPER
    RETURN VoDb.RddCount()

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rddinfo/*" />
FUNCTION RddInfo(kInfoType, uNewSetting) AS USUAL CLIPPER
    VoDb.RDDInfo(kInfoType, REF uNewSetting)
    RETURN uNewSetting

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rddlist/*" />
FUNCTION RddList () AS ARRAY CLIPPER
    LOCAL aRddList := {}    AS ARRAY
    IF VoDb.RddCount() > 0
        VAR aNames := VoDb.RddList()
        FOREACH name AS STRING IN aNames
            AAdd( aRddList, name)
        NEXT
    ENDIF
    RETURN aRddList

 /// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbmemoext/*" />
FUNCTION DbMemoExt      (cDriver) AS STRING CLIPPER
    RETURN VoDb.MemoExt(cDriver)

FUNCTION RddVersion     (nParm) AS USUAL CLIPPER
    IF !nParm:IsNumeric
        nParm := 0
    ENDIF
    RETURN DbInfo(DBI_RDD_VERSION, nParm)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbmemofield/*" />
FUNCTION DbMemoField (uField AS USUAL)  AS USUAL
    LOCAL n,i        AS DWORD
    LOCAL xRet       AS USUAL
    LOCAL nFields    AS DWORD

    IF uField:IsNumeric
        n := uField
    ELSEIF uField:IsSymbol
        n := FieldPosSym(uField)
    ELSEIF uField:IsString
        n := FieldPos(uField)
    ELSE
        nFields := FCount()
        n := 0
        FOR i := 1 TO nFields
            IF DbFieldInfo(i, DBS_TYPE) == "M"
                n := i
                EXIT
            ENDIF
        NEXT
    ENDIF

    xRet := DbInfo( DBI_MEMOFIELD, n )

    RETURN xRet

/// <exclude/>
FUNCTION _DbCreate(cFile1, cFile2, cDriver,lNew, cAlias)      AS LOGIC CLIPPER

    LOCAL aStruct       AS ARRAY
    LOCAL i,n           AS INT
    LOCAL nSelect       AS INT
    LOCAL aField        AS ARRAY

    FIELD field_name, field_type, field_len, field_dec

    nSelect := 0

    DEFAULT( REF lNew, .F.)

    IF ( Used() .AND. !lNew )
        VoDb.CloseArea()
    ENDIF

    TRY
        IF ( Empty(cFile2) )
            DbCreate(cFile1,                ;
            { {"FIELD_NAME", "C", 10, 0},   ;
            {"FIELD_TYPE", "C", 1, 0},      ;
            {"FIELD_LEN", "N", 3, 0},       ;
            {"FIELD_DEC", "N", 3, 0} },     ;
            cDriver,                        ;
            .F.,                            ;
            cAlias)
        ELSE
            DbUseArea(lNew, cDriver, cFile2)
            aStruct := {}
            n := VoDb.LastRec()
            VoDb.GoTop()
            DO WHILE !VoDb.EOF()
                aField := ArrayNew(4)
                aField[DBS_NAME] := AllTrim(fieldGet(1))
                aField[DBS_TYPE] := AllTrim(fieldGet(2))
                aField[DBS_LEN ] := fieldGet(3)
                aField[DBS_DEC ] := fieldGet(4)
                AAdd( aStruct, aField )
                VoDb.Skip(1)
            ENDDO

            VoDb.CloseArea()

            IF lNew
                VoDb.SetSelect(nSelect)
            ENDIF

            FOR i := 1 TO n
                aField := aStruct[i]
                IF aField[ DBS_TYPE] == "C" .AND. aField[DBS_DEC] != 0
                    aField[DBS_LEN] += aField[DBS_DEC] * 256
                ENDIF
            NEXT
            DbCreate(cFile1, aStruct, cDriver, lNew, cAlias )
        ENDIF

    CATCH e AS RddError
        VoDb.CloseArea()
        e:FuncSym := __FUNCTION__
        THROW e
    END TRY

    RETURN ( Used() )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/afields/*" />
FUNCTION AFields(acFieldNames, acTypes, anWidths, anDecimals)  AS DWORD CLIPPER
    LOCAL aStruct           AS ARRAY
    LOCAL siCount           AS DWORD
    LOCAL si                AS DWORD
    LOCAL lNamesOk  := .F.  AS LOGIC
    LOCAL lTypesOk  := .F.  AS LOGIC
    LOCAL lLensOk   := .F.  AS LOGIC
    LOCAL lDecsOk   := .F.  AS LOGIC
    aStruct := DbStruct()
    IF (Empty(aStruct))
        RETURN (0)
    ENDIF

    siCount := ALen(aStruct)

    IF UsualType(acFieldNames) == ARRAY
        siCount := Min(siCount, Len(acFieldNames) )
        lNamesOk := .T.
    ENDIF

    IF UsualType(acTypes) == ARRAY
        siCount := Min( siCount, Len(acTypes) )
        lTypesOk := .T.
    ENDIF

    IF UsualType(anWidths) == ARRAY
        siCount := Min( siCount, Len(anWidths) )
        lLensOk := .T.
    ENDIF

    IF UsualType(anDecimals) == ARRAY
        siCount := Min( siCount, Len(anDecimals) )
        lDecsOk := .T.
    ENDIF

    FOR si := 1 TO siCount

        IF lNamesOk
            acFieldNames[si] := aStruct[si, DBS_NAME]
        ENDIF

        IF lTypesOk
            acTypes[si] := aStruct[si, DBS_TYPE]
        ENDIF

        IF lLensOk
            anWidths[si]  := aStruct[si, DBS_LEN]
        ENDIF

        IF lDecsOk
            anDecimals[si]  := aStruct[si, DBS_DEC]
        ENDIF

    NEXT

    RETURN siCount

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcopystruct/*" />
FUNCTION DbCopyStruct(cTargetFile AS STRING, acStruct := NULL_ARRAY AS ARRAY) AS LOGIC STRICT
    RETURN DBCREATE(cTargetFile, VoDb.FieldList(DbStruct(), acStruct, NULL_ARRAY) )

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbcopyxstruct/*" />
FUNCTION DbCopyXStruct(cTargetFile AS STRING) AS LOGIC STRICT
    LOCAL siSaveSel,n,i AS DWORD
    LOCAL aStruct       AS ARRAY
    LOCAL lRetCode  := FALSE AS LOGIC

    FIELD field_name, field_type, field_len, field_dec

    TRY
        IF !Used()
            THROW VoDb.DBCMDError(__FUNCTION__)
        ENDIF

        aStruct := DbStruct()

        n := Len(aStruct)
        siSaveSel := 0
        VoDb.Select(0, REF siSaveSel)

        _DbCreate(cTargetFile)

        FOR i := 1 TO n

            IF aStruct[i, DBS_TYPE] == "C" .AND. aStruct[i, DBS_LEN] > 255
                aStruct[i, DBS_DEC] := SHORT(aStruct[i, DBS_LEN] / 256)
                aStruct[i, DBS_LEN] := aStruct[i, DBS_LEN] % 256
            ENDIF

            lRetCode := DBAPPEND()

            FieldPutSym(#field_name ,aStruct[i, DBS_NAME])
            FieldPutSym(#field_type ,aStruct[i, DBS_TYPE])
            FieldPutSym(#field_len  ,aStruct[i, DBS_LEN])
            FieldPutSym(#field_dec  , aStruct[i, DBS_DEC])

        NEXT

        IF (VoDb.GetSelect() <> siSaveSel)
            DbCloseArea()
            VoDb.SetSelect(INT(siSaveSel))
        ENDIF

    CATCH e AS RddError
        e:FuncSym := __FUNCTION__
        THROW e
    END TRY

    RETURN (lRetCode)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbstruct/*" />
FUNCTION DbStruct() AS ARRAY PASCAL

    LOCAL aStruct   AS ARRAY
    LOCAL nFCount   AS DWORD
    LOCAL nProps    AS DWORD
    LOCAL i,j       AS DWORD
    LOCAL aField    AS ARRAY

    aStruct := {}
    nFCount := FCount()

    IF !Used()
        THROW VoDb.DbCmdError(__FUNCTION__)
    ELSE
        FOR i := 1 UPTO nFCount
            aField := {}

            LOCAL xNewVal := NIL AS USUAL
            _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldInfo(DBS_PROPERTIES, i, REF xNewVal))
            nProps:= (DWORD)  xNewVal
            FOR j := 1 UPTO nProps
                _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldInfo(j, i, REF xNewVal))
                AAdd(aField, xNewVal)
            NEXT

            AAdd(aStruct, aField)

        NEXT
    ENDIF

    RETURN aStruct

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dbstruct/*" />
FUNCTION DbStruct(uArea AS USUAL) AS ARRAY PASCAL
    RETURN (uArea)->(DbStruct())

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/indexhplock/*" />
FUNCTION IndexHPLock(lNewSetting AS USUAL) AS LOGIC
    LOCAL lOld AS LOGIC
    lOld := RuntimeState.HPLocking
    IF lNewSetting:IsLogic
        RuntimeState.HPLocking := (LOGIC) lNewSetting
    ENDIF
    RETURN lOld

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/newindexlock/*" />
FUNCTION NewIndexLock(lNewSetting AS USUAL) AS LOGIC
    LOCAL lOld AS LOGIC
    lOld := RuntimeState.NewIndexLock
    IF lNewSetting:IsLogic
        RuntimeState.NewIndexLock := (LOGIC) lNewSetting
    ENDIF
    RETURN lOld

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/newlocks/*" />
FUNCTION NewLocks() AS LOGIC
    RETURN RuntimeState.NewIndexLock

/// <exclude />
FUNCTION __RDDList(cRddName AS STRING) AS ARRAY
    RETURN VoDb.RDDList(cRddName, {})
/// <exclude />
FUNCTION __RDDList(cRddName AS STRING, aHidden AS ARRAY) AS ARRAY
    RETURN VoDb.RDDList(cRddName, aHidden)

/// <exclude />
FUNCTION _AllocFieldNames(aStruct AS ARRAY) AS _FieldNames
    RETURN VoDb.AllocFieldNames(aStruct)

/// <exclude />
FUNCTION _FreeFieldNames(aNames AS _FieldNames) AS VOID
    RETURN

/// <exclude />
FUNCTION __allocNames(aStruct AS ARRAY) AS _FieldNames
    RETURN VoDb.AllocFieldNames(aStruct)

/// <exclude />
FUNCTION __TargetFields(cAlias AS STRING, aFields AS ARRAY, list OUT _JoinList ) AS ARRAY
    RETURN VoDb.TargetFields(cAlias, aFields, OUT list)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/emptyrecord/*" />
FUNCTION EmptyRecord() AS LOGIC
   LOCAL lRet    AS LOGIC
   LOCAL aRecord AS BYTE[]

   IF Used()
      aRecord := VODBRecordGet()
      lRet := TRUE
      FOREACH VAR b IN aRecord
         IF b != 32
            lRet := FALSE
            EXIT
         ENDIF
      NEXT
   ELSE
        lRet := FALSE
   ENDIF
   RETURN lRet

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/emptyfield/*" />
FUNCTION EmptyField( n AS DWORD ) AS LOGIC
   LOCAL aRecord AS BYTE[]
   LOCAL i       AS DWORD
   LOCAL lRet    AS LOGIC
   LOCAL nOffset AS DWORD
   LOCAL nEnd    AS DWORD
   LOCAL uLen AS USUAL
   IF Used() .AND. n > 0 .AND. n <= FCount()
        lRet := TRUE
        aRecord := VODBRecordGet()
        nOffset := 2        // skip the Deleted flag
        FOR i := 1 UPTO n - 1
            uLen := 0
            VoDbFieldInfo(DBS_LEN, i, REF uLen)
            nOffset += uLen
        NEXT
        uLen := 0
        VoDbFieldInfo(DBS_LEN, n, REF uLen)
        nEnd := uLen + nOffSet -1

        FOR i := nOffset UPTO nEnd
            IF aRecord[i] != 32
                lRet := FALSE
                EXIT
            ENDIF
        NEXT
    ELSE
        lRet := FALSE
    ENDIF
   RETURN lRet


QtScriptTools: data for code generation added

Added:
codegen/QtScriptTools
codegen/QtScriptTools/QScriptEngineDebugger.prg

/*

  Qt4xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 4

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
REQUEST QACTION
REQUEST QMENU
REQUEST QTOOLBAR
REQUEST QMAINWINDOW
REQUEST QWIDGET
#endif

CLASS QScriptEngineDebugger INHERIT QObject

   DATA self_destruction INIT .F.

   METHOD new
   METHOD delete
   METHOD action
   METHOD attachTo
   METHOD autoShowStandardWindow
   METHOD createStandardMenu
   METHOD createStandardToolBar
   METHOD detach
   METHOD setAutoShowStandardWindow
   METHOD standardWindow
   METHOD state
   METHOD widget
   METHOD onEvaluationResumed
   METHOD onEvaluationSuspended
   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QScriptEngineDebugger
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <QScriptEngineDebugger>

#include "qt4xhb_common.h"
#include "qt4xhb_macros.h"
#include "qt4xhb_utils.h"

/*
QScriptEngineDebugger ( QObject * parent = 0 )
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_NEW )
{
  QScriptEngineDebugger * o = new QScriptEngineDebugger ( OPQOBJECT(1,0) );
  _qt4xhb_storePointerAndFlag ( o, false );
}

HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_DELETE )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
QAction * action ( DebuggerAction action ) const
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_ACTION )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QAction * ptr = obj->action ( (QScriptEngineDebugger::DebuggerAction) hb_parni(1) );
    _qt4xhb_createReturnClass ( ptr, "QACTION" );
  }
}

/*
void attachTo ( QScriptEngine * engine )
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_ATTACHTO )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QScriptEngine * par1 = (QScriptEngine *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) );
    obj->attachTo ( par1 );
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
bool autoShowStandardWindow () const
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_AUTOSHOWSTANDARDWINDOW )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    RBOOL( obj->autoShowStandardWindow () );
  }
}

/*
QMenu * createStandardMenu ( QWidget * parent = 0 )
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_CREATESTANDARDMENU )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QMenu * ptr = obj->createStandardMenu ( OPQWIDGET(1,0) );
    _qt4xhb_createReturnClass ( ptr, "QMENU" );
  }
}

/*
QToolBar * createStandardToolBar ( QWidget * parent = 0 )
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_CREATESTANDARDTOOLBAR )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QToolBar * ptr = obj->createStandardToolBar ( OPQWIDGET(1,0) );
    _qt4xhb_createReturnClass ( ptr, "QTOOLBAR" );
  }
}

/*
void detach ()
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_DETACH )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    obj->detach ();
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
void setAutoShowStandardWindow ( bool autoShow )
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_SETAUTOSHOWSTANDARDWINDOW )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    obj->setAutoShowStandardWindow ( PBOOL(1) );
  }
  hb_itemReturn( hb_stackSelfItem() );
}

/*
QMainWindow * standardWindow () const
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_STANDARDWINDOW )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QMainWindow * ptr = obj->standardWindow ();
    _qt4xhb_createReturnClass ( ptr, "QMAINWINDOW" );
  }
}

/*
DebuggerState state () const
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_STATE )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    hb_retni( (int) obj->state () );
  }
}

/*
QWidget * widget ( DebuggerWidget widget ) const
*/
HB_FUNC_STATIC( QSCRIPTENGINEDEBUGGER_WIDGET )
{
  QScriptEngineDebugger * obj = (QScriptEngineDebugger *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    QWidget * ptr = obj->widget ( (QScriptEngineDebugger::DebuggerWidget) hb_parni(1) );
    _qt4xhb_createReturnQWidgetClass ( ptr, "QWIDGET" );
  }
}

#pragma ENDDUMP

error: pathspec 'codegen/QtScriptTools/QScriptEngineDebugger.prg' did not match any file(s) known to git


Singleton tower (of size 3) with Maybe

Singleton tower (of size 3) with Maybe

data Mayb :: a ~> *2 where
  Noth :: Mayb a
  Jus :: a ~> Mayb a

data Mayb1 :: Mayb a ~> *1 where
  Noth1 :: Mayb1 Noth
  Jus1 :: a ~> Mayb1 (Jus a)

data Mayb2 :: Mayb1 a ~> *0 where
  Noth2 :: Mayb2 Noth1
  Jus2 :: a -> Mayb2 (Jus1 a)

{-

It is strange that Omega adds level polymorphism
for the upper two. Witnessed by this dialogue:

prompt> :k Mayb
Mayb :: level b . forall (a::*(3+b)).a ~> *2

prompt> :k Mayb1
Mayb1 :: level b . forall (a::*(2+b)).Mayb a ~> *1

prompt> :k Mayb2
Mayb2 :: forall (a::Mayb *1).Mayb1 a ~> *0

prompt> :t Jus1 4
Not in scope: Jus1

prompt> :t Jus2 4
Jus2 4 :: Mayb2 (Jus1 Int)

prompt> :k Mayb2 (Jus1 Int)
Mayb2 (Jus1 Int) :: *0  = Mayb2 (Jus1 Int)

prompt> :k Jus1 Int
Jus1 Int :: Mayb1 (Jus *0)  = Jus1 Int

prompt> :k Jus *0
Jus *0 :: Mayb *1  = Jus *0

prompt> :k Jus *1
Jus *1 :: Mayb *2  = Jus *1

prompt> :k Jus *2
Jus *2 :: Mayb *3  = Jus *2

prompt> :k Jus
Jus :: level b . forall (a::*(3+b)) (c::a::*(3+b)).c ~> Mayb c

-}

error: pathspec 'tests/SingMaybe.prg' did not match any file(s) known to git


Added xBase/AdvPL sample file

Added xBase/AdvPL sample file

/**
 * This is a sample file for Linguist.
 * It's written in AdvPL, a xBase Language.
 *
 * Author: Arthur Helfstein Fragoso
 *
 * This script has the specific use of integrating between a financial institution
 * and other two companies in the process of creating Installment Bills for
 * customers.
 *
 * The functions are called from the ERP Protheus TOTVS.
 *
 **/

#Include "TOPCONN.ch"
#include "tbiconn.ch"
#Include "Protheus.ch"
#Include "rwmake.ch"
#Include "FileIO.ch"
#Include "json.ch"
#Include "utils.ch"

////////////////////////
// Faturando (Reparcelando)
// FA280
// FA280_01
//

User Function FA280()

	//Executado uma vez para cada parcela

	If cEmpAnt == '06'

		SE5->(dbSelectArea("SE5"))

		cSet3Filter := "SE5->E5_FATURA == SE1->E1_NUM"

		SE5->(dbSetFilter( {|| &cSet3Filter }, cSet3Filter ))
		SE5->(dbGoTOP())

		aOrig06Tit := {} // = Todos os Titulos que ser�o reparcelados
		nTotal := 0

		While SE5->(!EOF())
			AADD(aOrig06Tit, {SE5->E5_PREFIXO, SE5->E5_NUMERO, SE5->E5_VALOR})
			nTotal += SE5->E5_VALOR
			SE5->(dbSkip())
		End

		aNovoTitulo:= {;//{"E1_FILIAL"   ,SE1ORIG->E1_FILIAL ,Nil},;
		              ;//{"E1_PREFIXO"  ,SE1->E1_PREFIXO    ,Nil},;
		              {"E1_NUM"      ,SE1->E1_NUM        ,Nil},;
		              {"E1_TIPO"     ,SE1->E1_TIPO       ,Nil},;
		              {"E1_PARCELA"  ,SE1->E1_PARCELA    ,Nil},;
		              {"E1_NATUREZ"  ,SE1->E1_NATUREZ    ,Nil},;
		              {"E1_CLIENTE"  ,SE1->E1_CLIENTE    ,Nil},;
		              {"E1_LOJA"     ,SE1->E1_LOJA       ,Nil},;
		              {"E1_NRDOC"    ,SE1->E1_NRDOC      ,Nil},;
		              ;//{"E1_X_COD"    ,SE1->E1_NATUREZ    ,Nil},;
		              {"E1_EMISSAO"  ,SE1->E1_EMISSAO    ,Nil},;
		              {"E1_VENCTO"   ,SE1->E1_VENCTO     ,Nil},;
		              {"E1_VENCREA"  ,SE1->E1_VENCREA    ,Nil},;
		              ;//{"E1_VALOR"    ,SE1->E1_VALOR      ,Nil},;
		              ;//{"E1_SALDO"    ,SE1->E1_SALDO      ,Nil},;
		              ;//{"E1_VLCRUZ"   ,SE1->E1_VLCRUZ     ,Nil},;
		              {"E1_PORTADO"  ,SE1->E1_PORTADO    ,Nil},;
		              {"E1_FATURA"   ,SE1->E1_FATURA     ,Nil},;
		              {"E1_X_DTPAV"  ,SE1->E1_X_DTPAV    ,Nil},;
		              {"E1_X_DTSAV"  ,SE1->E1_X_DTSAV    ,Nil},;
		              {"E1_X_DTTAV"  ,SE1->E1_X_DTTAV    ,Nil},;
		              {"E1_X_DTSPC"  ,SE1->E1_X_DTSPC    ,Nil},;
		              {"E1_X_DTPRO"  ,SE1->E1_X_DTPRO    ,Nil},;
		              {"E1_NUMBCO"   ,SE1->E1_NUMBCO     ,Nil},;
		              {"E1_X_DUDME"  ,SE1->E1_X_DUDME    ,Nil},;
		              {"E1_X_TIPOP"  ,SE1->E1_X_TIPOP    ,Nil},;
		              {"E1_X_DTCAN"  ,SE1->E1_X_DTCAN    ,Nil},;
		              {"E1_X_MOTIV"  ,SE1->E1_X_MOTIV    ,Nil},;
		              {"E1_X_DESPC"  ,SE1->E1_X_DESPC    ,Nil},;
		              {"E1_NUMNOTA"  ,SE1->E1_NUMNOTA    ,Nil},;
		              {"E1_SERIE"    ,SE1->E1_SERIE      ,Nil},;
		              {"E1_X_DEPRO"  ,SE1->E1_X_DEPRO    ,Nil},;
		              {"E1_X_TPPAI"  ,SE1->E1_X_TPPAI    ,Nil},;
		              {"E1_X_CGC"    ,SE1->E1_X_CGC      ,Nil},;
		              {"E1_XTPEMP"   ,SE1->E1_XTPEMP     ,Nil},;
		              {"E1_X_CTRIM"  ,SE1->E1_X_CTRIM    ,Nil}}

		StartJob("U_FA280_01",getenvserver(),.T., SE1->E1_PREFIXO ,SE1->E1_NUM, SE1->E1_TIPO, SE1->E1_VALOR, aOrig06Tit, nTotal, SE1->E1_PARCELA, aNovoTitulo)

		SE5->(dbClearFilter())

	EndIf

Return nil

User Function FA280_01(cE1PREFIXO, cE1NUM, cE1TIPO, nE1Valor, aOrig06Tit, nTotal, cE1PARCELA, aNovoTitulo)
	Local nValPar := nil
	Local aTit05 := {}

	RpcSetType(3) // Nao consome licensa

	//Prepare Environment Empresa "01" Filial '0102'
	// Muda de empresa
	While !RpcSetEnv('01', '0102',,,,GetEnvServer(),{})
		Sleep(400)
	End

		nFileLog := u_OpenLog("\Logs\FA280_"+dToS(dDataBase)+".log")

		fWrite(nFileLog,"----- FA280 -----"+CRLF)

		fWrite(nFileLog,cE1NUM+CRLF)

		nParcelas := round(nTotal/nE1Valor, 0)

		cUltima := '0'+ chr(64+nParcelas)

		fWrite(nFileLog,"valor das parcelas: "+ cvaltochar(nE1Valor) +CRLF)
		fWrite(nFileLog,"parcelas: "+ cvaltochar(nParcelas) +CRLF)
		fWrite(nFileLog,"parcela atual: "+ cE1PARCELA +CRLF)
		fWrite(nFileLog,"ultima parcela: "+ cUltima +CRLF)

		n0102total := 0
		n0105total := 0

		//Loop entre todos os Titulos que serão Reparcelados

		For nI := 1 To len(aOrig06Tit)

			fWrite(nFileLog,"E5_NUMERO: "+aOrig06Tit[nI][2] +CRLF)

			cQuery := "select * from SE1010 where E1_PREFIXO = '"+ aOrig06Tit[nI][1] +"' and E1_NUM = '"+ aOrig06Tit[nI][2] +"' and  E1_TIPO = 'FAT' and D_E_L_E_T_ <> '*'"

			fWrite(nFileLog,cQuery +CRLF)

			If select("SE1ORIG") > 0
				SE1ORIG->(DbCloseArea())
			endif
			TcQuery cQuery New Alias 'SE1ORIG'
			dbSelectArea("SE1ORIG")
			SE1ORIG->(DBGOTOP())

			While SE1ORIG->(!EOF()) //Loop entre as duas filiais: 0102, 0105
				fWrite(nFileLog,"SE1ORIG loop: "+SE1ORIG->E1_FILIAL +CRLF)
				cFilAnt := SE1ORIG->E1_FILIAL

				//Faz a baixa
				if alltrim(SE1ORIG->E1_STATUS) == 'A'
					fWrite(nFileLog, SE1ORIG->E1_FILIAL+" : Fazendo baixa" +CRLF)

					aBaixa	:= {{"E1_FILIAL"   ,SE1ORIG->E1_FILIAL   ,Nil},;
					            {"E1_PREFIXO"  ,SE1ORIG->E1_PREFIXO  ,Nil},;
					            {"E1_NUM"      ,SE1ORIG->E1_NUM      ,Nil},;
					            {"E1_TIPO"     ,SE1ORIG->E1_TIPO     ,Nil},;
					            {"E1_PARCELA"  ,SE1ORIG->E1_PARCELA  ,Nil},;
					            {"E1_DESCONT"  ,SE1ORIG->E1_DESCONT  ,Nil},;
					            {"E1_JUROS"    ,SE1ORIG->E1_JUROS    ,Nil},;
					            {"E1_MULTA"    ,SE1ORIG->E1_MULTA    ,Nil},;
					            {"E1_VLRREAL"  ,SE1ORIG->E1_VLRREAL  ,Nil},;
					            {"AUTMOTBX"    ,"FAT"                ,Nil},;
					            {"AUTDTBAIXA"  ,date()               ,Nil},;
					            {"AUTDTCREDITO",date()               ,Nil},;
					            {"AUTHIST"     ,"Bx.Emis.Fat."+cE1NUM,Nil},;
					            {"AUTVALREC"   ,SE1ORIG->E1_VALOR    ,Nil}}

					lMsErroAuto:=.F. //reseta lMsErroAuto
					MSExecAuto ({|x,y| FINA070(x,y)},aBaixa, 3)

					If lMsErroAuto

						fWrite(nFileLog,SE1ORIG->E1_FILIAL+" : Não foi efetuada a baixa do titulo : "+CRLF+ MSErroString()+ CRLF + tojson(aBaixa) + CRLF)
						return
					else

						RECLOCK('SE5',.F.)
							E5_FATURA := cE1NUM
							E5_FATPREF:= cE1PREFIXO
							//E5_LA = S
							//E5_MOEDA = ''
							//E5_TXMOEDA = 1
						MSUNLOCK()
						RECLOCK('SE1',.F.)
							E1_FATURA := cE1NUM
							E1_FATPREF:= cE1PREFIXO
							E1_TIPOFAT:= cE1TIPO
							E1_FLAGFAT:= 'S'
							E1_DTFATUR:= dDataBase
						MSUNLOCK()

						fWrite(nFileLog,SE1ORIG->E1_FILIAL+" : baixa feita" +CRLF)
					endif

				endif

				//calcula valor total de cada filial para poder calcular a Fatura

				if SE1ORIG->E1_FILIAL == '0102'
					n0102total += SE1ORIG->E1_VALOR
				elseif SE1ORIG->E1_FILIAL == '0105'
					n0105total += SE1ORIG->E1_VALOR
				else
					fWrite(nFileLog,"Programa nao preparado para a filial "+SE1ORIG->E1_FILIAL +CRLF)
				endif

				SE1ORIG->(dbskip())

			End

		Next nI

		cFilAnt := '0102'

		fWrite(nFileLog,"Total 0102: "+cvaltochar(n0102total) +CRLF)
		fWrite(nFileLog,"Total 0105: "+cvaltochar(n0105total) +CRLF)

		n0102val := round(nE1Valor * n0102total/nTotal, 2)
		n0105val := nE1Valor - n0102val

		aFili := {}

		if n0102total > 0
			AADD(aFili,'0102')
		endif

		if n0105total > 0
			AADD(aFili,'0105')
		endif

		For nI := 1 To len(aFili)

			cQuery := "select COUNT(*) as QUANT, SUM(E1_VALOR) as TOTALINC from SE1010  where E1_NUM = '"+ cE1NUM +"'  and E1_FILIAL='"+ aFili[nI] +"' and E1_PREFIXO = '"+ cE1PREFIXO +"' and D_E_L_E_T_ <> '*'"

			If select("PARC") > 0
				PARC->(DbCloseArea())
			endif
			TcQuery cQuery New Alias 'PARC'
			dbSelectArea("PARC")

			//verificamos se estamos na ultima parcela
			if PARC->QUANT == nParcelas -1 //QUANT = quantidade de parcelas incluida
				fWrite(nFileLog,"Ultima Parcela"+CRLF)
				//o valor desta será o valor que resta
				nValPar := SE1ORIG->E1_VALOR - PARC->TOTALINC

				if aFili[nI] == '0102'
					n0102val := n0102total - PARC->TOTALINC
				elseif aFili[nI] == '0105'
					n0105val := n0105total - PARC->TOTALINC
				endif
			endif

		Next nI

		fWrite(nFileLog,"Total 0102: "+cvaltochar(n0102total) + "  -> Parcela de: "+cvaltochar(n0102val) +CRLF)
		fWrite(nFileLog,"Total 0105: "+cvaltochar(n0105total) + "  -> Parcela de: "+cvaltochar(n0105val) +CRLF)

		/////////////////

		For nI := 1 To len(aFili)

			if aFili[nI] == '0102'
				nValPar := n0102val
			elseif aFili[nI] == '0105'
				nValPar := n0105val
			endif

			aTitulo := ACLONE(aNovoTitulo)

			AADD(aTitulo, {"E1_PREFIXO" ,cE1PREFIXO          ,Nil})
			AADD(aTitulo, {"E1_FILIAL"  ,aFili[nI]           ,Nil})
			AADD(aTitulo, {"E1_VALOR"   ,nValPar             ,Nil})
			AADD(aTitulo, {"E1_SALDO"   ,nValPar             ,Nil})
			AADD(aTitulo, {"E1_VLCRUZ"  ,nValPar             ,Nil})

			lMsErroAuto := .F.

			if aFili[nI] == '0102'

				MSExecAuto({|x,y| FINA040(x,y)},aTitulo,3) //Inclusao

				If lMsErroAuto
					fWrite(nFileLog,"Erro " + CRLF)
					fWrite(nFileLog,"Erro ao incluir titulo: "+CRLF+ MSErroString()+ CRLF + tojson(aTitulo) + CRLF)
					return
				else
					fWrite(nFileLog,"Sucesso "+ CRLF)
					fWrite(nFileLog,"Titulo incluido: "+ aFili[nI] +" : " + cValToChar(nValPar) +CRLF)
				endif

			elseif aFili[nI] == '0105'
				fWrite(nFileLog,"Salvando titulos 05 para o final "+aFili[nI]+CRLF)
				//StartJob("U_JOBF040",getenvserver(),.T., SE1ORIG->E1_FILIAL, aTitulo)
				AADD(aTit05, aTitulo)
				//fWrite(nFileLog,"passou pela thread "+CRLF)
			else
				fWrite(nFileLog,"Erro, filial nao tratada "+aFili[nI]+CRLF)
			endif

		Next nI

	Reset Environment

	While !RpcSetEnv('01', '0105',,,,GetEnvServer(),{})
		Sleep(400)
	End

		For nI := 1 To len(aTit05)

			lMsErroAuto := .F.

			MSExecAuto({|x,y| FINA040(x,y)},aTit05[nI],3) //Inclusao

			If lMsErroAuto
				fWrite(nFileLog,"Erro " + CRLF)
				fWrite(nFileLog,"Erro ao incluir titulo: "+CRLF+ MSErroString()+ CRLF + tojson(aTit05[nI]) + CRLF)
				return
			else
				fWrite(nFileLog,"Sucesso "+ CRLF)
				fWrite(nFileLog,"Titulo incluido: "+CRLF)
			endif

		Next nI

	Reset Environment

	fClose(nFileLog)

Return

////////////////////////
// Cancelamento da Fatura (Cancelamento do Reparcelamento)
// F280PCAN
// JOBF280C
//

User Function F280PCAN()

	/**
	 * cFatCan  - numero da fatura
	 * cPrefCan - prefixo
	 * cTipoCan - tipo
	 **/

	If cEmpAnt == '06'

		StartJob("U_JOBF280C",getenvserver(),.T., cPrefCan, cFatCan, cTipoCan)

	EndIf

Return .T.

User Function JOBF280C(cPrefCan, cFatCan, cTipoCan)

	RpcSetType(3) // Nao consome licensa

	While !RpcSetEnv('01', '0102',,,,GetEnvServer(),{})
		Sleep(400)
	End

		nFileLog := u_OpenLog("\Logs\F280PCAN_"+dToS(dDataBase)+".log")

		fWrite(nFileLog,"----- F280PCAN -----"+CRLF)

		fWrite(nFileLog,"E1_PREFIXO = '"+ cPrefCan +"' and E1_NUM = '"+ cFatCan +"' and  E1_TIPO = '"+ cTipoCan +"'"+CRLF)

		cQuery := "select * from SE1010 where E1_PREFIXO = '"+ cPrefCan +"' and E1_NUM = '"+ cFatCan +"' and  E1_TIPO = '"+ cTipoCan +"' and D_E_L_E_T_ <> '*'"

		If select("SE1ORIG") > 0
			SE1ORIG->(DbCloseArea())
		endif
		TcQuery cQuery New Alias 'SE1ORIG'
		dbSelectArea("SE1ORIG")
		SE1ORIG->(DBGOTOP())

		While SE1ORIG->(!EOF()) //Loop entre todas as parcelas e filiais

			SE1->(dbselectarea("SE1"))
			SE1->(dbSetOrder(1))

			fWrite(nFileLog,"dbseek" + CRLF)
			if ! SE1->(dbSeek(SE1ORIG->E1_FILIAL+ SE1ORIG->E1_PREFIXO+ SE1ORIG->E1_NUM+ SE1ORIG->E1_PARCELA+ SE1ORIG->E1_TIPO))
				fWrite(nFileLog,"Erro dbseek" + CRLF)
				Alert("Erro. Verificar F280PCAN() - dbseek")
				fWrite(nFileLog,"Erro dbseek("+SE1ORIG->E1_FILIAL+ SE1ORIG->E1_PREFIXO+ SE1ORIG->E1_NUM+ SE1ORIG->E1_PARCELA+ SE1ORIG->E1_TIPO+")" + CRLF)
				return .F.
			endif

			cFilAnt := SE1ORIG->E1_FILIAL

			aFatura:= {{"E1_FILIAL"  ,SE1ORIG->E1_FILIAL         ,Nil},;
			           {"E1_PREFIXO" ,SE1ORIG->E1_PREFIXO        ,Nil},;
			           {"E1_NUM"     ,SE1ORIG->E1_NUM            ,Nil},;
			           {"E1_PARCELA" ,SE1ORIG->E1_PARCELA        ,Nil},;
			           {"E1_TIPO"    ,SE1ORIG->E1_TIPO           ,Nil}}

			lMsErroAuto := .F.

			MSExecAuto({|x,y| FINA040(x,y)},aFatura,5) //Exclus�o

			If lMsErroAuto
				fWrite(nFileLog,"Erro " + CRLF)
				fWrite(nFileLog,"Erro ao remover o titulo: "+CRLF+ MSErroString()+ CRLF + tojson(aFatura) + CRLF)
				Alert("Erro ao remover o titulo. Verificar F280PCAN()")
				return .F.
			else
				fWrite(nFileLog,"Sucesso "+ CRLF)
				fWrite(nFileLog,"Titulo removido" +CRLF)
			endif

			SE1ORIG->(dbskip())

		end

		/////////////////////////////////////////////
		///////  Cancela as baixas
		///

		fWrite(nFileLog,"- cancela baixas" + CRLF)

		cQuery := "select * from SE1060 where  E1_FATURA = '"+ cFatCan +"' and D_E_L_E_T_ <> '*'"

		If select("SE1ORIG") > 0
			SE1ORIG->(DbCloseArea())
		endif
		TcQuery cQuery New Alias 'SE1ORIG'
		dbSelectArea("SE1ORIG")
		SE1ORIG->(DBGOTOP())

		aFili := {"0102", "0105"}

		While SE1ORIG->(!EOF()) //Loop entre todas as parcelas e filiais

			SE1->(dbselectarea("SE1"))
			SE1->(dbSetOrder(1))

			For nI := 1 To len(aFili)

				cFilAnt := aFili[nI]

				fWrite(nFileLog,"dbseek" + CRLF)
				if ! SE1->(dbSeek(aFili[nI]+ SE1ORIG->E1_PREFIXO+ SE1ORIG->E1_NUM+ SE1ORIG->E1_PARCELA+ SE1ORIG->E1_TIPO))
					fWrite(nFileLog,"dbseek nao encontrou titulo para filial "+aFili[nI] + CRLF)
					fWrite(nFileLog,"dbseek('"+aFili[nI]+ SE1ORIG->E1_PREFIXO+ SE1ORIG->E1_NUM+ SE1ORIG->E1_PARCELA+ SE1ORIG->E1_TIPO+"')" + CRLF)
					LOOP
				endif

				nSE5Recno := u_RetSQLOne("select R_E_C_N_O_ from SE5010 where E5_FILIAL = '"+SE1->E1_FILIAL+"' and E5_PREFIXO = '"+SE1->E1_PREFIXO+"' and E5_TIPO = '"+SE1->E1_TIPO+"' and E5_NUMERO = '"+SE1->E1_NUM+"' "+;
				                         " and E5_FATURA = '"+SE1->E1_FATURA+"' and E5_FATPREF='"+SE1->E1_FATPREF+"' and D_E_L_E_T_ <> '*' ", "R_E_C_N_O_")

				//Removemos os Flags de Fatura para conseguirmos cancelar a baixa pelo FINA070
				RECLOCK('SE1',.F.)
					E1_FATURA := ''
					E1_FATPREF:= ''
					E1_TIPOFAT:= ''
					E1_FLAGFAT:= ''
					E1_DTFATUR:= StoD('')
			    MSUNLOCK()

			    SE5->(DbGoTo(nSE5Recno))
				RECLOCK('SE5',.F.)
					E5_MOTBX  := 'NOR'
					//E5_FATURA := ''
					//E5_FATPREF:= ''
				MSUNLOCK()

				aBaixa := {{"E1_FILIAL"   ,SE1->E1_FILIAL  ,Nil},;
				           {"E1_PREFIXO"  ,SE1->E1_PREFIXO ,Nil},;
				           {"E1_NUM"      ,SE1->E1_NUM     ,Nil},;
				           {"E1_TIPO"     ,SE1->E1_TIPO    ,Nil},;
				           {"E1_PARCELA"  ,SE1->E1_PARCELA ,Nil},;
				           {"E1_DESCONT"  ,SE1->E1_DESCONT ,Nil},;
				           {"E1_JUROS"    ,SE1->E1_JUROS   ,Nil},;
				           {"E1_MULTA"    ,SE1->E1_MULTA   ,Nil},;
				           {"E1_VLRREAL"  ,SE1->E1_VLRREAL ,Nil},;
				           {"AUTMOTBX"    ,"NOR"           ,Nil},;
				           {"AUTDTBAIXA"  ,date()          ,Nil},;
				           {"AUTDTCREDITO",date()          ,Nil},;
				           {"AUTHIST"     ,""              ,Nil},;
				           {"AUTVALREC"   ,SE1->E1_VALOR   ,Nil}}

				lMsErroAuto:=.F. //reseta lMsErroAuto
				MSExecAuto ({|x,y| FINA070(x,y)},aBaixa, 5)

				If lMsErroAuto
					fWrite(nFileLog,SE1->E1_FILIAL+" : Não foi efetuada o cancelamento de baixa : "+CRLF+ MSErroString()+ CRLF + tojson(aBaixa) + CRLF)
					return
				else
					fWrite(nFileLog,SE1->E1_FILIAL+" : cancelamento de baixa feito" +CRLF)
				endif

			Next nI

			SE1ORIG->(dbskip())
		end

	Reset Environment

Return

error: pathspec 'samples/xBase/sample.prw' did not match any file(s) known to git


Rest - Tipo de despesas

Rest - Tipo de despesas

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/alvarocneto/prestconthack.git/'


codegen/KDEWebKit: updated

codegen/KDEWebKit: updated

Modified:
codegen/KDEWebKit/KWebWallet.prg

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/marcosgambeta/KDE4xHb.git/'


moving Nat thrists around

moving Nat thrists around

import "../tests/OneHi.prg" (plus, plusS)

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 At :: * ~> Nat ~> Nat ~> * where
  HoldChar :: Char -> At Char n (S n)

move :: Nat' offs -> Nat' len -> Thrist (At Char) here {plus len here} -> Thrist (At Char) offs {plus len offs}
move _ Z Nil = Nil
move offs (1+len)v (Cons (HoldChar c) as) = Cons (HoldChar c) $ move (1+offs)v len as
  where theorem plusS

error: pathspec 'tests/move.prg' did not match any file(s) known to git


added new program for yellow pig day

added new program for yellow pig day

error: pathspec 'programs/yellow_pig_day.prg' did not match any file(s) known to git


ajustes no servico

ajustes no servico


first sketch with projection

first sketch with projection

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

builtIn :: Thrist Iceberg () ()
builtIn = [Constructor `Z 0l Sig, Constructor `S 0l Sig]t

projectName :: Label l -> Thrist Iceberg () () -> Thrist Icename l l
projectName _ Nil = Nil
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

error: pathspec 'tests/Iceberg.prg' did not match any file(s) known to git


digit lists with finite digits

digit lists with finite digits

import "LangPrelude.prg" (maybeM)

monad maybeM

data Fin :: Nat ~> *0 where
  Fz :: Fin (S m)
  Fs :: Fin m -> Fin (S m)
 deriving Nat(f)

data DigitList :: Nat ~> *0 where
  None :: DigitList a
  Longer :: DigitList a -> Fin a -> DigitList a
 deriving LeftList(dl)

up :: Nat' (2+b)t -> DigitList (2+b)t -> DigitList (2+b)t
up _ []dl = [1f]dl
up b [bla; f]dl = case tryIncr b f of
                  Nothing -> [up b bla; 0f]dl
                  Just d -> [bla; d]dl

tryIncr :: Nat' (2+b)t -> Fin (2+b)t -> Maybe (Fin (2+b)t)
tryIncr 2v 1f = Nothing
tryIncr (2+v)v 0f = Just 1f
tryIncr (3+v)v 1f = Just 2f
tryIncr (3+v)v (1+f)f = do { i <- tryIncr (2+v)v f; return (1+i)f }

error: pathspec 'tests/DigitList.prg' did not match any file(s) known to git