/**
* Modern Albufeira Prolog Interpreter
*
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
import {
exec_build, check_integer, set, check_number,
narrow_float, check_atom, make_check, exec_unify,
Compound, make_error
} from "../../nova/core.mjs";
/*********************************************************************/
/* Number Formatting */
/*********************************************************************/
/**
* sys_number_atom(F, S, N, A): internal only
* The built-in succeeds in A with the number F formatted according
* to the format specifier S and the number of digits N.
*/
function test_sys_number_atom(args) {
let num = exec_build(args[0]);
check_number(num);
let spec = exec_build(args[1]);
check_atom(spec);
let digs = exec_build(args[2]);
check_integer(digs);
if (digs < 0)
throw make_error(new Compound("domain_error",
["not_less_than_zero", digs]));
let text;
num = narrow_float(num);
if ("fF".includes(spec)) {
text = float_atom(num, digs, "standard");
text = shape_float(text, spec);
} else if ("eE".includes(spec)) {
text = float_atom(num, digs, "scientific");
text = shape_float(text, spec);
} else if ("gG".includes(spec)) {
let mag = (num !== 0 ? Math.floor(Math.log10(
Math.abs(num))) : 0);
if (mag >= digs || mag < -4) {
text = float_atom(num, digs - 1, "scientific");
} else {
text = float_atom(num, digs - 1 - mag, "standard");
}
text = shape_float(text, spec);
} else {
throw make_error(new Compound("existence_error",
["format_character", spec]));
}
return exec_unify(args[3], text);
}
function float_atom(value, digs, type) {
let fmt = Intl.NumberFormat("en", {notation: type,
maximumFractionDigits: digs, minimumFractionDigits: digs,
roundingMode: "halfEven", useGrouping: false})
return fmt.format(value);
}
/**
* Shape the number string.
*
* @param res The number string.
* @param spec The format specifier.
* @return The shaped number string.
*/
function shape_float(res, spec) {
let peek = res.indexOf("E");
if (peek !== -1) {
res = shape_float_mantissa(res.slice(0, peek), spec) +
("FEG".includes(spec) ? "E": "e")
+ shape_float_exponent(res.slice(peek+1));
} else {
res = shape_float_mantissa(res, spec);
}
return res;
}
function shape_float_mantissa(res, spec) {
if ("gG".includes(spec)) {
if (res.indexOf(".") !== -1) {
let pos = res.length;
while (res.charCodeAt(pos - 1) === 48) // '0'
pos--;
if (res.charCodeAt(pos - 1) === 46) // '.'
pos--;
if (pos !== res.length)
res = res.slice(0, pos);
}
}
return res;
}
function shape_float_exponent(res) {
if (res.startsWith("-")) {
if (res.length < 3)
return "-0"+res.slice(1);
return res;
}
if (res.length < 2)
return "+0"+res;
return "+"+res;
}
/*********************************************************************/
/* Integer Formatting */
/*********************************************************************/
/**
* sys_integer_atom(F, S, N, A): internal only
* The built-in succeeds in A with the integer F formatted according
* to the format specifier S and the radix N.
*/
function test_sys_integer_atom(args) {
let num = exec_build(args[0]);
check_integer(num);
let spec = exec_build(args[1]);
check_atom(spec);
let radix = exec_build(args[2]);
check_integer(radix);
if (radix < 2 || radix > 36)
throw make_error(new Compound("domain_error", ["radix", radix]));
let text;
if ("r" === spec) {
text = num.toString(radix);
} else if ("R" === spec) {
text = num.toString(radix);
text = text.toUpperCase();
} else {
throw make_error(new Compound("existence_error",
["format_character", spec]));
}
return exec_unify(args[3], text);
}
/*********************************************************************/
/* Str Lib Init */
/*********************************************************************/
export function main() {
set("sys_number_atom", 4, make_check(test_sys_number_atom));
set("sys_integer_atom", 4, make_check(test_sys_integer_atom));
}