-- FILE:     MATHEVAL.E
-- PURPOSE:  Evaluate math expression function for Euphoria 3.1.1.
-- AUTHOR:   Shian Lee
-- VERSION:  1.00  January/22/2018
-- LANGUAGE: Euphoria version 3.1.1 (http://www.RapidEuphoria.com)
-- PLATFORM: Any
-- LICENCE:  Free. Use at your own risk.
-- NOTE:     * See the attached reference manual MATH.DOC for details.
--           * See also the demo 'meval.ex'.
--           * Created using edu.ex 2.05 (lib2, RapidEuphoria.com archive).
-- HISTORY:  v1.00 - initial version (January/22/2018).
-----------------------------------------------------------------------------



--bookmark: include Euphoria 3.1.1 and lib2 library files;

include get.e       -- value()
include misc.e      -- arcsin(), arccos(), PI
include math.e      -- mod(), ceil(), E, etc
include machine2.e  -- fix(), int(), TRUE, string(), etc



--bookmark: Euphoria Operators, Functions, and Constants;

constant
    -- precedence lists, used by calc_expr()
    PRECEDENCE_LISTS = {                    -- [index]
	EMPTY, -- (place holder)            -- [1]  parenthesis () (highest)
	EMPTY, -- (place holder)            -- [2]  function calls
	EMPTY, -- (place holder)            -- [3]  unary-  unary+  not
	{"*", "/"},                         -- [4]  *  /
	{"+", "-"},                         -- [5]  +  -
	{"<", ">", "<=", ">=", "=", "!="},  -- [6]  <  >  <=  >=  =  !=
	{"and", "or", "xor"}                -- [7]  and  or  xor
    },

    -- unary operators list, used by calc_unary_op()
    UNARY_OP_LIST = {"-", "+", "not"},

    -- operators list, indexes used by calc_op()
    OP_LIST = {
    --  1,   2,   3,   4,   5,   6,   7,    8,
	"*", "/", "+", "-", "<", ">", "<=", ">=",
    --  9,   10,   11,    12,   13,    14
	"=", "!=", "and", "or", "xor", "not"
    },

    -- functions list (Euphoria & lib2), indexes used by calc_func()
    FUNC_LIST = {
    --  1,       2,      3,     4,      5,       6,     7,
	"floor", "ceil", "fix", "frac", "round", "abs", "sign",
    --  8,      9,     10,      11,    12,          13,    14,
	"sqrt", "log", "power", "exp", "remainder", "mod", "rand",
    --  15,    16,    17,    18,     19,     20,
	"sin", "cos", "tan", "sinh", "cosh", "tanh",
    --  21,       22,       23,       24,        25,        26,
	"arcsin", "arccos", "arctan", "arcsinh", "arccosh", "arctanh",
    --  27,           28
	"deg_to_rad", "rad_to_deg"
    },

    -- constants list (paralleled lists, names & values), used by parse_expr()
    CONST_LIST = {
	"PI", "E", "PHI"
    },
    CONST_LIST_VALUES = {
	PI, E, PHI
    }



--bookmark: Error in Expression;

-- PURPOSE: commonly used error messages
constant
    ER_ILLEGAL_FUNCTION_CALL = "illegal function call",
    ER_MISSING_COMMA_OR_ARG = "missing comma or argument"


-- PURPOSE: error flag is set on any error, by any routine
-- NOTE:    calculation-error doesn't crash the program, it only sets a flag
integer
    error_occurred
    error_occurred = FALSE -- reset for debug -- see also math_eval()



-- PURPOSE: set local error-flag and return error message
-- RETURN:  string;
function error_msg(string message)
    error_occurred = TRUE
    return message
end function



--bookmark: Calculate Functions;

-- PURPOSE: convert sequence of comma-delimited-arguments to sequence of atoms
-- DETAILS: e is sequence of comma-delimited-arguments, e.g. {5, ",", 20.1}
-- RETURN:  sequence; result sequence or error_msg() string
-- EXAMPLE: s = args_to_atoms({10.4, ",", -3, ",", 40}) -- s is {10.4, -3, 40}
function args_to_atoms(sequence e)
    sequence atoms
    integer len

    atoms = EMPTY
    len = length(e)

    -- check for valid arguments, e.g. {}, {1.3}, {5, ",", 20, ",", 3.1}
    if len = 0 then
	return atoms
    elsif remainder(len, 2) and atom(e[len]) then
	for i = 1 to len - 1 by 2 do
	    if atom(e[i]) and equal(e[i + 1], ",") then
		atoms = append(atoms, e[i])
	    else
		return error_msg(ER_MISSING_COMMA_OR_ARG)
	    end if
	end for
	return append(atoms, e[len])
    else
	return error_msg(ER_MISSING_COMMA_OR_ARG)
    end if
end function



-- PURPOSE: calculate a function expression and return the result
-- DETAILS: i is the function index in FUNC_LIST
--          e is arguments for function, separated by ","
-- RETURN:  object; result atom or error_msg() string
-- EXAMPLE: x = calc_func(12, {12.45, ",", 2}) -- x is 0.45 (remainder)
function calc_func(integer i, sequence e)
    sequence args, er_name
    integer er_flag
    atom a1, a2, r

    er_name = FUNC_LIST[i] & "()"

    args = args_to_atoms(e)

    if error_occurred then
	return error_msg(ER_MISSING_COMMA_OR_ARG & " in " & er_name)
    end if

    er_flag = FALSE

    -- calculate function according to number of arguments
    if length(args) = 1 then
	a1 = args[1]

--  --  1,       2,      3,     4,      5,       6,     7,
--      "floor", "ceil", "fix", "frac", "round", "abs", "sign",
	   if i = 1  then   r = floor(a1)
	elsif i = 2  then   r = ceil(a1)
	elsif i = 3  then   r = fix(a1)
	elsif i = 4  then   r = frac(a1)
	elsif i = 5  then   r = round(a1)
	elsif i = 6  then   r = abs(a1)
	elsif i = 7  then   r = sign(a1)

--  --  8,      9,     10,      11,    12,          13,    14,
--      "sqrt", "log", "power", "exp", "remainder", "mod", "rand",
	elsif i = 8 and a1 >= 0 then    r = sqrt(a1)
	elsif i = 9 and a1 > 0 then     r = log(a1)
	elsif i = 11 then               r = exp(a1)
	elsif i = 14 and a1 >= 1 and
		    integer(a1) then    r = rand(a1)

--  --  15,    16,    17,    18,     19,     20,
--      "sin", "cos", "tan", "sinh", "cosh", "tanh",
	elsif i = 15 then   r = sin(a1)
	elsif i = 16 then   r = cos(a1)
	elsif i = 17 then   r = tan(a1)
	elsif i = 18 then   r = sinh(a1)
	elsif i = 19 then   r = cosh(a1)
	elsif i = 20 then   r = tanh(a1)

--  --  21,       22,       23,       24,        25,        26,
--      "arcsin", "arccos", "arctan", "arcsinh", "arccosh", "arctanh",
	elsif i = 21 and a1 >= -1 and a1 <= +1 then r = arcsin(a1)
	elsif i = 22 and a1 >= -1 and a1 <= +1 then r = arccos(a1)
	elsif i = 23 then                           r = arctan(a1)
	elsif i = 24 then                           r = arcsinh(a1)
	elsif i = 25 and a1 >= +1 then              r = arccosh(a1)
	elsif i = 26 and a1 > -1 and a1 < +1 then   r = arctanh(a1)

--  --  27,           28
--      "deg_to_rad", "rad_to_deg"
	elsif i = 27 then   r = deg_to_rad(a1)
	elsif i = 28 then   r = rad_to_deg(a1)

	else
	    er_flag = TRUE  -- illegal argument value
	end if

    elsif length(args) = 2 then
	a1 = args[1]
	a2 = args[2]

--  --  8,      9,     10,      11,    12,          13,    14,
--      "sqrt", "log", "power", "exp", "remainder", "mod", "rand",
	   if i = 10 and not
	    (a1 = 0 and a2 <= 0) then   r = power(a1, a2)
	elsif i = 12 and a2 != 0 then   r = remainder(a1, a2)
	elsif i = 13 and a2 != 0 then   r = mod(a1, a2)

	else
	    er_flag = TRUE  -- illegal argument value
	end if

    else
	er_flag = TRUE  -- wrong number of arguments
    end if

    if er_flag then
	return error_msg(ER_ILLEGAL_FUNCTION_CALL & ": " & er_name)
    else
	return r
    end if
end function



--bookmark: Calculate Operators;

-- PURPOSE: calculate an operator expression and return the result
-- DETAILS: e is expression with two atoms & one operator, e.g. {5, "*", -1}
-- RETURN:  object; result atom or error_msg() string
-- EXAMPLE: x = calc_op({5, "*", -1.5}) -- x is -7.5
function calc_op(sequence e)
    atom a1, a2, r
    integer i -- i is the operator index in OP_LIST

    if atom(e[1]) and atom(e[3]) then
	a1 = e[1]
	a2 = e[3]
	i = find(e[2], OP_LIST)
    else
	i = 0 -- syntax error in expression
    end if

--  --  1,   2,   3,   4,   5,   6,   7,    8,
--      "*", "/", "+", "-", "<", ">", "<=", ">=",
--  --  9,   10,   11,    12,   13,    14
--      "=", "!=", "and", "or", "xor", "not"

    -- calculate operator, e.g. {2, "*", 1.5}
       if i = 1  then   r = a1 * a2
    elsif i = 2  then
	if a2 != 0 then r = a1 / a2
	else 
	    return error_msg("division by zero")
	end if                      
    elsif i = 3  then   r = a1 + a2
    elsif i = 4  then   r = a1 - a2
    elsif i = 5  then   r = a1 < a2
    elsif i = 6  then   r = a1 > a2
    elsif i = 7  then   r = a1 <= a2
    elsif i = 8  then   r = a1 >= a2
    elsif i = 9  then   r = a1 = a2
    elsif i = 10 then   r = a1 != a2
    elsif i = 11 then   r = a1 and a2
    elsif i = 12 then   r = a1 or a2
    elsif i = 13 then   r = a1 xor a2
    else
	return error_msg("illegal operator: " & e[2])
    end if

    return r
end function



-- PURPOSE: calculate all cases of unary-/+ and "not" in expression, only if
--          the next item is an atom
-- NOTE:    cases such as -(...) or -func(...) are handled in calc_expr(); this
--          function calculates atoms, e.g. '* - 15'; '( + 6'; etc.
-- DETAILS: e is expression (see example below)
-- RETURN:  sequence; modified expression
-- EXAMPLE: s = calc_unary_op({"-", 5, "*", "-", "(", 6, "/", 2, ")"})
--           -- s is {-5, "*", "-", "(", 6, "/", 2, ")"}
constant
    START_CHARS = OP_LIST & {"(", ","}
function calc_unary_op(sequence e)
    integer st, en, i, len

    e = {"+"} & e   -- temporarily prepend an operator
    len = length(e)
    i = 2           -- index in e

    -- calculate unary-/+/not and one atom each loop, e.g. {"*", "-", 15}
    while i < len do
	if sequence(e[i]) then
	    if find(e[i], UNARY_OP_LIST) then
		st = i - 1
		en = i + 1
		if sequence(e[st]) and atom(e[en]) then
		    if find(e[st], START_CHARS) then
			if equal(e[i], "-") then
			    e[en] = -e[en]
			elsif equal(e[i], "not") then
			    e[en] = not e[en]
			end if
			-- remove the sign (also in case of "+")
			e = e[1..st] & e[en..$]
			len -= 1
		    end if
		end if
	    end if
	end if
	i += 1
    end while

    return e[2..$] -- remove temporarily prepended operator
end function



--bookmark: Parse and Calculate Expression;

-- PURPOSE: parse string expression into a sequence of initial arguments
-- DETAILS: expr is the same as in function math_eval();
--          binary/hexa/octal prefixes (0b101, 0xFD, 0o34) are also supported
-- RETURN:  sequence; sequence of arguments, or error_msg() string
-- EXAMPLE: s = parse_expr("( 2 + 5 * abs(-9) )")
--           -- s is {"(", 2, "+", 5, "*", {'@', 6}, "(", -9, ")", ")"}
constant
    FUNC_ID = '@',  -- unique integer as function marker (-1, '@', 999, etc)
    NULL = 0        -- end-of-string marker and placeholder for next-char
function parse_expr(string expr)
    integer idx, ch, st, en, func_ix
    integer is_dec, is_hex, is_0b, is_0x, is_0o
    sequence name, e, get_value
    atom number

    e = EMPTY
    expr &= NULL

    -- parse expression into sequence
    idx = 1
    while TRUE do

	ch = expr[idx]

	-- first check for end-of-string marker
	if ch = NULL then
	    exit

	-- ignore and skip blanks and control characters ('\t', etc)
	elsif ch <= 32 or ch = 127 then
	    idx += 1

	-- append parenthesis, comma, and symbolic operators
	elsif find(ch, "(),*/+-=<>!") then
	    if expr[idx + 1] = '=' and find(ch, "<>!") then
		-- append ambiguous operators "<=", ">=", "!="
		e = append(e, ch & '=')
		idx += 2
	    else
		e = append(e, {ch})
		idx += 1
	    end if

	-- get and append number's value, e.g. 10.5 (# for hexadecimal)
	elsif (ch >= '0' and ch <= '9') or ch = '.' or ch = '#' then
	    st = idx
	    en = idx
	    idx += 1

	    is_hex = (ch = '#')
	    is_0b  = (ch = '0' and expr[idx] = 'b') -- binary, "0b110"
	    is_0x  = (ch = '0' and expr[idx] = 'x') -- hexa,   "0xF13D2"
	    is_0o  = (ch = '0' and expr[idx] = 'o') -- octal,  "0o245"

	    if is_0b or is_0x or is_0o then
		idx += 1    -- skip 'bxo'
		is_dec = FALSE
	    else
		is_dec = not is_hex
	    end if

	    while TRUE do
		ch = expr[idx]
		if (is_dec and (
			(ch >= '0' and ch <= '9') or ch = '.' or
			(ch = 'e' or ch = 'E') or -- 45e2; 45e+2; 45e-2
			((ch = '-' or ch = '+') and find(expr[idx - 1], "eE"))
		    )) or
		    (is_hex or is_0x and ( -- #F4; 0xF4
			(ch >= '0' and ch <= '9') or (ch >= 'A' and ch <= 'F')
		    )) or
		    (is_0b and (ch = '0' or ch = '1')) or
		    (is_0o and (ch >= '0' and ch <= '7'))
		then
		    en = idx
		    idx += 1
		else
		    if is_dec or is_hex then
			get_value = value(expr[st..en])
		    else -- is_0b, is_0x, is_0o
			get_value = GET_SUCCESS & int(expr[st..en])
		    end if
		    if get_value[1] = GET_SUCCESS then
			e = append(e, get_value[2])
			exit
		    else
			return error_msg("bad number: " & expr[st..en])
		    end if
		end if
	    end while

	-- get and append constant value, operator string and function index
	elsif (ch >= 'a' and ch <= 'z') or
	      (ch >= 'A' and ch <= 'Z') or ch = '_'
	then
	    st = idx
	    en = idx
	    idx += 1
	    while TRUE do
		ch = expr[idx]
		if (ch >= 'a' and ch <= 'z') or
		   (ch >= 'A' and ch <= 'Z') or
		   (ch >= '0' and ch <= '9') or ch = '_'
		then
		    en = idx
		    idx += 1
		else
		    name = expr[st..en]

		    -- append the value of constant
		    if find(name, CONST_LIST) then
			number = CONST_LIST_VALUES[find(name, CONST_LIST)]
			e = append(e, number)

		    -- append operator string ("and", "or", "xor", "not")
		    elsif find(name, OP_LIST) then
			e = append(e, name)

		    -- append the index of function, e.g. {'@', 11}
		    else
			func_ix = find(name, FUNC_LIST)
			if func_ix then
			    e = append(e, {FUNC_ID, func_ix})
			else
			    return error_msg("unsupported identifier: " & name)
			end if
		    end if

		    exit
		end if
	    end while

	-- unsupported character ch ('&', etc)
	else
	    return error_msg("illegal character: " & ch)
	end if

    end while -- idx

    -- do the initial unary+/-/not calculation for atoms, e.g. {"-", 15};
    -- note that -(1 + 2) or -floor(4.1) cases are handled in calc_expr()
    e = calc_unary_op(e)

    return e
end function



-- PURPOSE: calculate an expression and return the result
-- NOTE:    expressions are evaluated from left-to-right, using Euphoria's
--          precedence order (see PRECEDENCE_LISTS constant)
-- DETAILS: e sequence is returned by parse_expr()
-- RETURN:  sequence; result atom, e.g. {-2.5}; or error_msg() string
-- EXAMPLE: s = calc_expr({1, "+", 2, "*", {FUNC_ID, 6}, "(", -11, ")"})
--           -- s is {23}  -- i.e. 1 + 2 * abs(-11)
function calc_expr(sequence e)
    integer st, en, idx
    object obj

    e = {"("} & e & {")"}   -- expression must be enclosed with ()

    -- calculate all expressions found inside () (precedence-1)
    while TRUE do

	-- find the most inner ")"
	en = find(")", e)
	if en = 0 then
	    if find("(", e) then
		return error_msg("missing )")
	    else
		exit -- no more expressions inside () to calculate
	    end if
	end if

	-- find the most inner "("
	st = 0
	for i = en - 1 to 1 by -1 do
	    if equal(e[i], "(") then
		st = i
		exit
	    end if
	end for
	if st = 0 then
	    return error_msg("missing (")
	end if


	-- calculate chunks of the expression according to precedence order;
	-- the idea is to shrink each chunk into atom, e.g. 5 * 10 --> 50
	for precedence = 4 to 7 do
	    idx = st + 1

	    while idx < en do
		if atom(e[idx]) then    -- atom can't be operator
		    idx += 1
		elsif find(e[idx], PRECEDENCE_LISTS[precedence]) then
		    obj = calc_op(e[idx - 1..idx + 1])

		    -- remove two atoms and operator; keep only new atom
		    if atom(obj) then
			e = e[1..idx - 2] & obj & e[idx + 2..$]
			en -= 2
		    else
			return obj -- error_msg()
		    end if
		else
		    idx += 1
		end if
	    end while
	end for -- precedence


	-- helper for debug
	if not (equal(e[st], "(") and equal(e[en], ")")) then
	    return error_msg("bug in calc_expr()")

	-- first: calculate a function using the result atom(s), or
	--        calculate a function without arguments such as time()
	elsif st > 1 and sequence(e[st - 1]) and e[st - 1][1] = FUNC_ID then
	    obj = calc_func(e[st - 1][2], e[st + 1..en - 1])

	    -- remove the function-id and (); keep only result atom
	    if atom(obj) then
		e = e[1..st - 2] & obj & e[en + 1..$]
	    else
		return obj -- error_msg()
	    end if

	-- then: operator result must be a single atom
	elsif st + 2 = en and atom(e[st + 1]) then
	    -- remove the () and keep only the result atom
	    e = e[1..st - 1] & e[st + 1] & e[en + 1..$]

	-- syntax error in expression
	else
	    -- if st + 1 = en then case of "()", i.e. no expression inside ()
	    -- elsif st = 1 then   case of "1not-2", i.e. syntax error
	    -- else case of "(1not-2)", i.e. syntax error inside ()
	    return error_msg("syntax error")
	end if


	-- finally calc again unary+/-/not for atoms, since the () and the
	-- function name are removed, i.e. for -(1 + 2) or -abs(4), etc
	e = calc_unary_op(e)

     end while  -- expressions found inside ()

    return e
end function



-- PURPOSE: evaluate a math expression
-- DETAILS: expr is an Euphoria 3.1 math expression string (see example below);
--          binary/hexa/octal prefixes (0b101, 0xFD, 0o34) are also supported;
--          some functions and some constants are supported (not all).
-- NOTE:    * math_eval() does not crash on errors (e.g. 1 / 0).
--          * sequence manipulation is not supported.
--          * it's easy to support more functions and constants.
-- RETURN:  object; atom as result, or error_msg() string
-- EXAMPLE: x = math_eval("( 11.2 + 5 * abs(-4) )") -- x is 31.2
global function math_eval(string expr)
    object e

    error_occurred = FALSE  -- reset local flag on each call

    -- parse expression to its initial arguments
    e = parse_expr(expr)
    if error_occurred then
	return e    -- error_msg()
    elsif length(e) = 0 then
	return error_msg("empty expression")
    end if

    -- calculate the expression
    e = calc_expr(e)
    if error_occurred then
	return e    -- error_msg()
    elsif length(e) = 1 and atom(e[1]) then
	return e[1] -- the result must be a single atom
    else
	return error_msg("bug in math_eval()") -- for debug
    end if
end function



-- End of file.
