package nova; import java.lang.reflect.*; import java.math.*; import java.util.*; import java.util.function.Predicate; /** * 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. */ public final class special { private static final BigInteger MIN_INTEGER = BigInteger.valueOf(Integer.MIN_VALUE); private static final BigInteger MAX_INTEGER = BigInteger.valueOf(Integer.MAX_VALUE); private static final Double ZERO_DOUBLE = Double.valueOf(0.0); public static int MAX_ARITY = 2147483647; public static final String NAT_EXT = ".java"; public static String[] main_args = new String[0]; public static String[] classpath = null; /** * Set the program arguments. * * @param a The program arguments. */ public static void set_args(String[] a) { main_args = a; } /** * Set the class path. * * @param cp The class path. */ public static void set_classpath(String[] cp) { classpath = cp; } /******************************************************************/ /* Special Predicate */ /******************************************************************/ /** * Return a built-in for a special. * * @param func The special. * @return Provable The built-in. */ public static Store.Provable make_special(Handler.Builtin func) { Store.Provable peek = new Store.Provable(); peek.flags |= Store.MASK_PRED_SPECIAL; peek.func = func; return peek; } /** * Return a built-in for a check. * * @param func The check. * @return Provable The built-in. */ public static Store.Provable make_check(Handler.Check func) { Store.Provable peek = new Store.Provable(); peek.flags |= Store.MASK_PRED_TEST; peek.func = func; return peek; } /** * Return a built-in for an arithmetic. * * @param func The arithmetic. * @return Provable The built-in. */ public static Store.Provable make_arithmetic(Handler.Funktion func) { Store.Provable peek = new Store.Provable(); peek.flags |= Store.MASK_PRED_ARITH; peek.func = func; return peek; } /******************************************************************/ /* fail/0, '$CUT'/1 and '$MARK'/1 */ /******************************************************************/ /** * fail: [ISO 7.8.2] * The built-in fails. */ private static boolean test_fail(Object[] args) { return false; } /** * '$CUT'(R): internal only * The built-in removes the choice points up to R and succeeds. */ private static boolean test_cut(Object[] args) { Object choice = Machine.exec_build(args[0]); Machine.more((Machine.Choice) choice); return true; } /** * '$MARK'(R): Internal only * The built-in binds R to the top choice point. */ private static boolean test_mark(Object[] args) { Object choice = Machine.redo; return Machine.exec_unify(args[0], choice); } /******************************************************************/ /* '$SEQ'/2 and '$ALT'/1 */ /******************************************************************/ /** * '$SEQ'(O, L): internal only * The built-in first matches the option O with the top choice point. * The built-in then sequentially adds the goals L to the continuation. */ private static Object special_seq(Object[] args) { Object temp = Store.deref(args[0]); solve_mark(temp); temp = Store.deref(args[1]); solve_seq(temp); return Boolean.TRUE; } /** * If temp is just(R) bind R the top choice point. If temp is * nothing do nothing. Otherwise throw an exception. * * @param temp The Prolog term. */ private static void solve_mark(Object temp) { if ("nothing".equals(temp)) { /* */ } else if (Store.is_structure(temp) && "just".equals(((Store.Structure) temp).functor) && ((Store.Structure) temp).args.length == 1) { temp = Store.deref(((Store.Structure) temp).args[0]); Machine.bind(Machine.redo, (Store.Variable) temp); } else { Store.check_nonvar(temp); temp = Store.copy_term(temp); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"maybe", temp})); } } /** * Sequentially adds the literals L to the continuation. * * @param peek The literals. */ public static void solve_seq(Object peek) { Store.Structure back = null; Object res = null; while (Store.is_structure(peek) && ".".equals(((Store.Structure) peek).functor) && ((Store.Structure) peek).args.length == 2) { Object goal = Store.deref(((Store.Structure) peek).args[0]); goal = new Store.Compound(".", new Object[]{goal, Store.UNDEF_OBJ}); if (back == null) { res = goal; } else { back.args[1] = goal; } back = (Store.Structure)goal; peek = Store.deref(((Store.Structure) peek).args[1]); } special.check_nil(peek); if (back == null) { res = ((Store.Structure) Machine.call).args[1]; } else { back.args[1] = ((Store.Structure) Machine.call).args[1]; } Machine.cont(res); } /** * Sequentially adds the literals L to the continuation. * * @param peek The literals. */ public static void check(Object peek) { Store.Structure back = null; Object res = null; while (Store.is_structure(peek) && ".".equals(((Store.Structure) peek).functor) && ((Store.Structure) peek).args.length == 2) { Object goal = Store.deref(((Store.Structure) peek).args[0]); goal = new Store.Compound(".", new Object[]{goal, Store.UNDEF_OBJ}); if (back == null) { res = goal; } else { back.args[1] = goal; } back = (Store.Structure)goal; peek = Store.deref(((Store.Structure) peek).args[1]); } special.check_nil(peek); if (back == null) { res = ((Store.Structure) Machine.call).args[1]; } else { back.args[1] = ((Store.Structure) Machine.call).args[1]; } Machine.cont(res); } /** * '$ALT'(L): internal only * The built-in alternatively adds the variants L to the * continuation and succeeds. */ private static Object special_alt(Object[] args) { Object goal = Store.deref(args[0]); return solve_alt(goal, -1, null); } /** * Alternatively adds the variants to the continuation. * * @param peek The variants. * @param at This argument is ignored. * @param choice The choice point for reuse or null. * @return boolean True if a variant could be added, otherwise false. */ private static Object solve_alt(Object peek, int at, Machine.Choice choice) { if (Store.is_structure(peek) && ".".equals(((Store.Structure) peek).functor) && ((Store.Structure) peek).args.length == 2) { Store.Variable mark = Machine.trail; Object goal = Store.deref(((Store.Structure) peek).args[0]); solve_mark(Store.deref(((Store.Structure) goal).args[0])); peek = Store.deref(((Store.Structure) peek).args[1]); if (Store.is_structure(peek) && ".".equals(((Store.Structure) peek).functor) && ((Store.Structure) peek).args.length == 2) { if (choice == null) { choice = new Machine.Choice(special::solve_alt, peek, -1, mark); } else { choice.data = peek; } Machine.more(choice); } solve_seq(Store.deref(((Store.Structure) goal).args[1])); return Boolean.TRUE; } else { return Boolean.FALSE; } } /*****************************************************************/ /* sys_raise/1 and sys_trap/3 */ /*****************************************************************/ /** * sys_raise(E): internal only * The predicate raises the exception E. */ private static boolean test_sys_raise(Object[] args) { Object problem = Machine.exec_build(args[0]); problem = Store.copy_term(problem); throw new Handler.Problem(problem); } /** * sys_trap(G, E, F): internal only * The built-in succeeds whenever G succeeds. If * there was an exception that unifies with E, the * built-in further succeeds whenever F succeeds. */ private static Object special_sys_trap(Object[] args) { Object goal = Store.deref(args[0]); Machine.Choice snap = Machine.snap_setup(); goal = new Store.Compound(".", new Object[]{goal, "[]"}); Machine.cont(goal); return solve_catch(snap, 1, null); } /** * Call, redo or resume a goal. * If there is an exception put the handler on the continuation. * * @param data The surrounding choice point. * @param at The call or redo flag. * @param choice The choice point for reuse or null. * @return boolean True if goal succeeded, otherwise false. */ private static Object solve_catch(Object data, int at, Machine.Choice choice) { if (choice != null) { choice.mark = null; choice.cont = "[]"; choice.tail = null; } Machine.Choice snap = (Machine.Choice) data; Object found = (at != 0 ? Boolean.TRUE : Boolean.FALSE); try { found = Machine.solve(snap, found); } catch (Throwable err) { Machine.snap_cleanup(snap); Object goal = Store.deref(((Store.Structure) Machine.call).args[0]); err = map_throwable(err); Object beta = (err instanceof Handler.Problem ? ((Handler.Problem) err).term : err); if (!Machine.unify(((Store.Structure) goal).args[1], beta)) theatre.sneaky(err); goal = Store.deref(((Store.Structure) goal).args[2]); goal = new Store.Compound(".", new Object[]{goal, ((Store.Structure) Machine.call).args[1]}); Machine.cont(goal); return Boolean.TRUE; } if (found == Boolean.FALSE) return Boolean.FALSE; if (Machine.redo != snap) { if (choice == null) { choice = new Machine.Choice(special::solve_catch, snap, 0, Machine.trail); } else { choice.mark = Machine.trail; choice.cont = Machine.call; choice.tail = Machine.redo; } Machine.more(choice); } else { Machine.more(snap.tail); } if (found == Boolean.TRUE) Machine.cont(((Store.Structure) snap.cont).args[1]); return found; } private static Throwable map_throwable(Throwable err) { if (err instanceof StackOverflowError) { err = Machine.make_error(new Store.Compound("system_error", new Object[]{"stack_overflow"})); } else if (err instanceof OutOfMemoryError) { err = Machine.make_error(new Store.Compound("system_error", new Object[]{"out_of_memory"})); } return err; } /*******************************************************************/ /* os_sleep_promise/2 and os_import_promise/3 */ /*******************************************************************/ /** * os_sleep_promise(D, P): * The predicate succeeds in P with a promise for a delay D. */ private static boolean test_os_sleep_promise(Object[] args) { Object obj = Machine.exec_build(args[0]); check_integer(obj); if (eval.integer_signum((Number) obj) < 0) throw Machine.make_error(new Store.Compound("domain_error", new Object[]{"not_less_than_zero", obj})); if (!runtime.is_long((Number) obj)) throw Machine.make_error(new Store.Compound("representation_error", new Object[]{"long", obj})); long delay = ((Number) obj).longValue(); Object buf = Machine.ctx; return Machine.exec_unify(args[1], sleep_promise(buf, delay)); } private static Handler.Promise sleep_promise(Object buf, long delay) { return new Handler.Promise(() -> { Thread self = Thread.currentThread(); Machine.register_interrupt(buf, self::interrupt); try { Thread.sleep(delay); } catch (InterruptedException x) { /* */ } finally { Machine.register_interrupt(buf, () -> {}); } }); } /** * os_import_promise(F, M, Q): internal only * The predicate succeeds in Q with with a promise for the * import M of the file F. */ private static boolean test_os_import_promise(Object[] args) { Object url = Machine.exec_build(args[0]); special.check_atom(url); Map res = new HashMap(); if (!Machine.exec_unify(args[1], res)) return false; Object buf = Machine.ctx; return Machine.exec_unify(args[2], import_promise(buf, (String) url, res)); } private static Handler.Promise import_promise(Object buf, String url, Map res) { return new Handler.Promise(() -> { String name = special.find_name(url); if (name == null) { Machine.register_signal(buf, new Store.Compound("existence_error", new Object[]{"module", url})); } else { try { Class clazz = Class.forName(name); res.put("module", clazz); } catch (LinkageError x) { Machine.register_signal(buf, new Store.Compound("syntax_error", new Object[]{"bad_module"})); } catch (ClassNotFoundException x) { Machine.register_signal(buf, new Store.Compound("existence_error", new Object[]{"module", url})); } } }); } /** * Find a Java class name from an url * * @param url The url * @return The Java class name or null */ public static String find_name(String url) { if (!url.endsWith(special.NAT_EXT)) return null; String path = find_path(url); if (path == null) return null; url = url.substring(path.length(), url.length() - special.NAT_EXT.length()); url = url.replace("/", "."); url = url.replace("\\", "."); return url; } /** * Find a classpath entry for an url * * @param url The url * @return The classpath entry or null */ private static String find_path(String url) { for (int i = 0; i < special.classpath.length; i++) { String path = special.classpath[i]; if (url.startsWith(path)) return path; } return null; } /** * os_invoke_main(M): internal only * Invoke the main method of the module M. */ private static boolean test_os_invoke_main(Object[] args) { Class clazz = (Class) Machine.exec_build(args[0]); try { Method method = clazz.getMethod("main"); method.invoke(null); } catch (NoSuchMethodException x) { throw Machine.make_error(new Store.Compound("existence_error", new Object[]{"method", "main"})); } catch (IllegalAccessException x) { throw Machine.make_error(new Store.Compound("permission_error", new Object[]{"invoke", "method", "main"})); } catch (InvocationTargetException x) { theatre.sneaky(x.getCause()); } return true; } /*******************************************************************/ /* '$YIELD'/1, shield/1 and unshield/1 */ /*******************************************************************/ /** * '$YIELD'(R): Internal only * The built-in stops the interpreter loop with return value R. */ private static Object special_yield(Object[] args) { if ((Store.engine.flags & Machine.SYS_MASK_ALLOW_YIELD) == 0) throw Machine.make_error(new Store.Compound("system_error", new Object[]{"illegal_yield"})); Machine.cont(((Store.Structure) Machine.call).args[1]); Machine.more(new Machine.Choice(Machine::solve_signal, null, 0, Machine.trail)); return Store.deref(args[0]); } /** * shield(G): * The predicate succeeds whenever the goal G succeeds. * The goal is executed without auto-yield. */ private static Object special_shield(Object[] args) { Object goal = Store.deref(args[0]); Machine.Choice snap = Machine.snap_setup(); goal = new Store.Compound(".", new Object[]{goal, "[]"}); Machine.cont(goal); return solve_shield(snap, 1, null); } /** * Call, redo or resume a goal. * The goal is executed without auto-yield. * * @param data The surrounding choice point. * @param at The call or redo flag. * @param choice The choice point for reuse or null. * @return boolean True if goal succeeded, otherwise false. */ private static Object solve_shield(Object data, int at, Machine.Choice choice) { if (choice != null) { choice.mark = null; choice.cont = "[]"; choice.tail = null; } Machine.Choice snap = (Machine.Choice) data; Object found = (at != 0 ? Boolean.TRUE : Boolean.FALSE); int back = Store.engine.flags & Machine.SYS_MASK_ASYNC_MODE; Store.engine.flags &= ~Machine.SYS_MASK_ASYNC_MODE; try { found = Machine.solve(snap, found); } catch (Throwable x) { Store.engine.flags &= ~Machine.SYS_MASK_ASYNC_MODE; Store.engine.flags |= back; Machine.snap_cleanup(snap); throw x; } Store.engine.flags &= ~Machine.SYS_MASK_ASYNC_MODE; Store.engine.flags |= back; if (found == Boolean.FALSE) return Boolean.FALSE; if (Machine.redo != snap) { if (choice == null) { choice = new Machine.Choice(special::solve_shield, snap, 0, Machine.trail); } else { choice.mark = Machine.trail; choice.cont = Machine.call; choice.tail = Machine.redo; } Machine.more(choice); } else { Machine.more(snap.tail); } if (found == Boolean.TRUE) Machine.cont(((Store.Structure) snap.cont).args[1]); return found; } /** * unshield(G): * The predicate succeeds whenever the goal G succeeds. * The goal is executed with auto-yield. */ private static Object special_unshield(Object[] args) { Object goal = Store.deref(args[0]); Machine.Choice snap = Machine.snap_setup(); goal = new Store.Compound(".", new Object[]{goal, "[]"}); Machine.cont(goal); return solve_unshield(snap, 1, null); } /** * Call, redo or resume a goal. * The goal is executed without auto-yield. * * @param data The surrounding choice point. * @param at The call or redo flag. * @param choice The choice point for reuse or null. * @return boolean True if goal succeeded, otherwise false. */ private static Object solve_unshield(Object data, int at, Machine.Choice choice) { if (choice != null) { choice.mark = null; choice.cont = "[]"; choice.tail = null; } Machine.Choice snap = (Machine.Choice) data; Object found = (at != 0 ? Boolean.TRUE : Boolean.FALSE); int back = Store.engine.flags & Machine.SYS_MASK_ASYNC_MODE; Store.engine.flags |= Machine.SYS_MASK_ASYNC_MODE; try { found = Machine.solve(snap, found); } catch (Throwable x) { Store.engine.flags &= ~Machine.SYS_MASK_ASYNC_MODE; Store.engine.flags |= back; Machine.snap_cleanup(snap); throw x; } Store.engine.flags &= ~Machine.SYS_MASK_ASYNC_MODE; Store.engine.flags |= back; if (found == Boolean.FALSE) return Boolean.FALSE; if (Machine.redo != snap) { if (choice == null) { choice = new Machine.Choice(special::solve_unshield, snap, 0, Machine.trail); } else { choice.mark = Machine.trail; choice.cont = Machine.call; choice.tail = Machine.redo; } Machine.more(choice); } else { Machine.more(snap.tail); } if (found == Boolean.TRUE) Machine.cont(((Store.Structure) snap.cont).args[1]); return found; } /** * call(A): [ISO 7.8.3] * The predicate succeeds whenever the goal A succeeds. */ private static Object special_call(Object[] args) { Object goal = Store.deref(args[0]); goal = new Store.Compound(".", new Object[]{goal, ((Store.Structure) Machine.call).args[1]}); Machine.cont(goal); return true; } /*********************************************************************/ /* Type Assertions */ /*********************************************************************/ /** * Assure that the object is an atom. * * @param beta The object. */ public static void check_atom(Object beta) { if (!Machine.is_atom(beta)) { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"atom", beta})); } } /** * Assure that the object is a number. * * @param beta The object. */ public static void check_number(Object beta) { if (!Machine.is_number(beta)) { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"number", beta})); } } /** * Assure that the object is an integer. * * @param beta The object. */ public static void check_integer(Object beta) { if (!Machine.is_integer(beta)) { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"integer", beta})); } } /** * Assure that the object is atomic. * * @param beta The object. */ public static void check_atomic(Object beta) { if (Store.is_variable(beta) || Store.is_structure(beta)) { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"atomic", beta})); } } /** * Assure that the Prolog term is nil. * * @param beta The Prolog term. */ public static void check_nil(Object beta) { if ("[]".equals(beta)) return; if (Store.is_structure(beta) && ".".equals(((Store.Structure) beta).functor) && ((Store.Structure) beta).args.length == 2) { throw Machine.make_error(new Store.Compound("representation_error", new Object[]{"max_arity"})); } else { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"list", beta})); } } /*********************************************************************/ /* =/2 and copy_term/2 */ /*********************************************************************/ /** * S = T: [ISO 8.2.1] * The built-in succeeds when the Prolog terms S and T unify, * otherwise the built-in fails. */ private static boolean test_unify(Object[] args) { Object alpha = Machine.exec_build(args[0]); return Machine.exec_unify(args[1], alpha); } /** * copy_term(S, T): [ISO 8.5.4] * The built-in succeeds in T with a copy of S. */ private static boolean test_copy_term(Object[] args) { Object alpha = Machine.exec_build(args[0]); alpha = Store.copy_term(alpha); return Machine.exec_unify(args[1], alpha); } /******************************************************************/ /* =../2, functor/3 and arg/3 */ /******************************************************************/ /** * T =.. [F|L]: [ISO 8.5.3] * If T is a variable, the built-in succeeds in T with the Prolog term * from the functor F and arguments L. Otherwise the built-in succeeds in * F and L with the functor and arguments of the Prolog term T. */ private static boolean test_univ(Object[] args) { Object alpha = Machine.exec_deref(args[0]); if (Store.is_variable(alpha) || Machine.is_pending(alpha)) { Object beta = Machine.exec_build(args[1]); beta = special_univ_pack(beta); return Machine.exec_unify(alpha, beta); } else { alpha = Machine.exec_build(alpha); alpha = special_univ_unpack(alpha); return Machine.exec_unify(args[1], alpha); } } private static Object special_univ_pack(Object beta) { if (Store.is_structure(beta) && ".".equals(((Store.Structure) beta).functor) && ((Store.Structure) beta).args.length == 2) { /* */ } else { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"list", beta})); } Object functor = Store.deref(((Store.Structure) beta).args[0]); check_atomic(functor); beta = Store.deref(((Store.Structure) beta).args[1]); Object[] args = list_objects(beta); if (args.length == 0) { /* */ } else { if (Machine.is_number(functor)) throw Machine.make_error(new Store.Compound("type_error", new Object[]{"atom", functor})); functor = new Store.Compound(functor, args); } return functor; } public static Object[] list_objects(Object obj) { Object peek = obj; int i = 0; while (Store.is_structure(peek) && ".".equals(((Store.Structure) peek).functor) && ((Store.Structure) peek).args.length == 2 && i < special.MAX_ARITY) { i++; peek = Store.deref(((Store.Structure) peek).args[1]); } special.check_nil(peek); if (i == 0) { return Machine.VOID_ARGS; } else { Object[] args = new Object[i]; peek = obj; i = 0; while (Store.is_structure(peek) && ".".equals(((Store.Structure) peek).functor) && ((Store.Structure) peek).args.length == 2) { args[i++] = Store.deref(((Store.Structure) peek).args[0]); peek = Store.deref(((Store.Structure) peek).args[1]); } return args; } } private static Object special_univ_unpack(Object alpha) { if (Store.is_structure(alpha)) { Object[] temp = ((Store.Structure) alpha).args; alpha = ((Store.Structure) alpha).functor; return new Store.Compound(".", new Object[]{alpha, objects_list(temp, 0, temp.length)}); } else { return new Store.Compound(".", new Object[]{alpha, "[]"}); } } public static Object objects_list(Object[] args, int off, int count) { Object res = "[]"; for (int i = off + count - 1; i >= off; i--) res = new Store.Compound(".", new Object[]{args[i], res}); return res; } /** * functor(T, F, A): [ISO 8.5.1] * If T is a variable, the built-in succeeds in T with a new Prolog term * from the functor F and the arity A. Otherwise the built-in succeeds in * F and L with the functor and arguments of the Prolog term T. */ private static boolean test_functor(Object[] args) { Object alpha = Machine.exec_deref(args[0]); if (Store.is_variable(alpha) || Machine.is_pending(alpha)) { Object functor = Machine.exec_build(args[1]); check_atomic(functor); Object beta = Machine.exec_build(args[2]); check_integer(beta); if (eval.integer_signum((Number) beta) < 0) throw Machine.make_error(new Store.Compound("domain_error", new Object[]{"not_less_than_zero", beta})); if (Machine.is_bigint(beta)) throw Machine.make_error(new Store.Compound("representation_error", new Object[]{"max_arity"})); int arity = ((Integer) beta).intValue(); if (arity == 0) { /* */ } else { if (Machine.is_number(functor)) throw Machine.make_error(new Store.Compound("type_error", new Object[]{"atom", functor})); Object[] temp = new Object[arity]; for (int i = 0; i < arity; i++) temp[i] = new Store.Variable(); functor = new Store.Compound(functor, temp); } return Machine.exec_unify(alpha, functor); } else { alpha = Machine.exec_build(alpha); Object functor; Object arity; if (Store.is_structure(alpha)) { Store.Structure cmp = (Store.Structure) alpha; functor = cmp.functor; arity = Integer.valueOf(cmp.args.length); } else { functor = alpha; arity = Integer.valueOf(0); } if (!Machine.exec_unify(args[1], functor)) return false; return Machine.exec_unify(args[2], arity); } } /** * arg(K, X, Y): [ISO 8.5.2] * The predicate succeeds in Y with the K-th argument of X. */ private static boolean test_arg(Object[] args) { Object alpha = Machine.exec_build(args[0]); check_integer(alpha); Object beta = Machine.exec_build(args[1]); check_callable(beta); int arity; if (Store.is_structure(beta)) { arity = ((Store.Structure) beta).args.length; } else { arity = 0; } int pos = (!Machine.is_bigint(beta) ? ((Integer) alpha).intValue() : -1); if (pos < 1 || arity < pos) return false; beta = ((Store.Structure) beta).args[pos - 1]; return Machine.exec_unify(args[2], beta); } /** * Assure that the object is a callable. * * @param beta The object. */ public static void check_callable(Object beta) { if (Store.is_variable(beta) || Machine.is_number(beta)) { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"callable", beta})); } } /******************************************************************/ /* change_arg/3 */ /******************************************************************/ /** * change_arg(K, X, Y): * The predicate succeeds. As a side-effect the K-th argument of X is set to Y. */ private static boolean test_change_arg(Object[] args) { Object alpha = Machine.exec_build(args[0]); check_integer(alpha); Object beta = Machine.exec_build(args[1]); check_callable(beta); Object gamma = Machine.exec_build(args[2]); int arity; if (Store.is_structure(beta)) { arity = ((Store.Structure) beta).args.length; } else { arity = 0; } int pos = (!Machine.is_bigint(beta) ? ((Integer) alpha).intValue() : -1); if (pos < 1 || arity < pos) return false; linkarg(gamma, (Store.Structure) beta, pos); return true; } private static void linkarg(Object source, Store.Structure term, int pos) { if (Machine.is_frozen(term)) throw Machine.make_error(new Store.Compound("permission_error", new Object[]{"modify", "compound", term})); if ((((Store.Compound)term).walk & Store.VAR_MASK_STATE) == Machine.gc_mask) Machine.mark2_term(source); term.args[pos-1] = source; } /******************************************************************/ /* term_variables/2 */ /******************************************************************/ /** * term_variables(T, L): [TC2 8.5.5] * The built-in succeeds in L with a list of the variables of T. */ private static boolean test_term_variables(Object[] args) { Object alpha = Machine.exec_build(args[0]); term_variables2 h = new term_variables2(); walk_vars(alpha, h::run, Store.VAR_MASK_SEEN); if (h.back == null) { h.res = "[]"; } else { h.back.args[1] = "[]"; } walk_vars(alpha, node -> false, 0); return Machine.exec_unify(args[1], h.res); } private static class term_variables2 { public Object res = null; public Store.Structure back = null; public boolean run(Object node) { Store.Structure peek = new Store.Compound(".", new Object[]{node, Store.UNDEF_OBJ}); if (back == null) { res = peek; } else { back.args[1] = peek; } back = peek; return false; } } public static boolean walk_vars(Object first, Predicate acceptor, int state) { List stack = null; for (; ; ) { first = Store.deref(first); if (Store.is_variable(first)) { if ((((Store.Variable) first).flags & Store.VAR_MASK_SEEN) != state) { if (acceptor.test(first)) return true; ((Store.Variable)first).flags = (((Store.Variable)first).flags & ~Store.VAR_MASK_SEEN) | state; } } else if (Store.is_compound(first)) { if ((((Store.Compound) first).walk & Store.VAR_MASK_SEEN) != state) { ((Store.Compound)first).walk = (((Store.Compound)first).walk & ~Store.VAR_MASK_SEEN) | state; if (0 != ((Store.Structure) first).args.length - 1) { ((Store.Compound) first).walk &= ~Store.VAR_MASK_SERNO; stack = Store.stack_push(stack, first); } first = ((Store.Structure) first).args[0]; continue; } } Store.Compound item = (Store.Compound)Store.stack_peek(stack); if (item == null) { return false; } else { item.walk++; first = item.args[item.walk & Store.VAR_MASK_SERNO]; if ((item.walk & Store.VAR_MASK_SERNO) == item.args.length - 1) Store.stack_pop(stack); } } } /******************************************************************/ /* var/1, compound/1 and nonvar/1 */ /******************************************************************/ /** * var(V): [ISO 8.3.1] * The built-in succeeds if V is a Prolog variable. Otherwise, it fails. */ private static boolean test_var(Object[] args) { Object alpha = Machine.exec_build(args[0]); return Store.is_variable(alpha); } /** * compound(C): [ISO 8.3.6] * The built-in succeeds if C is a Prolog compound. Otherwise, it fails. */ private static boolean test_compound(Object[] args) { Object alpha = Machine.exec_build(args[0]); return Store.is_structure(alpha); } /** * nonvar(V): [ISO 8.3.7] * The built-in succeeds if V is not a Prolog variable. Otherwise, it fails. */ private static boolean test_nonvar(Object[] args) { Object alpha = Machine.exec_build(args[0]); return !Store.is_variable(alpha); } /******************************************************************/ /* atomic/1, number/1 and float/1 */ /******************************************************************/ /** * atomic(A): [ISO 8.3.5] * The built-in succeeds if A is a Prolog symbol or number. Otherwise, it fails. */ private static boolean test_atomic(Object[] args) { Object alpha = Machine.exec_build(args[0]); if (Store.is_structure(alpha) || Store.is_variable(alpha)) return false; return true; } /** * number(A): [ISO 8.3.8] * The built-in succeeds if A is a Prolog number. Otherwise, it fails. */ private static boolean test_number(Object[] args) { Object alpha = Machine.exec_build(args[0]); return Machine.is_number(alpha); } /** * float(A): [ISO 8.3.4] * The built-in succeeds if A is a Prolog float. Otherwise, it fails. */ private static boolean test_float(Object[] args) { Object alpha = Machine.exec_build(args[0]); return Machine.is_float(alpha) && !Machine.is_special(alpha); } /******************************************************************/ /* integer/1, atom/1, callable/1 and must_be/2 */ /******************************************************************/ /** * integer(A): [ISO 8.3.3] * The built-in succeeds if A is a Prolog integer. Otherwise, it fails. */ private static boolean test_integer(Object[] args) { Object alpha = Machine.exec_build(args[0]); return Machine.is_integer(alpha); } /** * atom(A): [ISO 8.3.2] * The built-in succeeds if A is a Prolog atom. Otherwise, it fails. */ private static boolean test_atom(Object[] args) { Object alpha = Machine.exec_build(args[0]); return Machine.is_atom(alpha); } /** * callable(C): [TC2 8.3.9] * The built-in succeeds if C is a Prolog compound or symbol. Otherwise, it fails. */ private static boolean test_callable(Object[] args) { Object alpha = Machine.exec_build(args[0]); if (Store.is_variable(alpha) || Machine.is_number(alpha)) return false; return true; } /** * must_be(T, A): * The built-in succeeds if A is of type T. Otherwise, an exception is thrown. */ private static boolean test_must_be(Object[] args) { Object alpha = Machine.exec_build(args[0]); check_atom(alpha); Object beta = Machine.exec_build(args[1]); if ("integer".equals(alpha)) { check_integer(beta); } else if ("atom".equals(alpha)) { check_atom(beta); } else if ("callable".equals(alpha)) { check_callable(beta); } else { throw Machine.make_error(new Store.Compound("type_error", new Object[]{"type", alpha})); } return true; } /******************************************************************/ /* Number Utilities */ /******************************************************************/ /** * Return the Prolog integer corresponding to the given long. * * @param val The long. * @return The Prolog integer. */ public static Number norm_smallint(long val) { if (Integer.MIN_VALUE <= val && val <= Integer.MAX_VALUE) { return Integer.valueOf((int) val); } else { return BigInteger.valueOf(val); } } /** * Return the Prolog integer corresponding to the given big integer. * * @param val The bigint. * @return number The Prolog integer. */ public static Number norm_bigint(BigInteger val) { if (MIN_INTEGER.compareTo(val) <= 0 && val.compareTo(MAX_INTEGER) <= 0) { return Integer.valueOf(val.intValue()); } else { return val; } } /** * Widen a Prolog integer. * * @param num The Prolog integer. * @return bigint The Java bigint. */ public static BigInteger widen_bigint(Number num) { if (num instanceof BigInteger) { return (BigInteger) num; } else { return BigInteger.valueOf(num.intValue()); } } /** * Narrow a Prolog number to a Java float. * * @param alpha The Prolog number. * @return number The Java float. */ public static double narrow_float(Number alpha) { double val; if (Machine.is_float(alpha)) { if (Machine.is_special(alpha)) throw Machine.make_error(new Store.Compound("evaluation_error", new Object[]{"undefined"})); return alpha.doubleValue(); } else { val = alpha.doubleValue(); if (Double.isInfinite(val)) throw Machine.make_error(new Store.Compound("evaluation_error", new Object[]{"float_overflow"})); return val; } } /** * Norm a Java float to a Prolog float. * * @param alpha The Java float. * @return number The Prolog float. */ public static Double norm_float(double alpha) { if (Double.isNaN(alpha)) throw Machine.make_error(new Store.Compound("evaluation_error", new Object[]{"undefined"})); if (Double.isInfinite(alpha)) throw Machine.make_error(new Store.Compound("evaluation_error", new Object[]{"float_overflow"})); if (alpha == 0.0) return ZERO_DOUBLE; return Double.valueOf(alpha); } /******************************************************************/ /* atom/1, code_category/2 and code_numeric/2 */ /******************************************************************/ /** * code_category(C, T): * The predicate succeeds in T with the Unicode general category of C. * Otherwise, the predicate succeeds in T with 0. */ private static boolean test_code_category(Object[] args) { Object alpha = Machine.exec_build(args[0]); check_integer(alpha); int ch = (!Machine.is_bigint(alpha) ? ((Integer) alpha).intValue() : -1); if (ch < 0 || ch > 0x10FFFF) { ch = 0; // UNASSIGNED } else { ch = Character.getType(ch); } alpha = Integer.valueOf(ch); return Machine.exec_unify(args[1], alpha); } /** * code_numeric(C, V): * The predicate succeeds in V with the Unicode numeric value of C, * in case it is integer and between 0 and 35. Otherwise, the predicate * succeeds in V with -1. */ private static boolean test_code_numeric(Object[] args) { Object alpha = Machine.exec_build(args[0]); check_integer(alpha); int ch = (!Machine.is_bigint(alpha) ? ((Integer) alpha).intValue() : -1); if (ch < 0 || ch > 0x10FFFF) { ch = -1; // UNASSIGNED } else { ch = Character.digit(ch, 36); } alpha = Integer.valueOf(ch); return Machine.exec_unify(args[1], alpha); } /*********************************************************************/ /* atom_integer/3 */ /*********************************************************************/ /** * atom_integer(A, R, N): * If A is a variable, then the built-in succeeds in A with the * atom for the Prolog integer N in radix R. Otherwise the * built-in succeeds in N with the Prolog number from the * atom A in radix R. */ private static boolean test_atom_integer(Object[] args) { Object alpha = Machine.exec_build(args[1]); check_integer(alpha); if (Machine.is_bigint(alpha)) throw Machine.make_error(new Store.Compound("representation_error", new Object[]{"int"})); int radix = ((Integer) alpha).intValue(); if (radix < 2 || radix > 36) throw Machine.make_error(new Store.Compound("domain_error", new Object[]{"radix", alpha})); Object text = Machine.exec_deref(args[0]); if (Store.is_variable(text) || Machine.is_pending(text)) { Object beta = Machine.exec_build(args[2]); check_integer(beta); beta = atom_integer_encode(beta, radix); return Machine.exec_unify(text, beta); } else { text = Machine.exec_build(text); check_atom(text); text = atom_integer_decode((String) text, radix); return Machine.exec_unify(args[2], text); } } /** * Encode a Prolog integer to a string. * * @param num The Prolog integer. * @param radix The radix. * @return The string. */ public static String atom_integer_encode(Object num, int radix) { String res; if (Machine.is_bigint(num)) { res = ((BigInteger) num).toString(radix); } else { res = Integer.toString(((Integer) num).intValue(), radix); } return res; } /** * Decode a Prolog integer from a string. * * @param text The string * @param radix The radix. * @return The Prolog integer. */ private static Number atom_integer_decode(String text, int radix) { try { int step = 63 / (32 - Integer.numberOfLeadingZeros(radix - 1)); Number res; if (text.length() <= step) { long val = Long.parseLong(text, radix); res = norm_smallint(val); } else { BigInteger val = new BigInteger(text, radix); res = norm_bigint(val); } return res; } catch (NumberFormatException x) { throw Machine.make_error(new Store.Compound("syntax_error", new Object[]{"illegal_number"})); } } /******************************************************************/ /* atom_number/2 */ /******************************************************************/ /** * atom_number(A, N): * If A is a variable, then the built-in succeeds in A with the * atom for the Prolog number N. Otherwise the built-in succeeds in N * with the Prolog number from the atom A. */ private static boolean test_atom_number(Object[] args) { Object text = Machine.exec_deref(args[0]); if (Store.is_variable(text) || Machine.is_pending(text)) { Object beta = Machine.exec_build(args[1]); check_number(beta); beta = atom_number_encode(beta); return Machine.exec_unify(text, beta); } else { text = Machine.exec_build(text); check_atom(text); text = atom_number_decode((String) text); return Machine.exec_unify(args[1], text); } } /** * Encode a Prolog number to a string. * * @param num The Prolog number. * @return The string. */ private static String atom_number_encode(Object num) { if (Machine.is_integer(num)) { return num.toString(); } else { String res = String.format(Locale.UK, "%.16g", (Double) num); if (Double.parseDouble(res) != ((Double) num).doubleValue()) res = String.format(Locale.UK, "%.17g", (Double) num); return shape_number(res); } } /** * Shape the number string so that it has no trailing * zeros after the period, always a period, no exponent * positive sign and lower case exponent. * * @param res The ascii number string * @return The shaped number string. */ public static String shape_number(String res) { int peek = res.indexOf('e'); if (peek != -1) { res = shape_number_mantissa(res.substring(0, peek)) + "e" + shape_number_exponent(res.substring(peek + 1)); } else { res = shape_number_mantissa(res); } return res; } private static String shape_number_mantissa(String res) { if (res.indexOf('.') != -1) { int pos = res.length(); while (res.charAt(pos - 1) == '0') pos--; if (res.charAt(pos - 1) == '.') pos++; if (pos != res.length()) res = res.substring(0, pos); } else { res += ".0"; } return res; } private static String shape_number_exponent(String res) { if (res.startsWith("+")) res = res.substring(1); return res; } /** * Decode a Prolog number from a string. Unlike the ISO * core standard and numbers without a period but with * an exponent are accepted as float. * * @param text The string * @return The Prolog number. */ private static Number atom_number_decode(String text) { try { Number res; if ((text.indexOf('.') != -1) || (text.indexOf('e') != -1) || (text.indexOf('E') != -1)) { double val = Double.parseDouble(text); res = norm_float(val); } else { if (text.length() <= 18) { long val = Long.parseLong(text); res = norm_smallint(val); } else { BigInteger val = new BigInteger(text); res = norm_bigint(val); } } return res; } catch (NumberFormatException x) { throw Machine.make_error(new Store.Compound("syntax_error", new Object[]{"illegal_number"})); } } /******************************************************************/ /* sys_goal_ossify/3 and sys_clause_ossify/6 */ /******************************************************************/ /** * sys_goal_ossify(B, R, G): internal only * The built-in succeeds in G with a Java object representing * a goal with body instructions B and the cut option R. */ private static boolean test_sys_goal_ossify(Object[] args) { Object alpha = Machine.exec_build(args[0]); Object[] body = list_objects(alpha); Object beta = Machine.exec_build(args[1]); number_term h = new number_term(); int cutvar; try { h.number_term2(beta); number_objects(body, h); cutvar = ossify_cutvar(beta); ossify_objects(body); } finally { unossify_term(beta); unossify_objects(alpha); } return Machine.exec_unify(args[2], new Store.Goal(h.size, body, cutvar)); } /** * sys_clause_ossify(H, B, R, W, C): internal only * The built-in succeeds in C with a Java object representing * a clause with head instructions H, body instructions B, * cut option R and head functor W. */ private static boolean test_sys_clause_ossify(Object[] args) { Object alpha = Machine.exec_build(args[0]); Object[] head = list_objects(alpha); Object beta = Machine.exec_build(args[1]); Object[] body = list_objects(beta); Object gamma = Machine.exec_build(args[2]); Object mue = Machine.exec_build(args[3]); number_term h = new number_term(); int cutvar; try { h.number_term2(gamma); number_objects(head, h); number_objects(body, h); cutvar = ossify_cutvar(gamma); ossify_objects(head); ossify_objects(body); } finally { unossify_term(gamma); unossify_objects(alpha); unossify_objects(beta); } return Machine.exec_unify(args[4], new Store.Clause(h.size, mue, head, body, cutvar)); } /******************************************************************/ /* Object Lists */ /******************************************************************/ private static void number_objects(Object[] peek, number_term h) { for (int i = 0; i < peek.length; i++) h.number_term2(peek[i]); } private static void ossify_objects(Object[] peek) { for (int i = 0; i < peek.length; i++) peek[i] = ossify_term(peek[i]); } private static void unossify_objects(Object peek) { while (Store.is_structure(peek) && ".".equals(((Store.Structure) peek).functor) && ((Store.Structure) peek).args.length == 2) { unossify_term(((Store.Structure) peek).args[0]); peek = Store.deref(((Store.Structure) peek).args[1]); } } /******************************************************************/ /* Cut Variable */ /******************************************************************/ private static int ossify_cutvar(Object peek) { if (Store.is_structure(peek) && "just".equals(((Store.Structure) peek).functor) && ((Store.Structure) peek).args.length == 1) { Object res = ossify_term(((Store.Structure) peek).args[0]); return ((Store.Place)res).index; } else { return -1; } } /******************************************************************/ /* Term Ossify */ /******************************************************************/ public static class number_term { public int size = 0; public void number_term2(Object first) { for (;;) { first = Store.deref(first); if (Store.is_variable(first)) { if (((Store.Variable) first).tail == null) { ((Store.Variable) first).tail = Store.UNDEF_OBJ; } else if (((Store.Variable) first).tail == Store.UNDEF_OBJ) { ((Store.Variable) first).tail = new Store.Place(size); size++; } } else if (Store.is_compound(first)) { int i = 0; for (; i < ((Store.Compound)first).args.length-1; i++) number_term2(((Store.Compound)first).args[i]); first = ((Store.Compound)first).args[i]; continue; } break; } } } public static Object ossify_term(Object first) { Store.Skeleton back = null; for (;;) { first = Store.deref(first); if (Store.is_variable(first)) { first = ((Store.Variable) first).tail; } else if (Store.is_compound(first)) { Object[] args = new Object[((Store.Compound)first).args.length]; int i = 0; for (; i < ((Store.Compound)first).args.length-1; i++) args[i] = ossify_term(((Store.Compound)first).args[i]); args[i] = back; back = new Store.Skeleton(((Store.Compound)first).functor, args); first = ((Store.Compound)first).args[i]; continue; } while (back != null) { Store.Skeleton peek = (Store.Skeleton)back.args[back.args.length-1]; back.args[back.args.length-1] = first; first = try_freeze(back); back = peek; } return first; } } public static Object try_freeze(Store.Skeleton alpha) { for (int i = 0; i < alpha.args.length; i++) { Object temp = alpha.args[i]; if (Machine.is_pending(temp)) return alpha; if (Store.is_skeleton(temp)) return alpha; } return new Machine.Frozen(alpha.functor, alpha.args); } public static void unossify_term(Object first) { for (;;) { first = Store.deref(first); if (Store.is_variable(first)) { if (((Store.Variable) first).tail != null) ((Store.Variable) first).tail = null; } else if (Store.is_compound(first)) { int i = 0; for (; i < ((Store.Compound)first).args.length-1; i++) unossify_term(((Store.Compound)first).args[i]); first = ((Store.Compound)first).args[i]; continue; } break; } } /**************************************************************/ /* sys_clause_add/2 and sys_goal_call/1 */ /**************************************************************/ /** * sys_clause_add(C, O): internal only * The built-in succeeds. As a side effect the Java object clause C * is added according to options O to the knowledge base. */ private static boolean test_sys_clause_add(Object[] args) { Object gamma = Machine.exec_build(args[0]); check_clause(gamma); Object flags = Machine.exec_build(args[1]); special.check_integer(flags); Store.add_clause((Store.Clause)gamma, ((Integer) flags).intValue()); return true; } public static void check_clause(Object beta) { if (!Store.is_clause(beta)) { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"clause", beta})); } } /** * sys_goal_call(A): * The predicate succeeds whenever the compiled goal A succeeds. */ private static Object special_sys_goal_call(Object[] args) { Object goal = Store.deref(args[0]); check_goal(goal); goal = Machine.melt_directive((Store.Goal) goal); special.solve_seq(goal); return Boolean.TRUE; } public static void check_goal(Object beta) { if (!Store.is_goal(beta)) { Store.check_nonvar(beta); beta = Store.copy_term(beta); throw Machine.make_error(new Store.Compound("type_error", new Object[]{"goal", beta})); } } /******************************************************************/ /* Special Init */ /******************************************************************/ public static void boot() { // Albufeira compiler, control flow Store.set("fail", 0, make_check(special::test_fail)); Store.set("$CUT", 1, make_check(special::test_cut)); Store.set("$MARK", 1, make_check(special::test_mark)); Store.set("$SEQ", 2, make_special(special::special_seq)); Store.set("$ALT", 1, make_special(special::special_alt)); Store.set("sys_raise", 1, make_check(special::test_sys_raise)); Store.set("sys_trap", 3, make_special(special::special_sys_trap)); // Albufeira compiler, async flow Store.set("os_sleep_promise", 2, make_check(special::test_os_sleep_promise)); Store.set("os_import_promise", 3, make_check(special::test_os_import_promise)); Store.set("os_invoke_main", 1, make_check(special::test_os_invoke_main)); Store.set("$YIELD", 1, make_special(special::special_yield)); Store.set("shield", 1, make_special(special::special_shield)); Store.set("unshield", 1, make_special(special::special_unshield)); Store.set("call", 1, make_special(special::special_call)); // term specials Store.set("=", 2, make_check(special::test_unify)); Store.set("copy_term", 2, make_check(special::test_copy_term)); Store.set("=..", 2, make_check(special::test_univ)); Store.set("functor", 3, make_check(special::test_functor)); Store.set("arg", 3, make_check(special::test_arg)); Store.set("change_arg", 3, make_check(special::test_change_arg)); Store.set("term_variables", 2, make_check(special::test_term_variables)); // type specials Store.set("var", 1, make_check(special::test_var)); Store.set("compound", 1, make_check(special::test_compound)); Store.set("nonvar", 1, make_check(special::test_nonvar)); Store.set("atomic", 1, make_check(special::test_atomic)); Store.set("number", 1, make_check(special::test_number)); Store.set("float", 1, make_check(special::test_float)); // must specials Store.set("integer", 1, make_check(special::test_integer)); Store.set("atom", 1, make_check(special::test_atom)); Store.set("callable", 1, make_check(special::test_callable)); Store.set("must_be", 2, make_check(special::test_must_be)); // atom specials Store.set("code_category", 2, make_check(special::test_code_category)); Store.set("code_numeric", 2, make_check(special::test_code_numeric)); Store.set("atom_integer", 3, make_check(special::test_atom_integer)); Store.set("atom_number", 2, make_check(special::test_atom_number)); // clause specials Store.set("sys_goal_ossify", 3, special.make_check(special::test_sys_goal_ossify)); Store.set("sys_clause_ossify", 5, special.make_check(special::test_sys_clause_ossify)); Store.set("sys_clause_add", 2, special.make_check(special::test_sys_clause_add)); Store.set("sys_goal_call", 1, special.make_special(special::special_sys_goal_call)); } }