-- utilities for the SOME project
-- John Ringland 2005/08/27

--include machine.e -- for crash_message()
--include CONSTANT.e

global constant inf = power(10,308)*9
global constant nan = -inf/inf

-- log2() logarithm to the base two
global function log2(atom x)
    return log(x)/log(2)
end function

-- some basic error handling
-- maybe use the error handling in OOP.e?
global integer ABORT_ON_ERROR ABORT_ON_ERROR = 1
global integer SHOW_ERROR_MSGS SHOW_ERROR_MSGS = 1
global procedure error(sequence msg)
    if SHOW_ERROR_MSGS then
        puts(1, msg)
    end if
    if ABORT_ON_ERROR then 
        abort(1) 
    end if
end procedure

-- returns the smallest
global function smallest(object o1, object o2)
    if compare(o1,o2) then  -- o1 > o2
        return o2
    end if
    return o1
end function

-- returns the largest
global function largest(object o1, object o2)
    if compare(o1,o2) then  -- o1 > o2
        return o1
    end if
    return o2
end function

-- isNum tests if an atom is a valid number with a well defined value
-- NOTE: nan really symbolises 'any number', a number with an undefined value
-- beware
--?floor(nan) -- creates a machine level exception!
--
-- inf is a particular number, the largest particular number
-- but is used to signify overflow so the value cannot be trusted
global function isNum(object a)
    return atom(a) and not (equal(a,nan) or a = inf or a = -inf)
end function


-- returns the nearest integer
global function roundoff(atom a)
    atom x
    if not isNum(a) then
        return -1  -- roundoff used for FDIndex component and -1 means undefined
    end if
    x = floor(a)
    if a-x >= 0.5 then
        return x+1
    end if
    return x
end function

global function first(sequence s)
    return s[1]
end function

global function nth(sequence s, integer n)
    return s[n]
end function

global function log_n(atom x,atom n)
    if  n <= 0 then
        return nan
    else
        return log(x)/log(n)
    end if
end function

global function sign(atom a)
    if a < 0 then
        return -1
    elsif a = 0 then
        return 0
    else
        return 1
    end if
end function


global function abs(atom x)
    if x < 0 then
        return -x
    end if
    return x
end function

global function tail(sequence s)
    integer len len = length(s)
    if len > 0 then
        return s[len]
    end if
    error("Error in tail: len < 0\n")
    return s
end function

global function mod(atom a, atom b) -- returns a mod b
    if b!=0 then
        return a - abs(floor(a/b))*b
    end if
    return nan
end function