--
--###############################################################
--# FDData, a base information medium for the SOME project: #
--###############################################################
-- John Ringland 2005/08/27

include SOME_Utilities.e

-- FDBits
global type FDBits(object b)
    return isNum(b) and b > 0
end type

-- Resolution = Limit/delta = 2^FDBits - 1
global type FDRes(object r)
    return isNum(r) and r >= 0
end type

-- FDIndex = squiggly delta
-- maximum value approximately 2^48 = 10^14
global type FDIndex(object v)
    return isNum(v) and v >= -1 and v-floor(v)=0 -- v=-1 means null value and it is an integer
end type

-- FDDelta = triangle delta
global type FDDelta(object d)
    return isNum(d) and d > 0
end type

-- FDMin = 0, by default
global type FDMin(object m)
    return isNum(m)
end type

-- FDMax = L, the limit
global type FDMax(object l)
    return isNum(l)
end type

-- FDValue = FDMin + FDIndex*FDDelta
global type FDValue(object v)
    return isNum(v)
end type

-- FDData = FDMin + FDIndex*FDDelta = FDMax - (FDRes - FDIndex)*FDDelta
-- FDMax = FDmin + FDRes*FDDelta
-- FDData = {FDIndex, FDDelta, FDMin, FDRes}
-- first three are generally required, the last gives
-- the maximum FDIndex and therefore FDMax and also FDBits.
global type FDData(object v)
    return sequence(v) and length(v)=4
           and FDIndex(v[1]) and FDDelta(v[2]) and FDMin(v[3]) and FDRes(v[4])
           and v[1] <= v[4] and FDBits(log2(v[4]+1))
end type

-- #######################################
-- # accessor functions for FDDatas: #
-- #######################################
global constant FDIND_ = 1
global constant FDDEL_ = 2
global constant FDMIN_ = 3
global constant FDRES_ = 4

global function fdCreate(FDBits b, FDMin min, FDMax max, FDIndex val)
    FDRes r
    FDDelta d
    FDData v

    r = power(2,b)-1
    d = (max - min)/r
    v = {val, d, min, r}
    return v
end function

global function fdIsNull(FDData v)
    return v[FDIND_]=-1
end function

global function fdIndex(FDData v)
    return v[FDIND_]
end function

-- returns the FDValue represented by the FDData
global function fdGet(FDData v)
    if fdIsNull(v) then
        error("Error: in function fdGet. Cannot evaluate a null FDData\n")
        return nan
    end if
    return v[FDMIN_] + v[FDIND_]*v[FDDEL_]
end function

global function fdSet(FDData v, atom val)
    object fdv
    if FDValue(val) then
        fdv = {floor((val-v[FDMIN_])/v[FDDEL_])} & v[FDDEL_..FDRES_]
        if FDData(fdv) then
            return fdv
        end if
    end if
    return {-1} & v[FDDEL_..FDRES_] -- a null FDData
end function

global function defaultFDV(atom val)
    if FDValue(val) then
        --                   bits  min   max  idx  value
        return fdSet(fdCreate(60, -1024, 1023, 0), val)
    else
        return fdSet(fdCreate(60, -1024, 1023, 0), nan) -- a null FDData
    end if
end function

global constant fdZero = defaultFDV(0)
global constant fdOne = defaultFDV(1)
global constant fdMinusOne = defaultFDV(-1)
global constant fdNan = {-1} & fdZero[FDDEL_..FDRES_]

-- note:
--      v = fdAdd(v, v1, v2)
-- is equivalent to
--      v = fdSet(v, fdGet(v1) + fdGet(v2))
global function fdAdd(FDData v, FDData v1, FDData v2)
    return fdSet(v, fdGet(v1) + fdGet(v2))
end function

global function fdSubtract(FDData v, FDData v1, FDData v2)
    return fdSet(v, fdGet(v1) - fdGet(v2))
end function
    
global function fdMultiply(FDData v, FDData v1, FDData v2)
    return fdSet(v, fdGet(v1) * fdGet(v2))
end function

global function fdDivide(FDData v, FDData v1, FDData v2)
    object val
    val = fdGet(v2)
    if val = 0 then 
        error("Error: In fdDivide. Cannot divide by zero.\n")
        return {-1} & v[FDDEL_..FDRES_] -- a null FDData
    end if
    return fdSet(v, fdGet(v1) / val)
end function

-- d should be an integer but the integer range is too small
global function fdInc(FDData v, atom d)
    object fdv 
    if not fdIsNull(v) then -- a Null FDData cannot be incremented
        fdv = {roundoff(v[FDIND_]+d)} & v[FDDEL_..FDRES_]
        if FDData(fdv) then
            return fdv
        end if
    end if
    return {-1} & v[FDDEL_..FDRES_] -- a null FDData
end function

global procedure FDdisp(FDData v)
--    if not fdIsNull(v) then
        ?v & fdGet(v)
--    end if
end procedure

procedure testFDData()
    FDData v1, v2, v3--, v4, v5, v6
    atom b, min, max
    
    b = 64
    min = -1000
    max = 1000
    v1 = fdCreate(b, min, max, power(2,b-1))
    v2 = fdCreate(b, min, max, power(2,b-1))
    v3 = fdCreate(b, min, max, 0)
    
    for i = 1 to 200 do
        puts(1,"#### Another round ####\n")
        --trace(1)
        FDdisp(v1)
        FDdisp(v2)
        FDdisp(fdAdd(v3,v1,v2))
--        ? fdGet(v1) + fdGet(v2)
        FDdisp(fdSubtract(v3,v1,v2))
--        ? fdGet(v1) - fdGet(v2)
        FDdisp(fdMultiply(v3,v1,v2))
--        ? fdGet(v1) * fdGet(v2)
        FDdisp(fdDivide(v3,v1,v2))
--        if fdGet(v2) != 0 then
--            ? fdGet(v1) / fdGet(v2)
--        else
--            puts(1,"infinity\n")
--        end if
        v1 = fdInc(v1,1e15)
        v2 = fdInc(v2,-1e15)
    end for
end procedure

-- there is constant entropy being produced
-- and it is easy to get an overflow error.
-- testFDData()

www.Anandavala.info