simplify

simplify

-- item notation

-- basic: http://www.cedar-forest.org/forest/talks/talks2001/talkPPDP2001.ps
-- extended: http://www.cedar-forest.org/forest/talks/talks2001/microsoft.ps

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

data Itm :: Inventory Tag ~> * where
  -- applicator wagon
  IApp :: Itm inv -> Itm inv -> Itm inv
  -- abstractor wagon
  IAbs :: Label n -> Itm [inv; n]i -> Itm inv
  -- argument access
  IArg :: Itm [ups; t]i
  IUp :: Itm [ups; t]i -> Itm [ups; t, t']i
 deriving syntax (it) Nat(IArg, IUp)

iota :: Tm inv -> Itm inv
iota Arg = IArg
iota (Up m) = IUp (iota m)
iota (Lm n b) = IAbs n (iota b)
iota (App f a) = IApp (iota a) (iota f)

slide1 = iota (Lm `x (Lm `y (1tm,0tm)tm), 0tm)tm  -- assuming `z = 0tm

-- ok now, let's drift to thrists

data Wagon :: Inventory Tag ~> Inventory Tag ~> * where
  AppW :: Thrist Wagon inv inv'' -> Wagon inv' inv
  AbsW :: Label n -> Wagon inv [inv; n]i
  ArgW :: Wagon [ups; t]i [ups; t]i
  UpW :: Wagon [ups; t]i [ups; t]i -> Wagon [ups; t, t']i [ups; t, t']i
 deriving syntax (w) Nat(ArgW, UpW) Item(AppW)

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)

theta :: Tm inv -> exists inv' . Thrist Wagon inv inv'
theta Arg = Ex [ArgW]t
theta (Up m) = case ensureVar m' of -- Note: NOT TOTAL!
               Just Eq -> Ex [UpW  m']t
    where (Ex thr) = theta m
    	  [m']t = thr
          ensureVar :: Wagon i j -> Maybe (Equal i j)
          ensureVar ArgW = Just Eq
          ensureVar (UpW v) = do { Eq <- ensureVar v; return Eq }
          monad maybeM

theta (Lm n b) = Ex [AbsW n; thr]t where (Ex thr) = theta b
theta (App f a) = Ex [(a')w; f']t
    where (Ex a') = theta a
          (Ex f') = theta f

-- item notation

-- basic: http://www.cedar-forest.org/forest/talks/talks2001/talkPPDP2001.ps
-- extended: http://www.cedar-forest.org/forest/talks/talks2001/microsoft.ps

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

data Itm :: Inventory Tag ~> * where
  -- applicator wagon
  IApp :: Itm inv -> Itm inv -> Itm inv
  -- abstractor wagon
  IAbs :: Label n -> Itm [inv; n]i -> Itm inv
  -- argument access
  IArg :: Itm [ups; t]i
  IUp :: Itm [ups; t]i -> Itm [ups; t, t']i
 deriving syntax (it) Nat(IArg, IUp)

iota :: Tm inv -> Itm inv
iota Arg = IArg
iota (Up m) = IUp (iota m)
iota (Lm n b) = IAbs n (iota b)
iota (App f a) = IApp (iota a) (iota f)

slide1 = iota (Lm `x (Lm `y (1tm,0tm)tm), 0tm)tm  -- assuming `z = 0tm

-- ok now, let's drift to thrists

data Wagon :: Inventory Tag ~> Inventory Tag ~> * where
  AppW :: Thrist Wagon inv inv'' -> Wagon inv' inv
  AbsW :: Label n -> Wagon inv [inv; n]i
  ArgW :: Wagon [ups; t]i [ups; t]i
  UpW :: Wagon [ups; t]i [ups; t]i -> Wagon [ups; t, t']i [ups; t, t']i
 deriving syntax (w) Nat(ArgW, UpW) Item(AppW)

data Thrist :: forall (l :: *1) . (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)

theta :: Tm inv -> exists inv' . Thrist Wagon inv inv'
theta Arg = Ex [ArgW]t
theta (Up m) = case ensureVar m' of -- Note: NOT TOTAL!
               Just Eq -> Ex [UpW  m']t
    where (Ex thr) = theta m
    	  [m']t = thr
          ensureVar :: Wagon i j -> Maybe (Equal i j)
          ensureVar ArgW = Just Eq
          ensureVar (UpW v) = do { Eq <- ensureVar v; return Eq }
          monad maybeM

theta (Lm n b) = Ex [AbsW n; thr]t where (Ex thr) = theta b
theta (App f a) = Ex [(a')w; f']t
    where (Ex a') = theta a
          (Ex f') = theta f


[Runtime] Updates for doc generation

[Runtime] Updates for doc generation

//
// 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.
//

#translate BETWEEN(<n1>, <n2>, <n3>)  => (<n1> >= <n2> .and. <n1> <= <n3>)
#define RANGE_ERROR "Value must be between 0 and 31"
#define TYPE_ERROR  "Value must be LONG or BINARY"
#define TYPE_ERROR2  "Value must be LONG"

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitand/*" />
FUNCTION BitAnd (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN BitHelpers._BITANDORX(BitOperation.And, Arg1, Arg2)
END FUNC
/// <include file="VFPDocs.xml" path="Runtimefunctions/bitand/*" />
FUNCTION BitAnd (Arg1 AS INT, Arg2 PARAMS INT[]) AS INT
    RETURN BitHelpers._BITANDORX(BitOperation.And, Arg1, Arg2)
END FUNC
/// <include file="VFPDocs.xml" path="Runtimefunctions/bitand/*" />
FUNCTION BitAnd(Arg1 AS BINARY, Arg2 PARAMS BINARY[]) AS BINARY
    RETURN BitHelpers._BITANDORX(BitOperation.And, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (Arg1 AS USUAL) AS BINARY
    RETURN BitClear((BINARY)Arg1)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (Arg1 AS USUAL, Bit AS USUAL) AS USUAL
    IF ! IsNumeric(Bit)
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bit),TYPE_ERROR, 2, {Bit})
    ENDIF
    IF IsBinary(Arg1)
        VAR binValue := (BINARY) Arg1
        RETURN IIF(binValue.Length == 0, 0h, BitClear(binValue, (INT)Bit, 1))
    ELSEIF IsNumeric(Arg1)
        RETURN BitClear((INT)Arg1, (INT)Bit)
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Arg1),TYPE_ERROR, 1, {Arg1})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (Arg1 AS USUAL, Arg2 AS USUAL, Arg3 AS USUAL) AS BINARY

    RETURN BitClear((BINARY)Arg1, (INT)Arg2, (INT)Arg3)

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (Num AS INT, Bit AS INT) AS INT

    IF BETWEEN(Bit, 0, 31)
        RETURN _AND(Num, _NOT(1 << Bit))
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bit),RANGE_ERROR, 2,{Bit})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (BinString AS BINARY) AS BINARY

    RETURN IIF(BinString.Length == 0, 0h, BitClear(BinString, 0, BinString.Length * 8))

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (BinString AS BINARY, StartBit AS INT) AS BINARY
    RETURN IIF(BinString.Length == 0, 0h, BitClear(BinString, StartBit, 1))
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (BinString AS BINARY, StartBit AS INT, BitCount AS INT) AS BINARY

    LOCAL Result := BinString AS BYTE[]
    LOCAL ByteIndex AS INT
    LOCAL BitIndex := StartBit AS INT
    LOCAL BitCounter AS INT

    FOR BitCounter := 1 TO BitCount

        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _AND(Result[ByteIndex], _NOT(1 << BitIndex % 8))
            BitIndex++
        ELSE
            THROW Error.ArgumentError(__FUNCTION__, nameof(StartBit),2)
        ENDIF

    NEXT

    RETURN (BINARY)Result

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitlshift/*" />
FUNCTION BitLShift (Arg AS INT, Bits AS INT) AS INT
    IF BETWEEN(Bits, 0, 31)
        RETURN Arg << Bits
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bits),RANGE_ERROR, 2,{Bits})
    ENDIF

END FUNC
/// <include file="VFPDocs.xml" path="Runtimefunctions/bitlshift/*" />
FUNCTION BitLShift (Arg AS USUAL, Bits AS USUAL) AS INT
    RETURN BitLShift((INT)Arg, (INT)Bits)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitnot/*" />
FUNCTION BitNot (Arg1 AS USUAL) AS USUAL
    IF IsBinary(Arg1)
        RETURN BitNot((BINARY)Arg1)
    ELSEIF IsNumeric(Arg1)
        RETURN BitNot((INT)Arg1)
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Arg1),TYPE_ERROR, 1, {Arg1})
    ENDIF
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitnot/*" />
FUNCTION BitNot (nNumericExpression AS INT) AS INT
    RETURN ~nNumericExpression
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitnot/*" />
FUNCTION BitNot (BinString AS BINARY) AS BINARY
    RETURN BitNot(BinString, 0, BinString.Length * 8)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitnot/*" />
FUNCTION BitNot (BinString AS BINARY, StartBit AS INT, BitCount := 1 AS INT) AS BINARY
    LOCAL Result := 0h + BinString AS BYTE[]
    LOCAL ByteIndex AS INT
    LOCAL BitIndex := StartBit AS INT
    LOCAL BitCounter AS INT

    FOR BitCounter := 1 TO BitCount

        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _XOR(Result[ByteIndex], 1 << BitIndex % 8)
            BitIndex++
        ELSE
            THROW Error.ArgumentError(__FUNCTION__, nameof(StartBit),2)
        ENDIF

    NEXT
    RETURN (BINARY)Result
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitor/*" />
FUNCTION BitOr (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN BitHelpers._BITANDORX(BitOperation.Or, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitor/*" />
FUNCTION BitOr (Arg1 AS INT, Arg2 PARAMS INT[]) AS INT
    RETURN BitHelpers._BITANDORX(BitOperation.Or, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitor/*" />
FUNCTION BitOr (Arg1 AS BINARY, Arg2 PARAMS BINARY[]) AS BINARY
    RETURN BitHelpers._BITANDORX(BitOperation.Or, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitrshift/*" />
FUNCTION BitRShift (Arg AS USUAL, Bits AS USUAL) AS INT
   IF IsNumeric(Arg) .AND. IsNumeric(Bits)
      RETURN BitRShift((INT)Arg, (INT)Bits)
   ENDIF
   IF ! IsNumeric(Arg)
     THROW Error.ArgumentError(__FUNCTION__, nameof(Arg),TYPE_ERROR2, 1, {Arg})
   ENDIF
   THROW Error.ArgumentError(__FUNCTION__, nameof(Bits),TYPE_ERROR2, 2, {Bits})

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitrshift/*" />
INTERNAL FUNCTION BitRShift (Arg AS INT, Bits AS INT) AS INT
    IF BETWEEN(Bits, 0, 31)
        IF !BitTest(Arg, 31) .OR. Bits == 0
            RETURN Arg >> Bits
        ELSE
            RETURN BitSet(BitClear(Arg, 31) >> Bits, 31 - Bits)
        ENDIF
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bits),RANGE_ERROR, 2,{Bits})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (Arg1 AS USUAL) AS BINARY
    RETURN BitSet((BINARY)Arg1)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (Arg1 AS USUAL, Bit AS USUAL) AS USUAL

    IF IsBinary(Arg1)
        RETURN BitSet((BINARY)Arg1, (INT)Bit, 1)
    ELSE
        RETURN BitSet((INT)Arg1, (INT)Bit)
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (BinString AS USUAL, StartBit AS USUAL, BitCount AS USUAL) AS BINARY
    RETURN BitSet((BINARY)BinString, (INT)StartBit, (INT)BitCount)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (Num AS INT, Bit AS INT) AS INT
    IF BETWEEN(Bit, 0, 31)
        RETURN _OR(Num, 1 << Bit)
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bit),RANGE_ERROR, 2,{Bit})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (BinString AS BINARY) AS BINARY

    RETURN IIF(BinString.Length == 0, 0h, BitSet(BinString, 0, BinString.Length * 8))

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (BinString AS BINARY, StartBit AS INT) AS BINARY

    RETURN IIF(BinString.Length == 0, 0h, BitSet(BinString, StartBit, 1))

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (BinString AS BINARY, StartBit AS INT, BitCount AS INT) AS BINARY

    LOCAL Result := 0h + BinString AS BYTE[]
    LOCAL ByteIndex AS INT
    LOCAL BitIndex := StartBit AS INT
    LOCAL BitCounter AS INT

    FOR BitCounter := 1 TO BitCount

        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _OR(Result[ByteIndex], 1 << BitIndex % 8)
            BitIndex++
        ELSE
            THROW Error.ArgumentError(__FUNCTION__, nameof(StartBit),2)
        ENDIF

    NEXT

    RETURN (BINARY)Result

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bittest/*" />
FUNCTION BitTest (Arg AS USUAL, Bit AS USUAL) AS LOGIC
    IF IsBinary(Arg)
      RETURN BitTest((BINARY)Arg, (INT)Bit)
    ELSEIF IsLong(Arg)
        RETURN BitTest((INT)Arg, (INT)Bit)
    ELSE
         THROW Error.ArgumentError(__FUNCTION__, nameof(Arg),TYPE_ERROR, 1, {Arg})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bittest/*" />
FUNCTION BitTest (Arg AS INT, Bit AS INT) AS LOGIC

    IF BETWEEN(Bit, 0, 31)
        RETURN _AND(Arg, 1 << Bit) != 0
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bit),RANGE_ERROR,2,{Bit})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bittest/*" />
FUNCTION BitTest (BinString AS BINARY, BitNumber AS INT) AS LOGIC

    LOCAL Buff := BinString AS BYTE[]

    IF BETWEEN(BitNumber, 0, Buff.Length * 8 - 1)
        RETURN _AND(Buff[BitNumber / 8 + 1], 1 << BitNumber % 8) != 0
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(BitNumber),2)
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitxor/*" />
FUNCTION BitXor (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN BitHelpers._BITANDORX(BitOperation.Xor, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitxor/*" />
FUNCTION BitXor (Arg1 AS INT, Arg2 PARAMS INT[]) AS INT
    RETURN BitHelpers._BITANDORX(BitOperation.Xor, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitxor/*" />
FUNCTION BitXor (Arg1 AS BINARY, Arg2 PARAMS BINARY[]) AS BINARY
    RETURN BitHelpers._BITANDORX(BitOperation.Xor, Arg1, Arg2)
END FUNC

INTERNAL STATIC CLASS BitHelpers
STATIC METHOD _BITANDORX (LogicalOp AS BitOperation, Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL

    IF IsBinary(Arg1)
        VAR Args = BINARY[]{Arg2.Length}
        LOCAL ArgIndex AS INT

        FOR ArgIndex := 1 TO Args.Length
            Args[ArgIndex] := (BINARY)Arg2[ArgIndex]
        NEXT

        RETURN _BITANDORX(LogicalOp, (BINARY)Arg1, Args)
    ELSEIF IsLong(Arg1)
        VAR Args = INT[]{Arg2.Length}
        LOCAL ArgIndex AS INT

        FOR ArgIndex := 1 TO Args.Length
            Args[ArgIndex] := (INT)Arg2[ArgIndex]
        NEXT

        RETURN _BITANDORX(LogicalOp, (INT)Arg1, Args)
    ELSE
       THROW Error.ArgumentError(__FUNCTION__, nameof(Arg1),TYPE_ERROR,1, {Arg1})
    ENDIF
END METHOD

STATIC METHOD _BITANDORX (LogicalOp AS BitOperation, Arg1 AS INT, Arg2 PARAMS INT[]) AS INT

    LOCAL Result := Arg1 AS INT
    LOCAL ArgIndex AS INT

    SWITCH LogicalOp
        CASE BitOperation.And
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _AND(Result, Arg2[ArgIndex])
            NEXT
        CASE BitOperation.Or
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _OR(Result, Arg2[ArgIndex])
            NEXT
        CASE BitOperation.Xor
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _XOR(Result, Arg2[ArgIndex])
            NEXT
        END

    RETURN Result

END METHOD

STATIC METHOD _BITANDORX (LogicalOp AS BitOperation, Arg1 AS BINARY, Arg2 PARAMS BINARY[]) AS BINARY

    LOCAL Result := 0h + Arg1 AS BYTE[]
    LOCAL ArgIndex AS INT

    FOR ArgIndex := 1 TO Arg2.Length
        LOCAL Arg := 0h + Arg2[ArgIndex] AS BYTE[]
        IF Result.Length < Arg.Length
            Array.Resize(Result, Arg.Length)
        ELSE
            IF Result.Length > Arg.Length
                Array.Resize(Arg, Result.Length)
            ENDIF
        ENDIF
        LOCAL ByteIndex AS INT
        SWITCH LogicalOp
            CASE BitOperation.And
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _AND(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            CASE BitOperation.Or
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _OR(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            CASE BitOperation.Xor
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _XOR(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            END

    ENDFOR

    RETURN (BINARY)Result

END METHOD

END CLASS

INTERNAL ENUM BitOperation
   MEMBER And
   MEMBER Or
   MEMBER Xor
END ENUM

//
// 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.
//

#translate BETWEEN(<n1>, <n2>, <n3>)  => (<n1> >= <n2> .and. <n1> <= <n3>)
#define RANGE_ERROR "Value must be between 0 and 31"
#define TYPE_ERROR  "Value must be LONG or BINARY"
#define TYPE_ERROR2  "Value must be LONG"

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitand/*" />
FUNCTION BitAnd (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN BitHelpers._BITANDORX(BitOperation.And, Arg1, Arg2)
END FUNC
/// <include file="VFPDocs.xml" path="Runtimefunctions/bitand/*" />
FUNCTION BitAnd (Arg1 AS INT, Arg2 PARAMS INT[]) AS INT
    RETURN BitHelpers._BITANDORX(BitOperation.And, Arg1, Arg2)
END FUNC
/// <include file="VFPDocs.xml" path="Runtimefunctions/bitand/*" />
FUNCTION BitAnd(Arg1 AS BINARY, Arg2 PARAMS BINARY[]) AS BINARY
    RETURN BitHelpers._BITANDORX(BitOperation.And, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (Arg1 AS USUAL) AS BINARY
    RETURN BitClear((BINARY)Arg1)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (Arg1 AS USUAL, Arg2 AS USUAL) AS USUAL
    IF ! IsNumeric(Arg2)
        THROW Error.ArgumentError(__FUNCTION__, nameof(Arg2),TYPE_ERROR, 2, {Arg2})
    ENDIF
    IF IsBinary(Arg1)
        VAR binary := (BINARY) Arg1
        RETURN IIF(binary.Length == 0, 0h, BitClear(binary, (INT)Arg2, 1))
    ELSEIF IsNumeric(Arg1)
        RETURN BitClear((INT)Arg1, (INT)Arg2)
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Arg1),TYPE_ERROR, 1, {Arg1})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (Arg1 AS USUAL, Arg2 AS USUAL, Arg3 AS USUAL) AS BINARY

    RETURN BitClear((BINARY)Arg1, (INT)Arg2, (INT)Arg3)

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (Num AS INT, Bit AS INT) AS INT

    IF BETWEEN(Bit, 0, 31)
        RETURN _AND(Num, _NOT(1 << Bit))
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bit),RANGE_ERROR, 2,{Bit})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (BinString AS BINARY) AS BINARY

    RETURN IIF(BinString.Length == 0, 0h, BitClear(BinString, 0, BinString.Length * 8))

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (BinString AS BINARY, StartBit AS INT) AS BINARY
    RETURN IIF(BinString.Length == 0, 0h, BitClear(BinString, StartBit, 1))
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitclear/*" />
FUNCTION BitClear (BinString AS BINARY, StartBit AS INT, BitCount AS INT) AS BINARY

    LOCAL Result := BinString AS BYTE[]
    LOCAL ByteIndex AS INT
    LOCAL BitIndex := StartBit AS INT
    LOCAL BitCounter AS INT

    FOR BitCounter := 1 TO BitCount

        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _AND(Result[ByteIndex], _NOT(1 << BitIndex % 8))
            BitIndex++
        ELSE
            THROW Error.ArgumentError(__FUNCTION__, nameof(StartBit),2)
        ENDIF

    NEXT

    RETURN (BINARY)Result

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitlshift/*" />
FUNCTION BitLShift (Arg AS INT, Bits AS INT) AS INT
    IF BETWEEN(Bits, 0, 31)
        RETURN Arg << Bits
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bits),RANGE_ERROR, 2,{Bits})
    ENDIF

END FUNC
/// <include file="VFPDocs.xml" path="Runtimefunctions/bitlshift/*" />
FUNCTION BitLShift (Arg AS USUAL, Bits AS USUAL) AS INT
    RETURN BitLShift((INT)Arg, (INT)Bits)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitnot/*" />
FUNCTION BitNot (Arg1 AS USUAL) AS USUAL
    IF IsBinary(Arg1)
        RETURN BitNot((BINARY)Arg1)
    ELSEIF IsNumeric(Arg1)
        RETURN BitNot((INT)Arg1)
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Arg1),TYPE_ERROR, 1, {Arg1})
    ENDIF
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitnot/*" />
FUNCTION BitNot (nNumericExpression AS INT) AS INT
    RETURN ~nNumericExpression
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitnot/*" />
FUNCTION BitNot (BinString AS BINARY) AS BINARY
    RETURN BitNot(BinString, 0, BinString.Length * 8)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitnot/*" />
FUNCTION BitNot (BinString AS BINARY, StartBit AS INT, BitCount := 1 AS INT) AS BINARY
    LOCAL Result := 0h + BinString AS BYTE[]
    LOCAL ByteIndex AS INT
    LOCAL BitIndex := StartBit AS INT
    LOCAL BitCounter AS INT

    FOR BitCounter := 1 TO BitCount

        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _XOR(Result[ByteIndex], 1 << BitIndex % 8)
            BitIndex++
        ELSE
            THROW Error.ArgumentError(__FUNCTION__, nameof(StartBit),2)
        ENDIF

    NEXT
    RETURN (BINARY)Result
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitor/*" />
FUNCTION BitOr (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN BitHelpers._BITANDORX(BitOperation.Or, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitor/*" />
FUNCTION BitOr (Arg1 AS INT, Arg2 PARAMS INT[]) AS INT
    RETURN BitHelpers._BITANDORX(BitOperation.Or, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitor/*" />
FUNCTION BitOr (Arg1 AS BINARY, Arg2 PARAMS BINARY[]) AS BINARY
    RETURN BitHelpers._BITANDORX(BitOperation.Or, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitrshift/*" />
FUNCTION BitRShift (Arg AS USUAL, Bits AS USUAL) AS INT
   IF IsNumeric(Arg) .AND. IsNumeric(Bits)
      RETURN BitRShift((INT)Arg, (INT)Bits)
   ENDIF
   IF ! IsNumeric(Arg)
     THROW Error.ArgumentError(__FUNCTION__, nameof(Arg),TYPE_ERROR2, 1, {Arg})
   ENDIF
   THROW Error.ArgumentError(__FUNCTION__, nameof(Bits),TYPE_ERROR2, 2, {Bits})

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitrshift/*" />
INTERNAL FUNCTION BitRShift (Arg AS INT, Bits AS INT) AS INT
    IF BETWEEN(Bits, 0, 31)
        IF !BitTest(Arg, 31) .OR. Bits == 0
            RETURN Arg >> Bits
        ELSE
            RETURN BitSet(BitClear(Arg, 31) >> Bits, 31 - Bits)
        ENDIF
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bits),RANGE_ERROR, 2,{Bits})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (Arg1 AS USUAL) AS BINARY
    RETURN BitSet((BINARY)Arg1)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (Arg1 AS USUAL, Bit AS USUAL) AS USUAL

    IF IsBinary(Arg1)
        RETURN BitSet((BINARY)Arg1, (INT)Bit, 1)
    ELSE
        RETURN BitSet((INT)Arg1, (INT)Bit)
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (BinString AS USUAL, StartBit AS USUAL, BitCount AS USUAL) AS BINARY
    RETURN BitSet((BINARY)BinString, (INT)StartBit, (INT)BitCount)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (Num AS INT, Bit AS INT) AS INT
    IF BETWEEN(Bit, 0, 31)
        RETURN _OR(Num, 1 << Bit)
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bit),RANGE_ERROR, 2,{Bit})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (BinString AS BINARY) AS BINARY

    RETURN IIF(BinString.Length == 0, 0h, BitSet(BinString, 0, BinString.Length * 8))

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (BinString AS BINARY, StartBit AS INT) AS BINARY

    RETURN IIF(BinString.Length == 0, 0h, BitSet(BinString, StartBit, 1))

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitset/*" />
FUNCTION BitSet (BinString AS BINARY, StartBit AS INT, BitCount AS INT) AS BINARY

    LOCAL Result := 0h + BinString AS BYTE[]
    LOCAL ByteIndex AS INT
    LOCAL BitIndex := StartBit AS INT
    LOCAL BitCounter AS INT

    FOR BitCounter := 1 TO BitCount

        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _OR(Result[ByteIndex], 1 << BitIndex % 8)
            BitIndex++
        ELSE
            THROW Error.ArgumentError(__FUNCTION__, nameof(StartBit),2)
        ENDIF

    NEXT

    RETURN (BINARY)Result

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bittest/*" />
FUNCTION BitTest (Arg1 AS USUAL, Arg2 AS USUAL) AS LOGIC
    IF IsBinary(Arg1)
      RETURN BitTest((BINARY)Arg1, (INT)Arg2)
    ELSEIF IsLong(Arg1)
        RETURN BitTest((INT)Arg1, (INT)Arg2)
    ELSE
         THROW Error.ArgumentError(__FUNCTION__, nameof(Arg1),TYPE_ERROR, 1, {Arg1})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bittest/*" />
FUNCTION BitTest (Arg AS INT, Bit AS INT) AS LOGIC

    IF BETWEEN(Bit, 0, 31)
        RETURN _AND(Arg, 1 << Bit) != 0
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(Bit),RANGE_ERROR,2,{Bit})
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bittest/*" />
FUNCTION BitTest (BinString AS BINARY, BitNumber AS INT) AS LOGIC

    LOCAL Buff := BinString AS BYTE[]

    IF BETWEEN(BitNumber, 0, Buff.Length * 8 - 1)
        RETURN _AND(Buff[BitNumber / 8 + 1], 1 << BitNumber % 8) != 0
    ELSE
        THROW Error.ArgumentError(__FUNCTION__, nameof(BitNumber),2)
    ENDIF

END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitxor/*" />
FUNCTION BitXor (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN BitHelpers._BITANDORX(BitOperation.Xor, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitxor/*" />
FUNCTION BitXor (Arg1 AS INT, Arg2 PARAMS INT[]) AS INT
    RETURN BitHelpers._BITANDORX(BitOperation.Xor, Arg1, Arg2)
END FUNC

/// <include file="VFPDocs.xml" path="Runtimefunctions/bitxor/*" />
FUNCTION BitXor (Arg1 AS BINARY, Arg2 PARAMS BINARY[]) AS BINARY
    RETURN BitHelpers._BITANDORX(BitOperation.Xor, Arg1, Arg2)
END FUNC

INTERNAL STATIC CLASS BitHelpers
STATIC METHOD _BITANDORX (LogicalOp AS BitOperation, Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL

    IF IsBinary(Arg1)
        VAR Args = BINARY[]{Arg2.Length}
        LOCAL ArgIndex AS INT

        FOR ArgIndex := 1 TO Args.Length
            Args[ArgIndex] := (BINARY)Arg2[ArgIndex]
        NEXT

        RETURN _BITANDORX(LogicalOp, (BINARY)Arg1, Args)
    ELSEIF IsLong(Arg1)
        VAR Args = INT[]{Arg2.Length}
        LOCAL ArgIndex AS INT

        FOR ArgIndex := 1 TO Args.Length
            Args[ArgIndex] := (INT)Arg2[ArgIndex]
        NEXT

        RETURN _BITANDORX(LogicalOp, (INT)Arg1, Args)
    ELSE
       THROW Error.ArgumentError(__FUNCTION__, nameof(Arg1),TYPE_ERROR,1, {Arg1})
    ENDIF
END METHOD

STATIC METHOD _BITANDORX (LogicalOp AS BitOperation, Arg1 AS INT, Arg2 PARAMS INT[]) AS INT

    LOCAL Result := Arg1 AS INT
    LOCAL ArgIndex AS INT

    SWITCH LogicalOp
        CASE BitOperation.And
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _AND(Result, Arg2[ArgIndex])
            NEXT
        CASE BitOperation.Or
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _OR(Result, Arg2[ArgIndex])
            NEXT
        CASE BitOperation.Xor
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _XOR(Result, Arg2[ArgIndex])
            NEXT
        END

    RETURN Result

END METHOD

STATIC METHOD _BITANDORX (LogicalOp AS BitOperation, Arg1 AS BINARY, Arg2 PARAMS BINARY[]) AS BINARY

    LOCAL Result := 0h + Arg1 AS BYTE[]
    LOCAL ArgIndex AS INT

    FOR ArgIndex := 1 TO Arg2.Length
        LOCAL Arg := 0h + Arg2[ArgIndex] AS BYTE[]
        IF Result.Length < Arg.Length
            Array.Resize(Result, Arg.Length)
        ELSE
            IF Result.Length > Arg.Length
                Array.Resize(Arg, Result.Length)
            ENDIF
        ENDIF
        LOCAL ByteIndex AS INT
        SWITCH LogicalOp
            CASE BitOperation.And
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _AND(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            CASE BitOperation.Or
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _OR(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            CASE BitOperation.Xor
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _XOR(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            END

    ENDFOR

    RETURN (BINARY)Result

END METHOD

END CLASS

INTERNAL ENUM BitOperation
   MEMBER And
   MEMBER Or
   MEMBER Xor
END ENUM