Updated WorkArea

Updated WorkArea

//
// 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.
//
USING System.IO
USING System.Collections.Generic
USING XSharp.RDD
USING XSharp.RDD.Enums
USING XSharp.RDD.Support
BEGIN NAMESPACE XSharp.RDD

	/// Base class for DBF based RDDs. Holds common propertis such as the Workarea number, Alias, Fields list and various flags.
	/// <seealso cref="T:XSharp.RDD.IRdd"/>
	CLASS Workarea IMPLEMENTS IRdd, IDisposable
		// This class does NOT implement file based (DBF stuff).
		// That is handled in the DBF class which inherits from RddBase
		#region Fields
		PROTECTED _Disposed     AS LOGIC
		/// Workarea Number (1 based)
		PUBLIC _Area			AS DWORD
		///  Unique Alias
		PUBLIC _Alias			AS STRING
		/// File name of the main file
		PUBLIC _FileName		AS STRING
		/// List of Fields
		PUBLIC _Fields		    AS RddFieldInfo[]
		/// Is at BOF ?
		PUBLIC _Bof			    AS LOGIC
		/// Is at bottom ?
		PUBLIC _Bottom		    AS LOGIC
		/// Is at EOF ?
		PUBLIC _Eof			    AS LOGIC
		/// Result of last SEEK operation
		PUBLIC _Found			AS LOGIC
		/// Is at top?
		PUBLIC _Top			    AS LOGIC
		/// Result of last macro evaluation
		PUBLIC _Result		    AS OBJECT
		/// Current Scope
		PUBLIC _ScopeInfo		AS DbScopeInfo
		/// Current Filter
		PUBLIC _FilterInfo	    AS DbFilterInfo
		/// Current Order condition
		PUBLIC _OrderCondInfo	AS DbOrderCondInfo
		/// Current Relation info
		PUBLIC _RelInfo		    AS DbRelInfo
		PUBLIC _Relations       AS List<DbRelInfo>
		/// # of parents
		PUBLIC _Parents		    AS LONG
		/// Maximum fieldname length (Advantage supports field names > 10 characters)
		PUBLIC _MaxFieldNameLength AS LONG	//

		// Some flags that are stored here but managed in subclasses
		PUBLIC _TransRec		AS LOGIC
		/// Size of record
		PUBLIC _RecordLength	AS LONG
		/// Current Record
		PUBLIC _RecordBuffer	AS BYTE[]
		/// Field delimiter (for DELIM RDD)
		PUBLIC _Delimiter		AS STRING
		/// Field separator (for DELIM RDD)
		PUBLIC _Separator	    AS STRING
		///  Is the file opened ReadOnly ?
		PUBLIC _ReadOnly		AS LOGIC
		///  Is the file opened Shared ?
		PUBLIC _Shared			AS LOGIC
		/// File handle of the current file
		PUBLIC _hFile			AS IntPtr
		/// Should the file be flushed (it is dirty) ?
		PUBLIC _Flush			AS LOGIC

		// Memo and Order Implementation
		/// Current memo implementation.
		PUBLIC _Memo			AS IMemo
		/// Current index implementation.
		PUBLIC _Order			AS IOrder

		/// Result of the last Block evaluation.
		PUBLIC _EvalResult    AS OBJECT
		#endregion

		#region Static Properties that point to Runtime state ?
		// Ansi
		// AutoOrder
		// AutoShare
		// etc
		#endregion

		CONSTRUCTOR()
			SELF:_FilterInfo := DbFilterInfo{}
			SELF:_ScopeInfo  := DbScopeInfo{}
			SELF:_OrderCondInfo := DbOrderCondInfo{}
			SELF:_Relations  := List<DbRelInfo>{}
			SELF:_Parents	 := 0
			SELF:_Memo		 := BaseMemo{SELF}
			SELF:_Order		 := BaseIndex{SELF}
			SELF:_Result	 := NULL
			SELF:_FileName	 := String.Empty
			SELF:_Fields	 := NULL
			SELF:_Area		 := 0
			SELF:_Shared	 := FALSE
			SELF:_ReadOnly   := FALSE
			SELF:_MaxFieldNameLength := 10
			SELF:_RelInfo    := NULL
			SELF:_Alias		 := String.Empty
			SELF:_RecordBuffer := NULL
			SELF:_Disposed   := FALSE

		DESTRUCTOR()
			SELF:Dispose(FALSE)

		VIRTUAL METHOD Dispose(disposing AS LOGIC) AS VOID
			IF !_Disposed
				_Disposed := TRUE
			ENDIF

		VIRTUAL METHOD Dispose() AS VOID
			SELF:Dispose(TRUE)
			GC.SuppressFinalize(SELF)
			RETURN

			/// <inheritdoc />
		VIRTUAL METHOD DbEval(info AS DbEvalInfo) AS LOGIC
			//Todo Implement DbEval
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoTop( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoBottom( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoTo(nRec AS INT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoToId(oRec AS OBJECT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Skip(nToSkip AS INT) AS LOGIC
			LOCAL lToSkip AS LONG
			IF nToSkip == 0
				RETURN SELF:SkipRaw(0)
			ENDIF
			SELF:_Top := SELF:_Bottom := FALSE
			IF nToSkip > 0
				lToSkip := 1 	// Forward
			ELSE
				lToSkip := -1	// Backward
				nToSkip := - nToSkip
			ENDIF
			DO WHILE --nToSkip >= 0
				IF !SELF:SkipRaw(lToSkip)
					RETURN FALSE
				ENDIF
				IF !SELF:SkipFilter(lToSkip)
					RETURN FALSE
				ENDIF
				IF SELF:_BOF .OR. SELF:_EOF
					EXIT
				ENDIF
			ENDDO
			IF lToSkip < 0
				SELF:_EOF := FALSE
			ELSE
				SELF:_Bof := FALSE
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
			// Todo
		VIRTUAL METHOD SkipFilter(nToSkip AS INT) AS LOGIC
			//LOCAL Bottom /*, Deleted */ AS LOGIC
			// When no active filter, record is Ok
			//            IF SELF:_FilterInfo == NULL_OBJECT .OR. ;
			//            !SELF:_FilterInfo:Active .OR. ;
			//            SELF:_FilterInfo:FilterBlock == NULL_OBJECT ;
			//            // .or. !SetDeleted()
			//                RETURN TRUE
			//            ENDIF
			//            nToSkip := IIF(nToSkip < 0 , -1, 1)
			//            Bottom := SELF:_Bottom
			RETURN FALSE
			/*
			WHILE( ! pArea->fBof && ! pArea->fEof )
			{
			/* SET DELETED * /
			IF( hb_setGetDeleted() )
			{
			IF( SELF_DELETED( pArea, &fDeleted ) != HB_SUCCESS )
			RETURN HB_FAILURE;
			IF( fDeleted )
			{
			IF( SELF_SKIPRAW( pArea, lUpDown ) != HB_SUCCESS )
			RETURN HB_FAILURE;
			continue;
			}
			}

			/* SET FILTER TO * /
			IF( pArea->dbfi.itmCobExpr )
			{
			IF( SELF_EVALBLOCK( pArea, pArea->dbfi.itmCobExpr ) != HB_SUCCESS )
			RETURN HB_FAILURE;

			IF( HB_IS_LOGICAL( pArea->valResult ) &&
			! hb_itemGetL( pArea->valResult ) )
			{
			IF( SELF_SKIPRAW( pArea, lUpDown ) != HB_SUCCESS )
			RETURN HB_FAILURE;
			continue;
			}
			}

			BREAK;
			}

			/*
			* The only one situation when we should repos is backward skipping
			* if we are at BOTTOM position (it's SKIPFILTER called from GOBOTTOM)
			* then GOEOF() if not then GOTOP()
			* /
			IF( pArea->fBof && lUpDown < 0 )
			{
			IF( fBottom )
			{
			/* GOTO EOF (phantom) record -
			this IS the only one place WHERE GOTO IS used BY Harbour
			directly and RDD which does not operate ON numbers should
			serve this METHOD only AS SELF_GOEOF() synonym. IF it's a
			problem then we can REMOVE this IF and always use SELF_GOTOP()
			but it also means second table scan IF all records filtered
			are OUT OF filter so I DO not want TO DO that. I will prefer
			explicit ADD SELF_GOEOF() METHOD
			* /
			errCode = SELF_GOTO( pArea, 0 );
			}
			ELSE
			{
			errCode = SELF_GOTOP( pArea );
			pArea->fBof = HB_TRUE;
			}
			}
			ELSE
			{
			errCode = HB_SUCCESS;
			}

			RETURN errCode;
			*/

		/// <inheritdoc />
		VIRTUAL METHOD SkipRaw(nToSkip AS INT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD SkipScope(nToSkip AS INT) AS LOGIC
			// Todo: Implement SkipScope
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Append(lReleaseLock AS LOGIC) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Delete( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GetRec( ) AS BYTE[]
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Pack( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD PutRec(aRec AS BYTE[]) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Recall( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Zap( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Close( ) AS LOGIC
			SELF:ClearFilter()
			SELF:ClearRel()
			SELF:ClearScope()
			// close all parent relations
			IF SELF:_Parents > 0
				//
				LOCAL max AS DWORD
				max := 4096 // RuntimeState.Workareas.MaxWorkAreas <- what's wrong here ??
				FOR VAR i := 1 TO max
					VAR rdd := XSharp.RuntimeState.Workareas:GetRDD( (DWORD)i )
					VAR wk := rdd ASTYPE Workarea
					IF ( wk != NULL ) .AND. ( wk != SELF )
						wk:_Relations:RemoveAll( SELF:isChildPredicate )
					ENDIF
				NEXT
			ENDIF

			/// <inheritdoc />
		VIRTUAL METHOD Create(info AS DbOpenInfo) AS LOGIC
			// todo: basic implementation
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Open(info AS DbOpenInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD ClearFilter( ) AS LOGIC
			IF SELF:_FilterInfo != NULL
				SELF:_FilterInfo:Clear()
			ELSE
				SELF:_FilterInfo := DbFilterInfo{}
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD ClearScope( ) AS LOGIC
			IF SELF:_ScopeInfo != NULL
				SELF:_ScopeInfo:Clear()
			ELSE
				SELF:_ScopeInfo := DbScopeInfo{}
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD Continue( ) AS LOGIC
			// Todo: Implement Continue
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GetScope( ) AS DbScopeInfo
			IF SELF:_ScopeInfo != NULL_OBJECT
				RETURN SELF:_ScopeInfo:Clone()
			ENDIF
			RETURN DbScopeInfo{}

			/// <inheritdoc />
		VIRTUAL METHOD ScopeInfo(nOrdinal AS INT) AS OBJECT
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD SetFilter(info AS DbFilterInfo) AS LOGIC
			SELF:ClearFilter()
			IF info != NULL_OBJECT
				SELF:_FilterInfo := info:Clone()
				SELF:_FilterInfo:Active := TRUE
			ENDIF
			RETURN TRUE

		VIRTUAL METHOD SetFieldExtent( fieldCount AS LONG ) AS LOGIC
			// Initialize the Fields array
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD SetScope(info AS DbScopeInfo) AS LOGIC
			SELF:ClearScope()
			IF (info != NULL_OBJECT)
				SELF:_ScopeInfo := info:Clone()
			ENDIF
			RETURN TRUE

		VIRTUAL METHOD SetFieldExtent(uiCount AS DWORD) AS LOGIC
			//Todo Copy implementation from DBF or ADS
			RETURN FALSE

			/// <inheritdoc />
		VIRTUAL METHOD AddField(info AS RddFieldInfo) AS LOGIC
			// ToDo
			// Copy implementation from ADS or DBF
			// including _CheckFIeldName

			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD CreateFields(aFields AS RddFieldInfo[]) AS LOGIC
			// ToDo
			// Copy implementation from ADS or DBF
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD FieldIndex(fieldName AS STRING) AS INT
			LOCAL nMax AS INT
			nMax := SELF:FieldCount
			FOR VAR nFldPos := 0 TO nMax -1
				IF SELF:_Fields[nFldPos] != NULL .AND. String.Compare(SELF:_Fields[nFldPos]:Name, fieldName, StringComparison.OrdinalIgnoreCase) == 0
					// Note that we must return 1 based fldPos
					RETURN nFldPos+1
				ENDIF
			NEXT
			RETURN 0

			/// <inheritdoc />
		PROTECTED METHOD _FieldIndexValidate(nFldPos AS LONG) AS LOGIC
			LOCAL nMax AS INT
			// Note that nFldPos is 1 based
			nMax := (INT) SELF:_Fields?:Length
			IF nFldPos <= 0 .OR. nFldPos > nMax
				THROW ArgumentException{"Invalid Field Index, must be between 1 and "+SELF:FieldCount:ToString(), NAMEOF(nFldPos)}
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD FieldInfo(nFldPos AS LONG, nOrdinal AS LONG, oNewValue AS OBJECT) AS OBJECT
			// Note that nFldPos is 1 based
			// Todo implement basic NAME, LEN, TYPE, DEC info
			IF SELF:_FieldIndexValidate(nFldPos)
				IF __ARRAYBASE__ == 0
					nFldPos -= 1
				ENDIF
			ENDIF
			THROW NotImplementedException{__ENTITY__}

		VIRTUAL METHOD GetField(nFldPos AS INT) AS RDDFieldInfo
			IF SELF:_FieldIndexValidate(nFldPos)
				IF __ARRAYBASE__ == 0
					nFldPos -= 1
				ENDIF
				RETURN SELF:_Fields[nFldPos]
			ENDIF
			RETURN NULL

			/// <inheritdoc />
		VIRTUAL METHOD FieldName(nFldPos AS INT) AS STRING
			// Note that nFldPos is 1 based
			IF SELF:_FieldIndexValidate(nFldPos)
				IF __ARRAYBASE__ == 0
					nFldPos -= 1
				ENDIF
				RETURN SELF:_Fields[nFldPos]:Name
			ENDIF
			RETURN String.Empty

			/// <inheritdoc />
		VIRTUAL METHOD GetValue(nFldPos AS INT) AS OBJECT
			// Note that nFldPos is 1 based
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GetValueFile(nFldPos AS INT, fileName AS STRING) AS LOGIC
			// Note that nFldPos is 1 based
			RETURN _Memo:GetValueFile(nFldPos, fileName )

			/// <inheritdoc />
		VIRTUAL METHOD GetValueLength(nFldPos AS INT) AS INT
			// Note that nFldPos is 1 based
			RETURN _Memo:GetValueLength(nFldPos )

			/// <inheritdoc />
		VIRTUAL METHOD Flush( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoCold( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoHot( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD PutValue(nFldPos AS INT, oValue AS OBJECT) AS LOGIC
			// Note that nFldPos is 1 based
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD PutValueFile(nFldPos AS INT, fileName AS STRING) AS LOGIC
			// Note that nFldPos is 1 based
			RETURN _Memo:PutValueFile(nFldPos, fileName )

			/// <inheritdoc />
		VIRTUAL METHOD AppendLock(uiMode AS DbLockMode) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD HeaderLock(uiMode AS DbLockMode) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Lock(uiMode REF DbLockInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD UnLock(oRecId AS OBJECT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD CloseMemFile( ) AS LOGIC
			RETURN SELF:_Memo:CloseMemFile()

			/// <inheritdoc />
		VIRTUAL METHOD CreateMemFile(info AS DbOpenInfo) AS LOGIC
			RETURN SELF:_Memo:CreateMemFile(info)

			/// <inheritdoc />
		VIRTUAL METHOD OpenMemFile( info AS DbOpenInfo) AS LOGIC
			RETURN SELF:_Memo:OpenMemFile(info )

			#region Orders Not implemented

			/// <inheritdoc />
			VIRTUAL METHOD OrderCondition(info AS DbOrderCondInfo) AS LOGIC
				RETURN SELF:_Order:OrderCondition(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderCreate(info AS DbOrderCreateInfo) AS LOGIC
				RETURN SELF:_Order:OrderCreate(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderDestroy(info AS DbOrderInfo) AS LOGIC
				RETURN SELF:_Order:OrderDestroy(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderInfo(nOrdinal AS DWORD, info AS DbOrderInfo) AS OBJECT
				/* CA-Cl*pper does not generate RT error when default ORDERINFO() method
				* is called
				*/
				RETURN SELF:_Order:OrderInfo(nOrdinal, info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderListAdd(info AS DbOrderInfo) AS LOGIC
				RETURN SELF:_Order:OrderListAdd(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderListDelete(info AS DbOrderInfo) AS LOGIC
				RETURN SELF:_Order:OrderListDelete(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderListFocus(info AS DbOrderInfo) AS LOGIC
				RETURN SELF:_Order:OrderListFocus(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderListRebuild( ) AS LOGIC
				RETURN SELF:_Order:OrderListRebuild()

				/// <inheritdoc />
			VIRTUAL METHOD Seek(info AS DbSeekInfo) AS LOGIC
				RETURN SELF:_Order:Seek(info)
				#endregion

			#region Relations

			/// <inheritdoc />
			VIRTUAL METHOD ChildEnd(info AS DbRelInfo) AS LOGIC
				SELF:_Parents --
				RETURN TRUE

				/// <inheritdoc />
			VIRTUAL METHOD ChildStart(info AS DbRelInfo) AS LOGIC
				SELF:_Parents ++
				RETURN TRUE

				/// <inheritdoc />
			VIRTUAL METHOD ChildSync(info AS DbRelInfo) AS LOGIC
				// Todo: Implement ChildSync
				THROW NotImplementedException{__ENTITY__}

			PRIVATE METHOD isChildPredicate( info AS DbRelInfo ) AS LOGIC
				// Is Child ?
				RETURN ( info:Child == SELF )

				/// <inheritdoc />
			VIRTUAL METHOD ClearRel( ) AS LOGIC
				LOCAL isOk AS LOGIC
				//
				isOk := TRUE
				//
				FOREACH info AS DbRelInfo IN SELF:_Relations
					isOk := isOk .AND. info:Child:ChildEnd( info )
				NEXT
				SELF:_Relations:Clear()
				RETURN isOk

				/// <inheritdoc />
			VIRTUAL METHOD ForceRel( ) AS LOGIC
				THROW NotImplementedException{__ENTITY__}

				/// <inheritdoc />
			VIRTUAL METHOD RelArea(nRelNum AS DWORD) AS DWORD
				LOCAL areaNum := 0 AS DWORD
				IF ( nRelNum < SELF:_Relations:Count )
					areaNum := SELF:_Relations[ (INT)nRelNum ]:Child:Area
				ENDIF
				RETURN areaNum

				/// <inheritdoc />
			VIRTUAL METHOD RelEval(info AS DbRelInfo) AS LOGIC
				LOCAL currentWk AS DWORD
				//
				currentWk := XSharp.RuntimeState.Workareas:CurrentWorkAreaNO
				TRY
					XSharp.RuntimeState.CurrentWorkArea := info:Parent:Area
					SELF:_EvalResult := info:Block:EvalBlock()
				FINALLY
					XSharp.RuntimeState.Workareas:CurrentWorkAreaNO := currentWk
				END TRY
				RETURN ( SELF:_EvalResult != NULL )

				/// <inheritdoc />
			VIRTUAL METHOD RelText(nRelNum AS DWORD) AS STRING
				LOCAL textRelation := "" AS STRING
				IF ( nRelNum < SELF:_Relations:Count )
					textRelation := SELF:_Relations[ (INT)nRelNum ]:Key
				ENDIF
				RETURN textRelation

				/// <inheritdoc />
			VIRTUAL METHOD SetRel(info AS DbRelInfo) AS LOGIC
				IF !SELF:_Relations:Contains( info )
					SELF:_Relations:Add( info )
				ENDIF
				RETURN info:Child:ChildStart( info )

				/// <inheritdoc />
			VIRTUAL METHOD SyncChildren( ) AS LOGIC
				LOCAL isOk AS LOGIC
				//
				isOk := TRUE
				//
				FOREACH info AS DbRelInfo IN SELF:_Relations
					isOk := info:Child:ChildSync( info )
					IF !isOk
						EXIT
					ENDIF
				NEXT
				RETURN isOk

				#endregion

			#region Trans not implemented

			/// <inheritdoc />
			VIRTUAL METHOD Trans(info AS DbTransInfo) AS LOGIC
				// Todo: Implement Trans
				THROW NotImplementedException{__ENTITY__}

				/// <inheritdoc />
			VIRTUAL METHOD TransRec(info AS DbTransInfo) AS LOGIC
				// Todo: Implement Trans
				THROW NotImplementedException{__ENTITY__}

				#endregion

			/// <inheritdoc />
		VIRTUAL METHOD BlobInfo(uiPos AS DWORD, uiOrdinal AS DWORD) AS OBJECT
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Compile(sBlock AS STRING) AS ICodeBlock
			LOCAL oBlock := NULL AS ICodeBlock
			TRY
				LOCAL oC AS IMacroCompiler
				oC := XSharp.RuntimeState.MacroCompiler
				LOCAL oType := typeof(Workarea) AS System.Type
				IF oC != NULL
					LOCAL isBlock AS LOGIC
					oBlock := oC:Compile(sBlock, TRUE, oType:Module, OUT isBlock)
				ENDIF
			CATCH e AS Exception
				XSharp.RuntimeState.LastRddError := e
			END TRY
			RETURN oBlock

			/// <inheritdoc />
		VIRTUAL METHOD EvalBlock(oBlock AS ICodeBlock) AS OBJECT
			// Todo: Save and restore workarea
			RETURN oBlock:EvalBlock()

			/// <inheritdoc />
		VIRTUAL METHOD Info(nOrdinal AS INT, oNewValue AS OBJECT) AS OBJECT
			LOCAL oResult AS OBJECT
			// todo check basic implementation
			SWITCH nOrdinal
			CASE DBI_ISDBF
				CASE DBI_CANPUTREC
				CASE DBI_ISFLOCK
				CASE DBI_TRANSREC
				CASE DBI_RM_SUPPORTED
					oResult := FALSE
				CASE DBI_SHARED
					oResult := SELF:_Shared
				CASE DBI_ISREADONLY
					oResult := SELF:_ReadOnly
				CASE DBI_GETDELIMITER
					oResult := SELF:_Delimiter
				CASE DBI_SEPARATOR
					oResult := SELF:_Separator
				CASE DBI_SETDELIMITER
					oResult := SELF:_Separator
					IF oNewValue != NULL .AND. oNewValue:GetType() == TYPEOF(STRING)
						SELF:_Separator	:= (STRING) oNewValue
					ENDIF
				CASE DBI_DB_VERSION
				CASE DBI_RDD_VERSION
					oResult := ""
				CASE DBI_GETHEADERSIZE
				CASE DBI_LOCKCOUNT
					oResult := 0
				CASE DBI_GETRECSIZE
					oResult := SELF:_RecordLength
				CASE DBI_LASTUPDATE
					oResult := DateTime.MinValue
				CASE DBI_GETLOCKARRAY
					oResult := <DWORD>{}
				CASE DBI_BOF
					oResult := SELF:_BOF
				CASE DBI_EOF
					oResult := SELF:_EOF
				CASE DBI_DBFILTER
					oResult := SELF:_FilterInfo?:FilterText
				CASE DBI_FOUND
					oResult := SELF:_Found
				CASE DBI_FCOUNT
					oResult := (INT) _Fields?:Length
				CASE DBI_ALIAS
					oResult := _Alias
				CASE DBI_FULLPATH
					oResult := SELF:_FileName
					// CASE DBI_CHILDCOUNT:
					// CASE DBI_TABLEEXT
					// CASE DBI_SCOPEDRELATION
					// CASE DBI_POSITIONED
					// CASE DBI_CODEPAGE
				OTHERWISE
					oResult := NULL
				END SWITCH
			RETURN oResult

			/// <inheritdoc />
		VIRTUAL METHOD RecInfo(oRecID AS OBJECT, nOrdinal AS LONG, oNewValue AS OBJECT) AS OBJECT
			LOCAL oResult AS OBJECT
			//Todo: Basic implementation of Recno deleted etc.
			SWITCH nOrdinal

				// etc
				OTHERWISE
					oResult := NULL
			END SWITCH
			RETURN oResult

			/// <inheritdoc />
		VIRTUAL METHOD Sort(info AS DbSortInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL PROPERTY Alias AS STRING GET _Alias SET _Alias := VALUE

		/// <inheritdoc />
		VIRTUAL PROPERTY Area AS DWORD GET _Area SET _Area := VALUE

		/// <inheritdoc />
		VIRTUAL PROPERTY BoF AS LOGIC GET _Bof

		/// <inheritdoc />
		VIRTUAL PROPERTY Deleted AS LOGIC GET FALSE

		/// <inheritdoc />
		VIRTUAL PROPERTY Driver AS STRING GET "Workarea"

		/// <inheritdoc />
		VIRTUAL PROPERTY EoF AS LOGIC GET _Eof

		/// <inheritdoc />
		VIRTUAL PROPERTY Exclusive AS LOGIC GET FALSE

		/// <inheritdoc />
		VIRTUAL PROPERTY FieldCount AS LONG GET (LONG) _Fields?:Length

		/// <inheritdoc />
		VIRTUAL PROPERTY FilterText AS STRING GET _FilterInfo?:FilterText

		/// <inheritdoc />
		VIRTUAL PROPERTY Found AS LOGIC GET _Order:Found SET _Order:Found := VALUE

		/// <inheritdoc />
		VIRTUAL PROPERTY RecCount AS INT GET 0

		/// <inheritdoc />
		VIRTUAL PROPERTY RecId AS OBJECT GET NULL
		/// <inheritdoc />
		VIRTUAL PROPERTY RecNo AS LONG GET   0

		/// <inheritdoc />
		VIRTUAL PROPERTY Shared AS LOGIC GET FALSE

		/// <inheritdoc />
		VIRTUAL PROPERTY SysName AS STRING GET TYPEOF(Workarea):ToString()

	END CLASS

END NAMESPACE

//
// 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.
//
USING System.IO
USING System.Collections.Generic
USING XSharp.RDD
USING XSharp.RDD.Enums
USING XSharp.RDD.Support
BEGIN NAMESPACE XSharp.RDD

    /// Base class for DBF based RDDs. Holds common propertis such as the Workarea number, Alias, Fields list and various flags.
    /// <seealso cref="T:XSharp.RDD.IRdd"/>
    CLASS Workarea IMPLEMENTS IRdd, IDisposable
        // This class does NOT implement file based (DBF stuff).
        // That is handled in the DBF class which inherits from RddBase
        #region Fields
        PROTECTED _Disposed     AS LOGIC
        /// Workarea Number (1 based)
        PUBLIC _Area			AS DWORD
        ///  Unique Alias
        PUBLIC _Alias			AS STRING
        /// File name of the main file
        PUBLIC _FileName		AS STRING
        /// List of Fields
        PUBLIC _Fields		    AS RddFieldInfo[]
        /// Is at BOF ?
        PUBLIC _Bof			    AS LOGIC
        /// Is at bottom ?
        PUBLIC _Bottom		    AS LOGIC
        /// Is at EOF ?
        PUBLIC _Eof			    AS LOGIC
        /// Result of last SEEK operation
        PUBLIC _Found			AS LOGIC
        /// Is at top?
        PUBLIC _Top			    AS LOGIC
        /// Result of last macro evaluation
        PUBLIC _Result		    AS OBJECT
        /// Current Scope
        PUBLIC _ScopeInfo		AS DbScopeInfo
        /// Current Filter
        PUBLIC _FilterInfo	    AS DbFilterInfo
        /// Current Order condition
        PUBLIC _OrderCondInfo	AS DbOrderCondInfo
        /// Current Relation info
        PUBLIC _RelInfo		    AS DbRelInfo
        /// # of parents
        PUBLIC _Parents		    AS LONG
        /// Maximum fieldname length (Advantage supports field names > 10 characters)
        PUBLIC _MaxFieldNameLength AS LONG	//

        // Some flags that are stored here but managed in subclasses
        PUBLIC _TransRec		AS LOGIC
        /// Size of record
        PUBLIC _RecordLength	AS LONG
        /// Current Record
        PUBLIC _RecordBuffer	AS BYTE[]
        /// Field delimiter (for DELIM RDD)
        PUBLIC _Delimiter		AS STRING
        /// Field separator (for DELIM RDD)
        PUBLIC _Separator	    AS STRING
        ///  Is the file opened ReadOnly ?
        PUBLIC _ReadOnly		AS LOGIC
        ///  Is the file opened Shared ?
        PUBLIC _Shared			AS LOGIC
        /// File handle of the current file
        PUBLIC _hFile			AS IntPtr
        /// Should the file be flushed (it is dirty) ?
        PUBLIC _Flush			AS LOGIC

        // Memo and Order Implementation
        /// Current memo implementation.
        PUBLIC _Memo			AS IMemo
        /// Current index implementation.
        PUBLIC _Order			AS IOrder

        #endregion

        #region Static Properties that point to Runtime state ?
        // Ansi
        // AutoOrder
        // AutoShare
        // etc
        #endregion

        CONSTRUCTOR()
            SELF:_FilterInfo := DbFilterInfo{}
            SELF:_ScopeInfo  := DbScopeInfo{}
            SELF:_OrderCondInfo := DbOrderCondInfo{}
            SELF:_Parents	 := 0
            SELF:_Memo		 := BaseMemo{SELF}
            SELF:_Order		 := BaseIndex{SELF}
            SELF:_Result	 := NULL
            SELF:_FileName	 := String.Empty
            SELF:_Fields	 := NULL
            SELF:_Area		 := 0
            SELF:_Shared	 := FALSE
            SELF:_ReadOnly   := FALSE
            SELF:_MaxFieldNameLength := 10
            SELF:_RelInfo    := NULL
            SELF:_Alias		 := String.Empty
            SELF:_RecordBuffer := NULL
            SELF:_Disposed   := FALSE

        DESTRUCTOR()
            SELF:Dispose(FALSE)

        VIRTUAL METHOD Dispose(disposing AS LOGIC) AS VOID
            IF !_Disposed
                _Disposed := TRUE
            ENDIF

        VIRTUAL METHOD Dispose() AS VOID
            SELF:Dispose(TRUE)
            GC.SuppressFinalize(SELF)
            RETURN

            /// <inheritdoc />
        VIRTUAL METHOD DbEval(info AS DbEvalInfo) AS LOGIC
            //Todo Implement DbEval
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GoTop( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GoBottom( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GoTo(nRec AS INT) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GoToId(oRec AS OBJECT) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Skip(nToSkip AS INT) AS LOGIC
            LOCAL lToSkip AS LONG
            IF nToSkip == 0
                RETURN SELF:SkipRaw(0)
            ENDIF
            SELF:_Top := SELF:_Bottom := FALSE
            IF nToSkip > 0
                lToSkip := 1 	// Forward
            ELSE
                lToSkip := -1	// Backward
                nToSkip := - nToSkip
            ENDIF
            DO WHILE --nToSkip >= 0
                IF !SELF:SkipRaw(lToSkip)
                    RETURN FALSE
                ENDIF
                IF !SELF:SkipFilter(lToSkip)
                    RETURN FALSE
                ENDIF
                IF SELF:_BOF .OR. SELF:_EOF
                    EXIT
                ENDIF
            ENDDO
            IF lToSkip < 0
                SELF:_EOF := FALSE
            ELSE
                SELF:_Bof := FALSE
            ENDIF
            RETURN TRUE

            /// <inheritdoc />
        // Todo
        VIRTUAL METHOD SkipFilter(nToSkip AS INT) AS LOGIC
            //LOCAL Bottom /*, Deleted */ AS LOGIC
            // When no active filter, record is Ok
//            IF SELF:_FilterInfo == NULL_OBJECT .OR. ;
//            !SELF:_FilterInfo:Active .OR. ;
//            SELF:_FilterInfo:FilterBlock == NULL_OBJECT ;
//            // .or. !SetDeleted()
//                RETURN TRUE
//            ENDIF
//            nToSkip := IIF(nToSkip < 0 , -1, 1)
//            Bottom := SELF:_Bottom
            RETURN FALSE
            /*
            WHILE( ! pArea->fBof && ! pArea->fEof )
            {
            /* SET DELETED * /
            IF( hb_setGetDeleted() )
            {
            IF( SELF_DELETED( pArea, &fDeleted ) != HB_SUCCESS )
            RETURN HB_FAILURE;
            IF( fDeleted )
            {
            IF( SELF_SKIPRAW( pArea, lUpDown ) != HB_SUCCESS )
            RETURN HB_FAILURE;
            continue;
            }
            }

            /* SET FILTER TO * /
            IF( pArea->dbfi.itmCobExpr )
            {
            IF( SELF_EVALBLOCK( pArea, pArea->dbfi.itmCobExpr ) != HB_SUCCESS )
            RETURN HB_FAILURE;

            IF( HB_IS_LOGICAL( pArea->valResult ) &&
            ! hb_itemGetL( pArea->valResult ) )
            {
            IF( SELF_SKIPRAW( pArea, lUpDown ) != HB_SUCCESS )
            RETURN HB_FAILURE;
            continue;
            }
            }

            BREAK;
            }

            /*
            * The only one situation when we should repos is backward skipping
            * if we are at BOTTOM position (it's SKIPFILTER called from GOBOTTOM)
            * then GOEOF() if not then GOTOP()
            * /
            IF( pArea->fBof && lUpDown < 0 )
            {
            IF( fBottom )
            {
            /* GOTO EOF (phantom) record -
            this IS the only one place WHERE GOTO IS used BY Harbour
            directly and RDD which does not operate ON numbers should
            serve this METHOD only AS SELF_GOEOF() synonym. IF it's a
            problem then we can REMOVE this IF and always use SELF_GOTOP()
            but it also means second table scan IF all records filtered
            are OUT OF filter so I DO not want TO DO that. I will prefer
            explicit ADD SELF_GOEOF() METHOD
            * /
            errCode = SELF_GOTO( pArea, 0 );
            }
            ELSE
            {
            errCode = SELF_GOTOP( pArea );
            pArea->fBof = HB_TRUE;
            }
            }
            ELSE
            {
            errCode = HB_SUCCESS;
            }

            RETURN errCode;
            */

            /// <inheritdoc />
        VIRTUAL METHOD SkipRaw(nToSkip AS INT) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD SkipScope(nToSkip AS INT) AS LOGIC
            // Todo: Implement SkipScope
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Append(lReleaseLock AS LOGIC) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Delete( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GetRec( ) AS BYTE[]
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Pack( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD PutRec(aRec AS BYTE[]) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Recall( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Zap( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Close( ) AS LOGIC
            SELF:ClearFilter()
            SELF:ClearRel()
            SELF:ClearScope()
            // todo close all parent relations
            RETURN TRUE

            /// <inheritdoc />
        VIRTUAL METHOD Create(info AS DbOpenInfo) AS LOGIC
            // todo: basic implementation
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Open(info AS DbOpenInfo) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD ClearFilter( ) AS LOGIC
            IF SELF:_FilterInfo != NULL
                SELF:_FilterInfo:Clear()
            ELSE
                SELF:_FilterInfo := DbFilterInfo{}
            ENDIF
            RETURN TRUE

            /// <inheritdoc />
        VIRTUAL METHOD ClearScope( ) AS LOGIC
            IF SELF:_ScopeInfo != NULL
                SELF:_ScopeInfo:Clear()
            ELSE
                SELF:_ScopeInfo := DbScopeInfo{}
            ENDIF
            RETURN TRUE

            /// <inheritdoc />
        VIRTUAL METHOD Continue( ) AS LOGIC
            // Todo: Implement Continue
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GetScope( ) AS DbScopeInfo
            IF SELF:_ScopeInfo != NULL_OBJECT
                RETURN SELF:_ScopeInfo:Clone()
            ENDIF
            RETURN DbScopeInfo{}

            /// <inheritdoc />
        VIRTUAL METHOD ScopeInfo(nOrdinal AS INT) AS OBJECT
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD SetFilter(info AS DbFilterInfo) AS LOGIC
            SELF:ClearFilter()
            IF info != NULL_OBJECT
                SELF:_FilterInfo := info:Clone()
                SELF:_FilterInfo:Active := TRUE
            ENDIF
            RETURN TRUE

        VIRTUAL METHOD SetFieldExtent( fieldCount AS LONG ) AS LOGIC
            // Initialize the Fields array
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD SetScope(info AS DbScopeInfo) AS LOGIC
            SELF:ClearScope()
            IF (info != NULL_OBJECT)
                SELF:_ScopeInfo := info:Clone()
            ENDIF
            RETURN TRUE

        VIRTUAL METHOD SetFieldExtent(uiCount AS DWORD) AS LOGIC
            //Todo Copy implementation from DBF or ADS
            RETURN FALSE

            /// <inheritdoc />
        VIRTUAL METHOD AddField(info AS RddFieldInfo) AS LOGIC
            // ToDo
            // Copy implementation from ADS or DBF
            // including _CheckFIeldName

            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD CreateFields(aFields AS RddFieldInfo[]) AS LOGIC
            // ToDo
            // Copy implementation from ADS or DBF
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD FieldIndex(fieldName AS STRING) AS INT
            LOCAL nMax AS INT
            nMax := SELF:FieldCount
            FOR VAR nFldPos := 0 TO nMax -1
                IF SELF:_Fields[nFldPos] != NULL .AND. String.Compare(SELF:_Fields[nFldPos]:Name, fieldName, StringComparison.OrdinalIgnoreCase) == 0
                    // Note that we must return 1 based fldPos
                    RETURN nFldPos+1
                ENDIF
            NEXT
            RETURN 0

            /// <inheritdoc />
        PROTECTED METHOD _FieldIndexValidate(nFldPos AS LONG) AS LOGIC
            LOCAL nMax AS INT
            // Note that nFldPos is 1 based
            nMax := (INT) SELF:_Fields?:Length
            IF nFldPos <= 0 .OR. nFldPos > nMax
                THROW ArgumentException{"Invalid Field Index, must be between 1 and "+SELF:FieldCount:ToString(), NAMEOF(nFldPos)}
            ENDIF
            RETURN TRUE

            /// <inheritdoc />
        VIRTUAL METHOD FieldInfo(nFldPos AS LONG, nOrdinal AS LONG, oNewValue AS OBJECT) AS OBJECT
            // Note that nFldPos is 1 based
            // Todo implement basic NAME, LEN, TYPE, DEC info
            IF SELF:_FieldIndexValidate(nFldPos)
                IF __ARRAYBASE__ == 0
                    nFldPos -= 1
                ENDIF
            ENDIF
            THROW NotImplementedException{__ENTITY__}

        VIRTUAL METHOD GetField(nFldPos AS INT) AS RDDFieldInfo
            IF SELF:_FieldIndexValidate(nFldPos)
                IF __ARRAYBASE__ == 0
                    nFldPos -= 1
                ENDIF
                RETURN SELF:_Fields[nFldPos]
            ENDIF
            RETURN NULL

            /// <inheritdoc />
        VIRTUAL METHOD FieldName(nFldPos AS INT) AS STRING
            // Note that nFldPos is 1 based
            IF SELF:_FieldIndexValidate(nFldPos)
                IF __ARRAYBASE__ == 0
                    nFldPos -= 1
                ENDIF
                RETURN SELF:_Fields[nFldPos]:Name
            ENDIF
            RETURN String.Empty

            /// <inheritdoc />
        VIRTUAL METHOD GetValue(nFldPos AS INT) AS OBJECT
            // Note that nFldPos is 1 based
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GetValueFile(nFldPos AS INT, fileName AS STRING) AS LOGIC
            // Note that nFldPos is 1 based
            RETURN _Memo:GetValueFile(nFldPos, fileName )

            /// <inheritdoc />
        VIRTUAL METHOD GetValueLength(nFldPos AS INT) AS INT
            // Note that nFldPos is 1 based
            RETURN _Memo:GetValueLength(nFldPos )

            /// <inheritdoc />
        VIRTUAL METHOD Flush( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GoCold( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD GoHot( ) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD PutValue(nFldPos AS INT, oValue AS OBJECT) AS LOGIC
            // Note that nFldPos is 1 based
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD PutValueFile(nFldPos AS INT, fileName AS STRING) AS LOGIC
            // Note that nFldPos is 1 based
            RETURN _Memo:PutValueFile(nFldPos, fileName )

            /// <inheritdoc />
        VIRTUAL METHOD AppendLock(uiMode AS DbLockMode) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD HeaderLock(uiMode AS DbLockMode) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Lock(uiMode REF DbLockInfo) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD UnLock(oRecId AS OBJECT) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD CloseMemFile( ) AS LOGIC
            RETURN SELF:_Memo:CloseMemFile()

            /// <inheritdoc />
        VIRTUAL METHOD CreateMemFile(info AS DbOpenInfo) AS LOGIC
            RETURN SELF:_Memo:CreateMemFile(info)

            /// <inheritdoc />
        VIRTUAL METHOD OpenMemFile( info AS DbOpenInfo) AS LOGIC
            RETURN SELF:_Memo:OpenMemFile(info )

            #region Orders Not implemented

            /// <inheritdoc />
            VIRTUAL METHOD OrderCondition(info AS DbOrderCondInfo) AS LOGIC
                RETURN SELF:_Order:OrderCondition(info)

                /// <inheritdoc />
            VIRTUAL METHOD OrderCreate(info AS DbOrderCreateInfo) AS LOGIC
                RETURN SELF:_Order:OrderCreate(info)

                /// <inheritdoc />
            VIRTUAL METHOD OrderDestroy(info AS DbOrderInfo) AS LOGIC
                RETURN SELF:_Order:OrderDestroy(info)

                /// <inheritdoc />
            VIRTUAL METHOD OrderInfo(nOrdinal AS DWORD, info AS DbOrderInfo) AS OBJECT
                /* CA-Cl*pper does not generate RT error when default ORDERINFO() method
                * is called
                */
                RETURN SELF:_Order:OrderInfo(nOrdinal, info)

            /// <inheritdoc />
            VIRTUAL METHOD OrderListAdd(info AS DbOrderInfo) AS LOGIC
                RETURN SELF:_Order:OrderListAdd(info)

                /// <inheritdoc />
            VIRTUAL METHOD OrderListDelete(info AS DbOrderInfo) AS LOGIC
                RETURN SELF:_Order:OrderListDelete(info)

                /// <inheritdoc />
            VIRTUAL METHOD OrderListFocus(info AS DbOrderInfo) AS LOGIC
                RETURN SELF:_Order:OrderListFocus(info)

                /// <inheritdoc />
            VIRTUAL METHOD OrderListRebuild( ) AS LOGIC
                RETURN SELF:_Order:OrderListRebuild()

                /// <inheritdoc />
            VIRTUAL METHOD Seek(info AS DbSeekInfo) AS LOGIC
                RETURN SELF:_Order:Seek(info)
                #endregion

            #region Relations

            /// <inheritdoc />
            VIRTUAL METHOD ChildEnd(info AS DbRelInfo) AS LOGIC
                // Todo: Implement ChildEnd
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD ChildStart(info AS DbRelInfo) AS LOGIC
                // Todo: Implement ChildStart
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD ChildSync(info AS DbRelInfo) AS LOGIC
                // Todo: Implement ChildSync
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD ClearRel( ) AS LOGIC
                // Todo: Implement ClearRel
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD ForceRel( ) AS LOGIC
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD RelArea(nRelNum AS DWORD) AS DWORD
                // Todo: Implement RelArea
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD RelEval(info AS DbRelInfo) AS LOGIC
                // Todo: Implement RelEval
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD RelText(nRelNum AS DWORD) AS STRING
                // Todo: Implement RelText
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD SetRel(info AS DbRelInfo) AS LOGIC
                // Todo: Implement SetRel
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD SyncChildren( ) AS LOGIC
                // Todo: Implement SyncChildren
                THROW NotImplementedException{__ENTITY__}

                #endregion

            #region Trans not implemented

            /// <inheritdoc />
            VIRTUAL METHOD Trans(info AS DbTransInfo) AS LOGIC
                // Todo: Implement Trans
                THROW NotImplementedException{__ENTITY__}

                /// <inheritdoc />
            VIRTUAL METHOD TransRec(info AS DbTransInfo) AS LOGIC
                // Todo: Implement Trans
                THROW NotImplementedException{__ENTITY__}

                #endregion

            /// <inheritdoc />
        VIRTUAL METHOD BlobInfo(uiPos AS DWORD, uiOrdinal AS DWORD) AS OBJECT
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL METHOD Compile(sBlock AS STRING) AS ICodeBlock
            LOCAL oBlock := NULL AS ICodeBlock
            TRY
                LOCAL oC AS IMacroCompiler
                oC := XSharp.RuntimeState.MacroCompiler
                LOCAL oType := typeof(Workarea) AS System.Type
                IF oC != NULL
                    LOCAL isBlock AS LOGIC
                    oBlock := oC:Compile(sBlock, TRUE, oType:Module, OUT isBlock)
                ENDIF
            CATCH e AS Exception
                XSharp.RuntimeState.LastRddError := e
            END TRY
            RETURN oBlock

            /// <inheritdoc />
        VIRTUAL METHOD EvalBlock(oBlock AS ICodeBlock) AS OBJECT
            // Todo: Save and restore workarea
            RETURN oBlock:EvalBlock()

            /// <inheritdoc />
        VIRTUAL METHOD Info(nOrdinal AS INT, oNewValue AS OBJECT) AS OBJECT
            LOCAL oResult AS OBJECT
            // todo check basic implementation
            SWITCH nOrdinal
            CASE DBI_ISDBF
            CASE DBI_CANPUTREC
            CASE DBI_ISFLOCK
            CASE DBI_TRANSREC
            CASE DBI_RM_SUPPORTED
                oResult := FALSE
            CASE DBI_SHARED
                oResult := SELF:_Shared
            CASE DBI_ISREADONLY
                oResult := SELF:_ReadOnly
            CASE DBI_GETDELIMITER
                oResult := SELF:_Delimiter
            CASE DBI_SEPARATOR
                oResult := SELF:_Separator
            CASE DBI_SETDELIMITER
                    oResult := SELF:_Separator
                    IF oNewValue != NULL .AND. oNewValue:GetType() == TYPEOF(STRING)
                        SELF:_Separator	:= (STRING) oNewValue
                ENDIF
            CASE DBI_DB_VERSION
            CASE DBI_RDD_VERSION
                oResult := ""
            CASE DBI_GETHEADERSIZE
            CASE DBI_LOCKCOUNT
                oResult := 0
            CASE DBI_GETRECSIZE
                oResult := SELF:_RecordLength
            CASE DBI_LASTUPDATE
                oResult := DateTime.MinValue
            CASE DBI_GETLOCKARRAY
                oResult := <DWORD>{}
            CASE DBI_BOF
                oResult := SELF:_BOF
            CASE DBI_EOF
                oResult := SELF:_EOF
            CASE DBI_DBFILTER
                oResult := SELF:_FilterInfo?:FilterText
            CASE DBI_FOUND
                oResult := SELF:_Found
            CASE DBI_FCOUNT
                oResult := (INT) _Fields?:Length
            CASE DBI_ALIAS
                oResult := _Alias
            CASE DBI_FULLPATH
                    oResult := SELF:_FileName
                    // CASE DBI_CHILDCOUNT:
                    // CASE DBI_TABLEEXT
                    // CASE DBI_SCOPEDRELATION
                    // CASE DBI_POSITIONED
                // CASE DBI_CODEPAGE
            OTHERWISE
                oResult := NULL
            END SWITCH
            RETURN oResult

            /// <inheritdoc />
        VIRTUAL METHOD RecInfo(oRecID AS OBJECT, nOrdinal AS LONG, oNewValue AS OBJECT) AS OBJECT
            LOCAL oResult AS OBJECT
            //Todo: Basic implementation of Recno deleted etc.
            SWITCH nOrdinal

                // etc
            OTHERWISE
                oResult := NULL
            END SWITCH
            RETURN oResult

            /// <inheritdoc />
        VIRTUAL METHOD Sort(info AS DbSortInfo) AS LOGIC
            THROW NotImplementedException{__ENTITY__}

            /// <inheritdoc />
        VIRTUAL PROPERTY Alias AS STRING GET _Alias SET _Alias := VALUE

        /// <inheritdoc />
        VIRTUAL PROPERTY Area AS DWORD GET _Area SET _Area := VALUE

        /// <inheritdoc />
        VIRTUAL PROPERTY BoF AS LOGIC GET _Bof

        /// <inheritdoc />
        VIRTUAL PROPERTY Deleted AS LOGIC GET FALSE

        /// <inheritdoc />
        VIRTUAL PROPERTY Driver AS STRING GET "Workarea"

        /// <inheritdoc />
        VIRTUAL PROPERTY EoF AS LOGIC GET _Eof

        /// <inheritdoc />
        VIRTUAL PROPERTY Exclusive AS LOGIC GET FALSE

        /// <inheritdoc />
        VIRTUAL PROPERTY FieldCount AS LONG GET (LONG) _Fields?:Length

        /// <inheritdoc />
        VIRTUAL PROPERTY FilterText AS STRING GET _FilterInfo?:FilterText

        /// <inheritdoc />
        VIRTUAL PROPERTY Found AS LOGIC GET _Order:Found SET _Order:Found := VALUE

        /// <inheritdoc />
        VIRTUAL PROPERTY RecCount AS INT GET 0

        /// <inheritdoc />
        VIRTUAL PROPERTY RecId AS OBJECT GET NULL
        /// <inheritdoc />
        VIRTUAL PROPERTY RecNo AS LONG GET   0

        /// <inheritdoc />
        VIRTUAL PROPERTY Shared AS LOGIC GET FALSE

        /// <inheritdoc />
        VIRTUAL PROPERTY SysName AS STRING GET TYPEOF(Workarea):ToString()

    END CLASS
	/// Base class for DBF based RDDs. Holds common propertis such as the Workarea number, Alias, Fields list and various flags.
	/// <seealso cref="T:XSharp.RDD.IRdd"/>
	CLASS Workarea IMPLEMENTS IRdd
		// This class does NOT implement file based (DBF stuff).
		// That is handled in the DBF class which inherits from RddBase
		#region Fields
		/// Workarea Number (1 based)
		PUBLIC _Area			AS DWORD
		///  Unique Alias
		PUBLIC _Alias			AS STRING
		/// File name of the main file
		PUBLIC _FileName		AS STRING
		/// List of Fields
		PUBLIC _Fields		    AS RddFieldInfo[]
		/// Is at BOF ?
		PUBLIC _Bof			    AS LOGIC
		/// Is at bottom ?
		PUBLIC _Bottom		    AS LOGIC
		/// Is at EOF ?
		PUBLIC _Eof			    AS LOGIC
		/// Result of last SEEK operation
		PUBLIC _Found			AS LOGIC
		/// Is at top?
		PUBLIC _Top			    AS LOGIC
		/// Result of last macro evaluation
		PUBLIC _Result		    AS OBJECT
		/// Current Scope
		PUBLIC _ScopeInfo		AS DbScopeInfo
		/// Current Filter
		PUBLIC _FilterInfo	    AS DbFilterInfo
		/// Current Order condition
		PUBLIC _OrderCondInfo	AS DbOrderCondInfo
		/// Current Relation info
		PUBLIC _RelInfo		    AS DbRelInfo
		PUBLIC _Relations       AS List<DbRelInfo>

		/// # of parents
		PUBLIC _Parents		    AS LONG
		/// Maximum fieldname length (Advantage supports field names > 10 characters)
		PUBLIC _MaxFieldNameLength AS LONG	//

		// Some flags that are stored here but managed in subclasses
		PUBLIC _TransRec		AS LOGIC
		/// Size of record
		PUBLIC _RecordLength	AS LONG
		/// Current Record
		PUBLIC _RecordBuffer	AS BYTE[]
		/// Field delimiter (for DELIM RDD)
		PUBLIC _Delimiter		AS STRING
		/// Field separator (for DELIM RDD)
		PUBLIC _Separator	    AS STRING
		///  Is the file opened ReadOnly ?
		PUBLIC _ReadOnly		AS LOGIC
		///  Is the file opened Shared ?
		PUBLIC _Shared			AS LOGIC
		/// File handle of the current file
		PUBLIC _hFile			AS IntPtr
		/// Should the file be flushed (it is dirty) ?
		PUBLIC _Flush			AS LOGIC

		// Memo and Order Implementation
		/// Current memo implementation.
		PUBLIC _Memo			AS IMemo
		/// Current index implementation.
		PUBLIC _Order			AS IOrder

		/// Result of the last Block evaluation.
		PUBLIC _EvalResult    AS OBJECT

		#endregion

		CONSTRUCTOR()
			SELF:_FilterInfo := DbFilterInfo{}
			SELF:_ScopeInfo  := DbScopeInfo{}
			SELF:_OrderCondInfo := DbOrderCondInfo{}
			SELF:_Relations  := List<DbRelInfo>{}
			SELF:_Parents	 := 0
			SELF:_RelInfo    := NULL
			SELF:_Memo		 := BaseMemo{SELF}
			SELF:_Order		 := BaseIndex{SELF}
			SELF:_Result	 := NULL
			SELF:_FileName	 := String.Empty
			SELF:_Fields	 := NULL
			SELF:_Area		 := 0
			SELF:_Shared	 := FALSE
			SELF:_ReadOnly   := FALSE
			SELF:_MaxFieldNameLength := 10

			SELF:_Alias		 := String.Empty
			SELF:_RecordBuffer := NULL
			/// <inheritdoc />
		VIRTUAL METHOD DbEval(info AS XSharp.RDD.DbEvalInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoTop( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoBottom( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoTo(nRec AS INT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoToId(oRec AS OBJECT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Skip(nToSkip AS INT) AS LOGIC
			LOCAL lToSkip AS LONG
			IF nToSkip == 0
				RETURN SELF:SkipRaw(0)
			ENDIF
			SELF:_Top := SELF:_Bottom := FALSE
			IF nToSkip > 0
				lToSkip := 1 	// Forward
			ELSE
				lToSkip := -1	// Backward
				nToSkip := - nToSkip
			ENDIF
			DO WHILE --nToSkip >= 0
				IF !SELF:SkipRaw(lToSkip)
					RETURN FALSE
				ENDIF
				IF !SELF:SkipFilter(lToSkip)
					RETURN FALSE
				ENDIF
				IF SELF:_BOF .OR. SELF:_EOF
					EXIT
				ENDIF
			ENDDO
			IF lToSkip < 0
				SELF:_EOF := FALSE
			ELSE
				SELF:_Bof := FALSE
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD SkipFilter(nToSkip AS INT) AS LOGIC
			LOCAL Bottom /*, Deleted */ AS LOGIC
			// When no active filter, record is Ok
			IF SELF:_FilterInfo == NULL_OBJECT .OR. ;
			!SELF:_FilterInfo:Active .OR. ;
			SELF:_FilterInfo:FilterBlock == NULL_OBJECT ;
			// .or. !SetDeleted()
				RETURN TRUE
			ENDIF
			nToSkip := IIF(nToSkip < 0 , -1, 1)
			Bottom := SELF:_Bottom
			RETURN FALSE
			/*
			WHILE( ! pArea->fBof && ! pArea->fEof )
			{
			/* SET DELETED * /
			IF( hb_setGetDeleted() )
			{
			IF( SELF_DELETED( pArea, &fDeleted ) != HB_SUCCESS )
			RETURN HB_FAILURE;
			IF( fDeleted )
			{
			IF( SELF_SKIPRAW( pArea, lUpDown ) != HB_SUCCESS )
			RETURN HB_FAILURE;
			continue;
			}
			}

			/* SET FILTER TO * /
			IF( pArea->dbfi.itmCobExpr )
			{
			IF( SELF_EVALBLOCK( pArea, pArea->dbfi.itmCobExpr ) != HB_SUCCESS )
			RETURN HB_FAILURE;

			IF( HB_IS_LOGICAL( pArea->valResult ) &&
			! hb_itemGetL( pArea->valResult ) )
			{
			IF( SELF_SKIPRAW( pArea, lUpDown ) != HB_SUCCESS )
			RETURN HB_FAILURE;
			continue;
			}
			}

			BREAK;
			}

			/*
			* The only one situation when we should repos is backward skipping
			* if we are at BOTTOM position (it's SKIPFILTER called from GOBOTTOM)
			* then GOEOF() if not then GOTOP()
			* /
			IF( pArea->fBof && lUpDown < 0 )
			{
			IF( fBottom )
			{
			/* GOTO EOF (phantom) record -
			this IS the only one place WHERE GOTO IS used BY Harbour
			directly and RDD which does not operate ON numbers should
			serve this METHOD only AS SELF_GOEOF() synonym. IF it's a
			problem then we can REMOVE this IF and always use SELF_GOTOP()
			but it also means second table scan IF all records filtered
			are OUT OF filter so I DO not want TO DO that. I will prefer
			explicit ADD SELF_GOEOF() METHOD
			* /
			errCode = SELF_GOTO( pArea, 0 );
			}
			ELSE
			{
			errCode = SELF_GOTOP( pArea );
			pArea->fBof = HB_TRUE;
			}
			}
			ELSE
			{
			errCode = HB_SUCCESS;
			}

			RETURN errCode;
			*/

			/// <inheritdoc />
		VIRTUAL METHOD SkipRaw(nToSkip AS INT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD SkipScope(nToSkip AS INT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Append(lReleaseLock AS LOGIC) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Delete( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GetRec( ) AS BYTE[]
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Pack( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD PutRec(aRec AS BYTE[]) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Recall( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Zap( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Close( ) AS LOGIC
			SELF:ClearFilter()
			SELF:ClearRel()
			SELF:ClearScope()
			// close all parent relations
			IF SELF:_Parents > 0
				//
				LOCAL max AS DWORD
				max := 4096 // RuntimeState.Workareas.MaxWorkAreas <- what's wrong here ??
				FOR VAR i := 1 TO max
					VAR rdd := XSharp.RuntimeState.Workareas:GetRDD( (DWORD)i )
					VAR wk := rdd ASTYPE Workarea
					IF ( wk != NULL ) .AND. ( wk != SELF )
						wk:_Relations:RemoveAll( SELF:isChildPredicate )
					ENDIF
				NEXT
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD Create(info AS XSharp.RDD.DbOpenInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Open(info AS XSharp.RDD.DbOpenInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD ClearFilter( ) AS LOGIC
			IF SELF:_FilterInfo != NULL
				SELF:_FilterInfo:Clear()
			ELSE
				SELF:_FilterInfo := DbFilterInfo{}
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD ClearScope( ) AS LOGIC
			IF SELF:_ScopeInfo != NULL
				SELF:_ScopeInfo:Clear()
			ELSE
				SELF:_ScopeInfo := DbScopeInfo{}
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD Continue( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GetScope( ) AS XSharp.RDD.DbScopeInfo
			IF SELF:_ScopeInfo != NULL_OBJECT
				RETURN SELF:_ScopeInfo:Clone()
			ENDIF
			RETURN DbScopeInfo{}

			/// <inheritdoc />
		VIRTUAL METHOD ScopeInfo(nOrdinal AS INT) AS OBJECT
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD SetFilter(info AS DbFilterInfo) AS LOGIC
			SELF:ClearFilter()
			IF (info != NULL_OBJECT)
				SELF:_FilterInfo := info:Clone()
				SELF:_FilterInfo:Active := TRUE
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD SetScope(info AS XSharp.RDD.DbScopeInfo) AS LOGIC
			SELF:ClearScope()
			IF (info != NULL_OBJECT)
				SELF:_ScopeInfo := info:Clone()
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD AddField(info AS RddFieldInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD CreateFields(fields AS RddFieldInfo[]) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD FieldIndex(fieldName AS STRING) AS INT
			LOCAL nMax AS INT
			nMax := SELF:FieldCount
			FOR VAR nFldPos := 0 TO nMax -1
				IF String.Compare(SELF:_Fields[nFldPos]:Name, fieldName, StringComparison.OrdinalIgnoreCase) == 0
					// Note that we must return 1 based fldPos
					RETURN nFldPos+1
				ENDIF
			NEXT
			RETURN 0

			/// <inheritdoc />
		PROTECTED METHOD _FieldIndexValidate(nFldPos AS LONG) AS LOGIC
			LOCAL nMax AS INT
			// Note that nFldPos is 1 based
			nMax := (INT) SELF:_Fields?:Length
			IF nFldPos <= 0 .OR. nFldPos > nMax
				THROW ArgumentException{"Invalid Field Index, must be between 1 and "+SELF:FieldCount:ToString(), NAMEOF(nFldPos)}
			ENDIF
			RETURN TRUE

			/// <inheritdoc />
		VIRTUAL METHOD FieldInfo(nFldPos AS LONG, nOrdinal AS LONG, oNewValue AS OBJECT) AS OBJECT
			// Note that nFldPos is 1 based
			IF SELF:_FieldIndexValidate(nFldPos)
				IF __ARRAYBASE__ == 0
					nFldPos -= 1
				ENDIF
			ENDIF
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD FieldName(nFldPos AS INT) AS STRING
			// Note that nFldPos is 1 based
			IF SELF:_FieldIndexValidate(nFldPos)
				IF __ARRAYBASE__ == 0
					nFldPos -= 1
				ENDIF
				RETURN SELF:_Fields[nFldPos]:Name
			ENDIF
			RETURN String.Empty

			/// <inheritdoc />
		VIRTUAL METHOD GetValue(nFldPos AS INT) AS OBJECT
			// Note that nFldPos is 1 based
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GetValueFile(nFldPos AS INT, fileName AS STRING) AS LOGIC
			// Note that nFldPos is 1 based
			RETURN _Memo:GetValueFile(nFldPos, fileName )

			/// <inheritdoc />
		VIRTUAL METHOD GetValueLength(nFldPos AS INT) AS INT
			// Note that nFldPos is 1 based
			RETURN _Memo:GetValueLength(nFldPos )

			/// <inheritdoc />
		VIRTUAL METHOD Flush( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoCold( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD GoHot( ) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD PutValue(nFldPos AS INT, oValue AS OBJECT) AS LOGIC
			// Note that nFldPos is 1 based
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD PutValueFile(nFldPos AS INT, fileName AS STRING) AS LOGIC
			// Note that nFldPos is 1 based
			RETURN _Memo:PutValueFile(nFldPos, fileName )

			/// <inheritdoc />
		VIRTUAL METHOD AppendLock(uiMode AS DbLockMode) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD HeaderLock(uiMode AS DbLockMode) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Lock(uiMode REF DbLockInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD UnLock(oRecId AS OBJECT) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD CloseMemFile( ) AS LOGIC
			RETURN SELF:_Memo:CloseMemFile()

			/// <inheritdoc />
		VIRTUAL METHOD CreateMemFile(info AS DbOpenInfo) AS LOGIC
			RETURN SELF:_Memo:CreateMemFile(info)

			/// <inheritdoc />
		VIRTUAL METHOD OpenMemFile( info AS DbOpenInfo) AS LOGIC
			RETURN SELF:_Memo:OpenMemFile(info )

			#region Orders Not implemented

			/// <inheritdoc />
			VIRTUAL METHOD OrderCondition(info AS DbOrderCondInfo) AS LOGIC
				RETURN SELF:_Order:OrderCondition(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderCreate(info AS DbOrderCreateInfo) AS LOGIC
				RETURN SELF:_Order:OrderCreate(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderDestroy(info AS DbOrderInfo) AS LOGIC
				RETURN SELF:_Order:OrderDestroy(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderInfo(nOrdinal AS DWORD, info AS DbOrderInfo) AS OBJECT
				/* CA-Cl*pper does not generate RT error when default ORDERINFO() method
				* is called
				*/
				RETURN SELF:_Order:OrderInfo(nOrdinal, info)

			/// <inheritdoc />
			VIRTUAL METHOD OrderListAdd(info AS DbOrderInfo) AS LOGIC
				RETURN SELF:_Order:OrderListAdd(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderListDelete(info AS DbOrderInfo) AS LOGIC
				RETURN SELF:_Order:OrderListDelete(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderListFocus(info AS DbOrderInfo) AS LOGIC
				RETURN SELF:_Order:OrderListFocus(info)

				/// <inheritdoc />
			VIRTUAL METHOD OrderListRebuild( ) AS LOGIC
				RETURN SELF:_Order:OrderListRebuild()

				/// <inheritdoc />
			VIRTUAL METHOD Seek(info AS DbSeekInfo) AS LOGIC
				RETURN SELF:_Order:Seek(info)
				#endregion

			#region Relations

			/// <inheritdoc />
			VIRTUAL METHOD ChildEnd(info AS DbRelInfo) AS LOGIC
				SELF:_Parents --
				RETURN TRUE

				/// <inheritdoc />
			VIRTUAL METHOD ChildStart(info AS DbRelInfo) AS LOGIC
				SELF:_Parents ++
				RETURN TRUE

				/// <inheritdoc />
			VIRTUAL METHOD ChildSync(info AS DbRelInfo) AS LOGIC
				THROW NotImplementedException{__ENTITY__}

			PRIVATE METHOD isChildPredicate( info AS DbRelInfo ) AS LOGIC
				// Is Child ?
				RETURN ( info:Child == SELF )

				/// <inheritdoc />
			VIRTUAL METHOD ClearRel( ) AS LOGIC
				LOCAL isOk AS LOGIC
				//
				isOk := TRUE
				//
				FOREACH info AS DbRelInfo IN SELF:_Relations
					isOk := isOk .AND. info:Child:ChildEnd( info )
				NEXT
				SELF:_Relations:Clear()
				RETURN isOk

				/// <inheritdoc />
			VIRTUAL METHOD ForceRel( ) AS LOGIC
				THROW NotImplementedException{__ENTITY__}

				/// <inheritdoc />
			VIRTUAL METHOD RelArea(nRelNum AS DWORD) AS DWORD
				LOCAL areaNum := 0 AS DWORD
				IF ( nRelNum < SELF:_Relations:Count )
					areaNum := SELF:_Relations[ (INT)nRelNum ]:Child:Area
				ENDIF
				RETURN areaNum

				/// <inheritdoc />
			VIRTUAL METHOD RelEval(info AS DbRelInfo) AS LOGIC
				LOCAL currentWk AS DWORD
				//
				currentWk := XSharp.RuntimeState.Workareas:CurrentWorkAreaNO
				TRY
					XSharp.RuntimeState.CurrentWorkArea := info:Parent:Area
					SELF:_EvalResult := info:Block:EvalBlock()
				FINALLY
					XSharp.RuntimeState.Workareas:CurrentWorkAreaNO := currentWk
				END TRY
				RETURN ( SELF:_EvalResult != NULL )

				/// <inheritdoc />
			VIRTUAL METHOD RelText(nRelNum AS DWORD) AS STRING
				LOCAL textRelation := "" AS STRING
				IF ( nRelNum < SELF:_Relations:Count )
					textRelation := SELF:_Relations[ (INT)nRelNum ]:Key
				ENDIF
				RETURN textRelation

				/// <inheritdoc />
			VIRTUAL METHOD SetRel(info AS DbRelInfo) AS LOGIC
				IF !SELF:_Relations:Contains( info )
					SELF:_Relations:Add( info )
				ENDIF
				RETURN info:Child:ChildStart( info )

				/// <inheritdoc />
			VIRTUAL METHOD SyncChildren( ) AS LOGIC
				LOCAL isOk AS LOGIC
				//
				isOk := TRUE
				//
				FOREACH info AS DbRelInfo IN SELF:_Relations
					isOk := info:Child:ChildSync( info )
					IF !isOk
						EXIT
					ENDIF
				NEXT
				RETURN isOk

				#endregion

			#region Trans not implemented

			/// <inheritdoc />
			VIRTUAL METHOD Trans(info AS DbTransInfo) AS LOGIC
				THROW NotImplementedException{__ENTITY__}

				/// <inheritdoc />
			VIRTUAL METHOD TransRec(info AS DbTransInfo) AS LOGIC
				THROW NotImplementedException{__ENTITY__}

				#endregion

			/// <inheritdoc />
		VIRTUAL METHOD BlobInfo(uiPos AS DWORD, uiOrdinal AS DWORD) AS OBJECT
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL METHOD Compile(sBlock AS STRING) AS ICodeBlock
			LOCAL oBlock := NULL AS ICodeBlock
			TRY
				LOCAL oC AS IMacroCompiler
				oC := XSharp.RuntimeState.MacroCompiler
				LOCAL oType := typeof(Workarea) AS System.Type
				IF oC != NULL
					LOCAL isBlock AS LOGIC
					oBlock := oC:Compile(sBlock, TRUE, oType:Module, OUT isBlock)
				ENDIF
			CATCH e AS Exception
				XSharp.RuntimeState.LastRddError := e
			END TRY
			RETURN oBlock

			/// <inheritdoc />
		VIRTUAL METHOD EvalBlock(oBlock AS ICodeBlock) AS OBJECT
			RETURN oBlock:EvalBlock()

			/// <inheritdoc />
		VIRTUAL METHOD Info(nOrdinal AS INT, oNewValue AS OBJECT) AS OBJECT
			LOCAL oResult AS OBJECT
			SWITCH nOrdinal
			CASE DBI_ISDBF
				CASE DBI_CANPUTREC
				CASE DBI_ISFLOCK
				CASE DBI_TRANSREC
				CASE DBI_RM_SUPPORTED
					oResult := FALSE
				CASE DBI_SHARED
					oResult := SELF:_Shared
				CASE DBI_ISREADONLY
					oResult := SELF:_ReadOnly
				CASE DBI_GETDELIMITER
					oResult := SELF:_Delimiter
				CASE DBI_SEPARATOR
					oResult := SELF:_Separator
				CASE DBI_SETDELIMITER
					oResult := SELF:_Separator
					IF oNewValue != NULL .AND. oNewValue:GetType() == TYPEOF(STRING)
						SELF:_Separator	:= (STRING) oNewValue
					ENDIF
				CASE DBI_DB_VERSION
				CASE DBI_RDD_VERSION
					oResult := ""
				CASE DBI_GETHEADERSIZE
				CASE DBI_LOCKCOUNT
					oResult := 0
				CASE DBI_GETRECSIZE
					oResult := SELF:_RecordLength
				CASE DBI_LASTUPDATE
					oResult := DateTime.MinValue
				CASE DBI_GETLOCKARRAY
					oResult := <DWORD>{}
				CASE DBI_BOF
					oResult := SELF:_BOF
				CASE DBI_EOF
					oResult := SELF:_EOF
				CASE DBI_DBFILTER
					oResult := SELF:_FilterInfo?:FilterText
				CASE DBI_FOUND
					oResult := SELF:_Found
				CASE DBI_FCOUNT
					oResult := (INT) _Fields?:Length
				CASE DBI_ALIAS
					oResult := _Alias
				CASE DBI_FULLPATH
					oResult := SELF:_FileName
					// CASE DBI_CHILDCOUNT:
					// CASE DBI_TABLEEXT
					// CASE DBI_SCOPEDRELATION
					// CASE DBI_POSITIONED
					// CASE DBI_CODEPAGE
				OTHERWISE
					oResult := NULL
				END SWITCH
			RETURN oResult

			/// <inheritdoc />
		VIRTUAL METHOD RecInfo(oRecID AS OBJECT, nOrdinal AS LONG, oNewValue AS OBJECT) AS OBJECT
			LOCAL oResult AS OBJECT
			SWITCH nOrdinal

				// etc
				OTHERWISE
					oResult := NULL
			END SWITCH
			RETURN oResult

			/// <inheritdoc />
		VIRTUAL METHOD Sort(info AS DbSortInfo) AS LOGIC
			THROW NotImplementedException{__ENTITY__}

			/// <inheritdoc />
		VIRTUAL PROPERTY Alias AS STRING GET _Alias SET _Alias := VALUE

		/// <inheritdoc />
		VIRTUAL PROPERTY Area AS DWORD GET _Area SET _Area := VALUE

		/// <inheritdoc />
		VIRTUAL PROPERTY BoF AS LOGIC GET _Bof

		/// <inheritdoc />
		VIRTUAL PROPERTY Deleted AS LOGIC GET FALSE

		/// <inheritdoc />
		VIRTUAL PROPERTY Driver AS STRING GET "Workarea"

		/// <inheritdoc />
		VIRTUAL PROPERTY EoF AS LOGIC GET _Eof

		/// <inheritdoc />
		VIRTUAL PROPERTY Exclusive AS LOGIC GET FALSE

		/// <inheritdoc />
		VIRTUAL PROPERTY FieldCount AS LONG GET (LONG) _Fields?:Length

		/// <inheritdoc />
		VIRTUAL PROPERTY FilterText AS STRING GET _FilterInfo?:FilterText

		/// <inheritdoc />
		VIRTUAL PROPERTY Found AS LOGIC GET _Order:Found SET _Order:Found := VALUE

		/// <inheritdoc />
		VIRTUAL PROPERTY RecCount AS INT GET 0

		/// <inheritdoc />
		VIRTUAL PROPERTY RecId AS OBJECT GET NULL
		/// <inheritdoc />
		VIRTUAL PROPERTY RecNo AS LONG GET   0

		/// <inheritdoc />
		VIRTUAL PROPERTY Shared AS LOGIC GET FALSE

		/// <inheritdoc />
		VIRTUAL PROPERTY SysName AS STRING GET TYPEOF(Workarea):ToString()

	END CLASS
END NAMESPACE


better name

better name

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

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

import "../tests/Nat.prg"

kind Trees = NoTree | Pre (Tree d) Trees deriving syntax (ts) List(NoTree, Pre)

data ZoomCompley :: Tree e ~> Tree f ~> * where
  Nily :: ZoomCompley a a
  Consy :: Stack a b -> ZoomCompley b c -> ZoomCompley a c
 deriving List(cply)

data ZoomComplex :: Trees ~> * where
  Nilx :: ZoomComplex [()tr]ts
  Endx :: Stack a b -> ZoomComplex [a, b]ts
  Consx :: Stack a b -> ZoomComplex [b; c]ts -> ZoomComplex [a, b; c]ts
 deriving syntax (cplx) List(Nilx, Consx) Item(Endx)

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

-- define the Tree kind, a rose tree
-- note: we may need a two-level kind, since we need to track disjointness
--       of subtrees
-- todo: later we may want to have a label kind parameter too

data Tree :: Dir ~> *1 where
  Unit :: Tree Ver
  Ni :: Tree Hor
  Fork :: Tree d ~> Tree Hor ~> Tree Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree d ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork) Unit(In) -- "arbre"
-- http://www.papoulipoesique.com/wp-content/uploads/2013/06/arbre.jpg

-- define a proposition for subtrees
-- to be checked: TakeHead must ensure that all the node is consumed

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

-- now we can stack cards (these are zooms in Kock et al. parlance)

data Stack :: Tree d ~> Tree e ~> * where
  Corolla :: Corolla tr => Tree' tr -> Stack tr ()tr
  SubDone :: Stack ()tr []tr
  SubCont :: Stack ()tr tr -> Stack ()tr [tr]tr
  --Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod

  -- put a frame around a niche
  Frame :: (Equal {nodes tr} {nodeValence out}) => Stack tr out -> Stack tr out

  -- the following three grab a node (and possibly its offsprings) and incorporate it into a single card
  NodeDone :: Stack []tr [()tr]tr
  Pick :: {- EntireNode => -} Stack head prodhead -> Stack tail prodtail -> Stack [head; tail]tr [prodhead; prodtail]tr
  Exclude :: {- EntireNode => -} Stack tail prod -> Stack [()tr; tail]tr prod
  -- we need a way to sequence cards
  -- MultiCard :: ??? Disjoint a b 0 => Subtree a -> Subtree b -> Stack tr a [proda, prodb]tr

  On :: (Subtree tr' tr, Pointers 1t at out) => Stack tr' out' -> Stack tr out -> Tree' at -> Stack tr {graft out' at out}

  -- building niches
  NicheDone :: Stack ()tr []tr
  Niche :: Stack tr out -> Stack tr [out]tr
  Also :: () -- (Pointers 1t at tr)
         => Tree' at -> Stack tr' out' -> Stack tr out -> Stack {extgraft tr' at tr} [out'; out]tr

-- it remains to define corollas

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

--  o   --->  |
--  |         |

lolliCell :: Stack []tr ()tr
lolliCell = Corolla Done

--  |         |
--  o   --->  |
--  |         |

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Corolla $ Fork In Done

--              |
--  [o]   --->  o
--   |          |

lolliFrame :: Stack []tr [()tr]tr
lolliFrame = Encompass NodeDone

--   |          |
--  [o]   --->  o
--   |          |

dolliFrame :: Stack [()tr]tr [()tr]tr
dolliFrame = Encompass (Exclude NodeDone)

--   |          |
--   |          o
-- [[o]]  --->  |
--   |          o
--   |          |

stacked :: Stack [()tr]tr [[()tr]tr]tr
stacked = (dolliFrame `On` dolliFrame) (In `Fork` Done)

--   |
--  [|]   --->  o
--   |          |

crossed :: Stack ()tr []tr
crossed = SubDone

-- we can now join things
--
dolliForever = [dolliFrame; dolliForever]cply
nopetope = [crossed, lolliFrame; dolliForever]cply

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cply
neverstopetope = [crossed, lolliFrame, dolliCell; neverstopetope]cply
stopetope' = [crossed, lolliFrame; (dolliCell)cplx]cplx
stopetope'' = [crossed, lolliFrame, dolliCell]cplx

--   |          o
-- [[|]]  --->  |
--   |          o
--   |          |

drossed :: Stack ()tr [[]tr]tr
drossed = SubCont SubDone
-- drossed = (SubDone `On` NodeDone) In
-- Note: can we find a way to graft here? Then On would be feasible

-- ################################
-- ############  Niches ###########
-- ################################

--  |          +
--  |          |

-- this is a niche, but assume to be a frame
niche0 :: Stack ()tr []tr
niche0 = NicheDone

--  |           |
-- [|]          +
--  |           |

-- this is a niche, but assume to be a frame
niche1 :: Stack ()tr [[]tr]tr
niche1 = Also ()ar SubDone NicheDone

--  |         o   o
-- [|]  --->   \ /
-- [|]          +
--  |           |

-- this is a niche, but assume to be a frame
niche2 :: Stack ()tr [[]tr, []tr]tr
niche2 = Also ()ar SubDone niche1

--                |
--  |         o   o
-- [o]  --->   \ /
-- [|]          +
--  |           |

niche10 :: Stack [()tr]tr [[()tr]tr, []tr]tr
niche10 = Also ()ar (Exclude NodeDone) $ Niche SubDone

-- ################################
-- ############  Frames ###########
-- ################################

--   |              |
--  /|\         o   o
-- |[o]|  --->   \ /
-- |[|]|          o
--  \|/           |
--   |

cyclops :: Stack [()tr]tr [[()tr]tr, []tr]tr
cyclops = Frame niche10

-- Stacking, Valence, Affine subtree, Substitute at an affine position

-- counting Units in a tree

valence :: Tree d ~> Nat
{valence []tr} = 0t
{valence [head; tail]tr} = {plus {valence head} {valence tail}}
{valence ()tr} = 1t

-- counting siblings of a tree

nodeValence :: Tree d ~> Nat
{nodeValence []tr} = 0t
{nodeValence [head; tail]tr} = (1+{nodeValence tail})t

-- counting nodes in a tree

nodes :: Tree d ~> Nat
{nodes ()tr} = t
{nodes []tr} = 1t
{nodes [head; tail]tr} = {plus {nodes head} {nodes tail}}

-- nodeValenceAt: given a (multi)pointer, determine the node valences at those positions
--               WHERE     IN
nodeValenceAt :: Tree d ~> Tree e ~> Nat
{nodeValenceAt ()tr tree} = {nodeValence tree}
{nodeValenceAt []tr []tr} = 0t
{nodeValenceAt [head'; tail']tr [head; tail]tr} = {plus {nodeValenceAt head' head} {nodeValenceAt tail' tail}}

-- a pointer is a valence-1 subtree of a tree
-- it is used to mark a unit in a tree where substitution will occur
--
prop Pointers :: Nat ~> Tree d ~> Tree e ~> * where
  Finger :: Pointers 1t ()tr ()tr
  Finished :: Pointers 0t []tr []tr
  ThisWay :: Pointers 1t head' head -> Pointers n tail' tail -> Pointers (1+n)t [head'; tail']tr [head; tail]tr
  ElseWhere :: Pointers n tail' tail -> Pointers n [[]tr; tail']tr [head; tail]tr

-- http://en.wikipedia.org/wiki/Grafting
--
-- graft WHAT      WHERE     IN
graft :: Tree d ~> Tree e ~> Tree f ~> Tree f
{graft what ()tr ()tr} = what
{graft what []tr tr} = tr
{graft what [head'; tail']tr [head; tail]tr} = [{graft what head' head}; {graft what tail' tail}]tr

extgraft :: Tree what ~> Tree wher ~> Tree tree ~> Tree tree'
{extgraft what ()tr ()tr} = what
{extgraft what []tr ()tr} = ()tr
{extgraft what [head; tail]tr ()tr} = [{extgraft what head ()tr}; {extgraft what tail ()tr}]tr
{extgraft what []tr []tr} = []tr
{extgraft what []tr [head; tail]tr} = [head; tail]tr
{extgraft what [head'; tail']tr [head; tail]tr} = [{extgraft what head' head}; {extgraft what tail' tail}]tr

{- TODO? multiGraft :: Treelist -> where -> in -}

{- NOTE: we have an Omega bug here:

prompt> :norm {graft []tr ()tr ()tr}
Normalizes to:
  []tr

prompt> :kind []tr
[]tr :: Tree Hor  = []tr

prompt> :kind {graft []tr ()tr ()tr}
{graft []tr ()tr ()tr} :: Tree Ver  = {graft []tr ()tr ()tr}

... BUT: Hor /= Ver :-(
-}

-- substitution: replace a pointed node (of valence n) in a tree with an
-- other tree of (valence n) -- TODO

-- HERE IS A NICE RESEARCH QUESTION:
-- is it possible to "proof search" a Zoom?
-- i.e.
{-

class ZoomLike (int :: Tree) (out :: Tree) where
  zoom :: (Nodes int ~ Valence out) => Zoom int out

-}

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

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

import "../tests/Nat.prg"

kind Trees = NoTree | Pre (Tree d) Trees deriving syntax (ts) List(NoTree, Pre)

data ZoomCompley :: Tree e ~> Tree f ~> * where
  Nily :: ZoomCompley a a
  Consy :: Stack a b -> ZoomCompley b c -> ZoomCompley a c
 deriving List(cply)

data ZoomComplex :: Trees ~> * where
  Nilx :: ZoomComplex [()tr]ts
  Endx :: Stack a b -> ZoomComplex [a, b]ts
  Consx :: Stack a b -> ZoomComplex [b; c]ts -> ZoomComplex [a, b; c]ts
 deriving syntax (cplx) List(Nilx, Consx) Item(Endx)

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

-- define the Tree kind, a rose tree
-- note: we may need a two-level kind, since we need to track disjointness
--       of subtrees
-- todo: later we may want to have a label kind parameter too

data Tree :: Dir ~> *1 where
  Unit :: Tree Ver
  Ni :: Tree Hor
  Fork :: Tree d ~> Tree Hor ~> Tree Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree d ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork) Unit(In) -- "arbre"
-- http://www.papoulipoesique.com/wp-content/uploads/2013/06/arbre.jpg

-- define a proposition for subtrees
-- to be checked: TakeHead must ensure that all the node is consumed

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

-- now we can stack cards (these are zooms in Kock et al. parlance)

data Stack :: Tree d ~> Tree e ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr
  SubDone :: Stack ()tr []tr
  SubCont :: Stack ()tr tr -> Stack ()tr [tr]tr
  --Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod

  -- put a frame around a niche
  Frame :: (Equal {nodes tr} {nodeValence out}) => Stack tr out -> Stack tr out
  -- the following three grab a node (and possibly its offsprings) and incorporate it into a single card
  NodeDone :: Stack []tr [()tr]tr
  Pick :: {- EntireNode => -} Stack head prodhead -> Stack tail prodtail -> Stack [head; tail]tr [prodhead; prodtail]tr
  Exclude :: {- EntireNode => -} Stack tail prod -> Stack [()tr; tail]tr prod
  -- we need a way to sequence cards
  -- MultiCard :: ??? Disjoint a b 0 => Subtree a -> Subtree b -> Stack tr a [proda, prodb]tr

  On :: (Subtree tr' tr, Pointers 1t at out) => Stack tr' out' -> Stack tr out -> Tree' at -> Stack tr {graft out' at out}

  -- building niches
  NicheDone :: Stack ()tr []tr
  Niche :: Stack tr out -> Stack tr [out]tr
  Also :: () -- (Pointers 1t at tr)
         => Tree' at -> Stack tr' out' -> Stack tr out -> Stack {extgraft tr' at tr} [out'; out]tr

-- it remains to define corollas

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

--  o   --->  |
--  |         |

lolliCell :: Stack []tr ()tr
lolliCell = Empty Done

--  |         |
--  o   --->  |
--  |         |

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Empty $ Fork In Done

--              |
--  [o]   --->  o
--   |          |

lolliFrame :: Stack []tr [()tr]tr
lolliFrame = Encompass NodeDone

--   |          |
--  [o]   --->  o
--   |          |

dolliFrame :: Stack [()tr]tr [()tr]tr
dolliFrame = Encompass (Exclude NodeDone)

--   |          |
--   |          o
-- [[o]]  --->  |
--   |          o
--   |          |

stacked :: Stack [()tr]tr [[()tr]tr]tr
stacked = (dolliFrame `On` dolliFrame) (In `Fork` Done)

--   |
--  [|]   --->  o
--   |          |

crossed :: Stack ()tr []tr
crossed = SubDone

-- we can now join things
--
dolliForever = [dolliFrame; dolliForever]cply
nopetope = [crossed, lolliFrame; dolliForever]cply

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cply
neverstopetope = [crossed, lolliFrame, dolliCell; neverstopetope]cply
stopetope' = [crossed, lolliFrame; (dolliCell)cplx]cplx
stopetope'' = [crossed, lolliFrame, dolliCell]cplx

--   |          o
-- [[|]]  --->  |
--   |          o
--   |          |

drossed :: Stack ()tr [[]tr]tr
drossed = SubCont SubDone
-- drossed = (SubDone `On` NodeDone) In
-- Note: can we find a way to graft here? Then On would be feasible

-- ################################
-- ############  Niches ###########
-- ################################

--  |          +
--  |          |

-- this is a niche, but assume to be a frame
niche0 :: Stack ()tr []tr
niche0 = NicheDone

--  |           |
-- [|]          +
--  |           |

-- this is a niche, but assume to be a frame
niche1 :: Stack ()tr [[]tr]tr
niche1 = Also ()ar SubDone NicheDone

--  |         o   o
-- [|]  --->   \ /
-- [|]          +
--  |           |

-- this is a niche, but assume to be a frame
niche2 :: Stack ()tr [[]tr, []tr]tr
niche2 = Also ()ar SubDone niche1

--                |
--  |         o   o
-- [o]  --->   \ /
-- [|]          +
--  |           |

niche10 :: Stack [()tr]tr [[()tr]tr, []tr]tr
niche10 = Also ()ar (Exclude NodeDone) $ Niche SubDone

-- ################################
-- ############  Frames ###########
-- ################################

--   |              |
--  /|\         o   o
-- |[o]|  --->   \ /
-- |[|]|          o
--  \|/           |
--   |

cyclops :: Stack [()tr]tr [[()tr]tr, []tr]tr
cyclops = Frame niche10

-- Stacking, Valence, Affine subtree, Substitute at an affine position

-- counting Units in a tree

valence :: Tree d ~> Nat
{valence []tr} = 0t
{valence [head; tail]tr} = {plus {valence head} {valence tail}}
{valence ()tr} = 1t

-- counting siblings of a tree

nodeValence :: Tree d ~> Nat
{nodeValence []tr} = 0t
{nodeValence [head; tail]tr} = (1+{nodeValence tail})t

-- counting nodes in a tree

nodes :: Tree d ~> Nat
{nodes ()tr} = t
{nodes []tr} = 1t
{nodes [head; tail]tr} = {plus {nodes head} {nodes tail}}

-- nodeValenceAt: given a (multi)pointer, determine the node valences at those positions
--               WHERE     IN
nodeValenceAt :: Tree d ~> Tree e ~> Nat
{nodeValenceAt ()tr tree} = {nodeValence tree}
{nodeValenceAt []tr []tr} = 0t
{nodeValenceAt [head'; tail']tr [head; tail]tr} = {plus {nodeValenceAt head' head} {nodeValenceAt tail' tail}}

-- a pointer is a valence-1 subtree of a tree
-- it is used to mark a unit in a tree where substitution will occur
--
prop Pointers :: Nat ~> Tree d ~> Tree e ~> * where
  Finger :: Pointers 1t ()tr ()tr
  Finished :: Pointers 0t []tr []tr
  ThisWay :: Pointers 1t head' head -> Pointers n tail' tail -> Pointers (1+n)t [head'; tail']tr [head; tail]tr
  ElseWhere :: Pointers n tail' tail -> Pointers n [[]tr; tail']tr [head; tail]tr

-- http://en.wikipedia.org/wiki/Grafting
--
-- graft WHAT      WHERE     IN
graft :: Tree d ~> Tree e ~> Tree f ~> Tree f
{graft what ()tr ()tr} = what
{graft what []tr tr} = tr
{graft what [head'; tail']tr [head; tail]tr} = [{graft what head' head}; {graft what tail' tail}]tr

extgraft :: Tree what ~> Tree wher ~> Tree tree ~> Tree tree'
{extgraft what ()tr ()tr} = what
{extgraft what []tr ()tr} = ()tr
{extgraft what [head; tail]tr ()tr} = [{extgraft what head ()tr}; {extgraft what tail ()tr}]tr
{extgraft what []tr []tr} = []tr
{extgraft what []tr [head; tail]tr} = [head; tail]tr
{extgraft what [head'; tail']tr [head; tail]tr} = [{extgraft what head' head}; {extgraft what tail' tail}]tr

{- TODO? multiGraft :: Treelist -> where -> in -}

{- NOTE: we have an Omega bug here:

prompt> :norm {graft []tr ()tr ()tr}
Normalizes to:
  []tr

prompt> :kind []tr
[]tr :: Tree Hor  = []tr

prompt> :kind {graft []tr ()tr ()tr}
{graft []tr ()tr ()tr} :: Tree Ver  = {graft []tr ()tr ()tr}

... BUT: Hor /= Ver :-(
-}

-- substitution: replace a pointed node (of valence n) in a tree with an
-- other tree of (valence n) -- TODO

-- HERE IS A NICE RESEARCH QUESTION:
-- is it possible to "proof search" a Zoom?
-- i.e.
{-

class ZoomLike (int :: Tree) (out :: Tree) where
  zoom :: (Nodes int ~ Valence out) => Zoom int out

-}


implement fits-into

implement fits-into

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

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

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

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

data HiddenLev :: *1 where
  HideLev :: Lev m ~> HiddenLev

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

data Signature = Sig

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

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

data Icelevel :: HiddenLev ~> HiddenLev ~> * where -- entities with certain level
  LevelConstructor :: Label t -> Level l -> Signature -> Icelevel (HideLev l) (HideLev l)

builtIn :: Thrist Iceberg () ()
builtIn = [ Constructor `Z 0l Sig, Constructor `S 0l Sig, Constructor natPrime 0l Sig
          , Constructor `Z 1l Sig, Constructor `S 1l Sig, Constructor `Nat 2l Sig]t
  where HideLabel natPrime = newLabel "Nat'"

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

projectLevel :: Level l -> Thrist Iceberg () () -> Thrist Icelevel (HideLev l) (HideLev l)
projectLevel _ []t = []t
{-
projectLevel l [Constructor t l' sig; rest]t = case sameLevel l l' of
                                               Just (Eq, Eq) -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               _ -> projectLevel l rest

sameLevel :: Level l -> Level l' -> Maybe (Equal l l', Equal (HideLev l) (HideLev l'))
sameLevel ValueLevel ValueLevel = Just (Eq, Eq)
sameLevel PolyLevel PolyLevel = Just (Eq, Eq)
sameLevel (LevelUp l) (LevelUp l') = do (Eq, Eq) <- sameLevel l l'
                                        return (Eq, Eq)
                                      where monad maybeM
-}

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

-- should be LevelFits
prop LevelSubsumes :: Lev n ~> Lev n' ~> * where
  BothValue :: LevelSubsumes ValueLevel ValueLevel
  BothPoly :: LevelSubsumes PolyLevel PolyLevel
  BothUp :: LevelSubsumes k k' -> LevelSubsumes (LevelUp k) (LevelUp k')
  UpValuePoly :: LevelSubsumes (LevelUp ValueLevel) PolyLevel
  --Commutes :: LevelSubsumes k k' => LevelSubsumes k' k -- NOT!

-- should be 'fits'
subsumes :: Level l -> Level l' -> Maybe (LevelSubsumes l l')
subsumes ValueLevel ValueLevel = Just BothValue
subsumes PolyLevel PolyLevel = Just BothPoly
subsumes (LevelUp l) (LevelUp l') = do ev <- subsumes l l'
                                       return $ BothUp ev
                                     where monad maybeM
subsumes (LevelUp ValueLevel) PolyLevel = Just UpValuePoly
subsumes _ _ = Nothing

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

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

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

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

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

data HiddenLev :: *1 where
  HideLev :: Lev m ~> HiddenLev

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

data Signature = Sig

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

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

data Icelevel :: HiddenLev ~> HiddenLev ~> * where -- entities with certain level
  LevelConstructor :: Label t -> Level l -> Signature -> Icelevel (HideLev l) (HideLev l)

builtIn :: Thrist Iceberg () ()
builtIn = [ Constructor `Z 0l Sig, Constructor `S 0l Sig, Constructor natPrime 0l Sig
          , Constructor `Z 1l Sig, Constructor `S 1l Sig, Constructor `Nat 2l Sig]t
  where HideLabel natPrime = newLabel "Nat'"

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

projectLevel :: Level l -> Thrist Iceberg () () -> Thrist Icelevel (HideLev l) (HideLev l)
projectLevel _ []t = []t
projectLevel l [Constructor t l' sig; rest]t = case sameLevel l l' of
                                               Just (Eq, Eq) -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               _ -> projectLevel l rest

sameLevel :: Level l -> Level l' -> Maybe (Equal l l', Equal (HideLev l) (HideLev l'))
sameLevel ValueLevel ValueLevel = Just (Eq, Eq)
sameLevel PolyLevel PolyLevel = Just (Eq, Eq)
sameLevel (LevelUp l) (LevelUp l') = do (Eq, Eq) <- sameLevel l l'
                                        return (Eq, Eq)
                                      where monad maybeM