eyeprolog 1.5.65 → 1.5.67

package/package.json

@@ -3,7 +3,7 @@
   "publishConfig": {
     "access": "public"
   },
-  "version": "1.5.65",
+  "version": "1.5.67",
   "description": "EyeProlog turns facts and rules into answers and proofs.",
   "type": "module",
   "main": "./index.js",

package/src/lib/error.pl

@@ -17,10 +17,6 @@
 
 :- meta_predicate(call_with_error_context(0, +)).
 
-%  The context is supplied once here rather than handed over manually at every
-%  raise site: the raise sites throw with [] and this wrapper prepends its
-%  element, so contexts stay proper lists and compose with any enclosing
-%  call_with_error_context/2 (issue #98).
 %  The context is named in exactly one place -- error__must_be_throw/1 -- so no
 %  raise site hands one over (issue #98). It is a throw helper rather than a
 %  call_with_error_context/2 wrapper because wrapping a Prolog goal in catch/3
@@ -57,9 +53,20 @@ error__must_be(ground, Term) :- !,
 error__must_be(acyclic, Term) :- !,
     ( acyclic_term(Term) -> true ; type_error(acyclic_term, Term) ).
 error__must_be(list, Term) :- !,
-    error__proper_list(Term).
+    error__list(Term, Term, must_be/2, complete).
 error__must_be(list(Type), Term) :- !,
+    error__list(Term, Term, must_be/2, complete),
     error__proper_list_of(Term, Type).
+error__must_be(character, Term) :- !,
+    ( var(Term) -> error__must_be_throw(instantiation_error)
+    ; atom(Term), atom_length(Term, 1) -> true
+    ; error__must_be_throw(type_error(character, Term))
+    ).
+error__must_be(chars, Term) :- !,
+    error__list(Term, Term, must_be/2, partial),
+    error__partial_list_of(Term, character, must_be/2),
+    error__list(Term, Term, must_be/2, complete),
+    error__proper_list_of(Term, character).
 error__must_be(pair, Term) :- !,
     ( var(Term) -> error__must_be_throw(instantiation_error)
     ; Term = _-_ -> true
@@ -73,12 +80,17 @@ error__must_be(Type, Term) :-
     ; error__must_be_throw(type_error(Type, Term))
     ).
 
-error__proper_list([]) :- !.
-error__proper_list([_|Tail]) :- !, error__proper_list(Tail).
-error__proper_list(Term) :-
-    ( var(Term) -> error__must_be_throw(instantiation_error)
-    ; error__must_be_throw(type_error(list, Term))
-    ).
+% A list ends in []; a partial list ends in a variable (including a variable
+% alone). Inspect before matching so validation never completes a partial list.
+% Keep the original term as the culprit when a tail cannot become a list.
+error__list(Term, _, Predicate, Mode) :- var(Term), !,
+    ( Mode == partial -> true
+    ; throw(error(instantiation_error, [predicate-Predicate])) ).
+error__list([], _, _, _) :- !.
+error__list([_|Tail], Original, Predicate, Mode) :- !,
+    error__list(Tail, Original, Predicate, Mode).
+error__list(_, Original, Predicate, _) :-
+    throw(error(type_error(list, Original), [predicate-Predicate])).
 
 error__proper_list_of([], _) :- !.
 error__proper_list_of([Head|Tail], Type) :- !,
@@ -90,37 +102,46 @@ error__proper_list_of(Term, _) :-
     ).
 
 can_be(Type, Term) :-
-    ( var(Type) -> instantiation_error(can_be/2)
+    ( var(Type) -> error__can_be_throw(instantiation_error)
     ; var(Term) -> true
     ; error__can_be(Type, Term)
     ).
 
+error__can_be_throw(Formal) :-
+    throw(error(Formal, [predicate-can_be/2])).
+
 error__can_be(integer, Term) :- !,
-    ( integer(Term) -> true ; type_error(integer, Term, can_be/2) ).
+    ( integer(Term) -> true ; error__can_be_throw(type_error(integer, Term)) ).
 error__can_be(atom, Term) :- !,
-    ( atom(Term) -> true ; type_error(atom, Term, can_be/2) ).
+    ( atom(Term) -> true ; error__can_be_throw(type_error(atom, Term)) ).
 error__can_be(number, Term) :- !,
-    ( number(Term) -> true ; type_error(number, Term, can_be/2) ).
-error__can_be(list, Term) :- !, error__partial_list(Term).
-error__can_be(list(Type), Term) :- !, error__partial_list_of(Term, Type).
+    ( number(Term) -> true ; error__can_be_throw(type_error(number, Term)) ).
+error__can_be(list, Term) :- !, error__list(Term, Term, can_be/2, partial).
+error__can_be(list(Type), Term) :- !,
+    error__list(Term, Term, can_be/2, partial),
+    error__partial_list_of(Term, Type, can_be/2).
+error__can_be(character, Term) :- !,
+    ( atom(Term), atom_length(Term, 1) -> true
+    ; error__can_be_throw(type_error(character, Term)) ).
+error__can_be(chars, Term) :- !,
+    error__list(Term, Term, can_be/2, partial),
+    error__partial_list_of(Term, character, can_be/2).
 error__can_be(not_less_than_zero, Term) :- !,
     ( integer(Term) ->
-        ( Term >= 0 -> true ; domain_error(not_less_than_zero, Term, can_be/2) )
-    ; type_error(integer, Term, can_be/2)
+        ( Term >= 0 -> true ; error__can_be_throw(domain_error(not_less_than_zero, Term)) )
+    ; error__can_be_throw(type_error(integer, Term))
     ).
-error__can_be(Type, Term) :- error__must_be(Type, Term).
-
-error__partial_list(Term) :- var(Term), !.
-error__partial_list([]) :- !.
-error__partial_list([_|Tail]) :- !, error__partial_list(Tail).
-error__partial_list(Term) :- type_error(list, Term, can_be/2).
+error__can_be(Type, Term) :-
+    catch(error__must_be(Type, Term), error(Formal, _), error__can_be_throw(Formal)).
 
-error__partial_list_of(Term, _) :- var(Term), !.
-error__partial_list_of([], _) :- !.
-error__partial_list_of([Head|Tail], Type) :- !,
-    can_be(Type, Head),
-    error__partial_list_of(Tail, Type).
-error__partial_list_of(Term, _) :- type_error(list, Term, can_be/2).
+error__partial_list_of(Term, _, _) :- var(Term), !.
+error__partial_list_of([], _, _) :- !.
+error__partial_list_of([Head|Tail], Type, Predicate) :-
+    ( var(Head) -> true
+    ; Predicate == must_be/2 -> must_be(Type, Head)
+    ; can_be(Type, Head)
+    ),
+    error__partial_list_of(Tail, Type, Predicate).
 
 instantiation_error :- throw(error(instantiation_error, [])).
 instantiation_error(Context) :- throw(error(instantiation_error, Context)).
@@ -140,8 +161,7 @@ call_with_error_context(Goal, Pair) :-
     error__require_pair(Pair),
     catch(Goal,
           error(Error, Context),
-          ( copy_term(Pair, Element),
-            throw(error(Error, [Element|Context])) )).
+          throw(error(Error, [Pair|Context]))).
 
 %  The element must be a pair (issue #99). The test is inlined rather than
 %  delegated to must_be(pair, _) so that the wrapper stays independent of the

package/src/lib/si.pl

@@ -69,32 +69,50 @@ si__condition((A;B)) :- si__condition(A), si__condition(B).
 %  names, f(X,a) @< f(X,b) by the second arguments, and X == X gives (=), while
 %  f(a) vs f(Y) and X vs 1 are genuinely undecided.
 compare_si(Order, A, B) :-
-    (  A == B
-    -> Order = (=)
-    ;  si__order_decided(A, B)
-    -> compare(Order, A, B)
-    ;  throw(error(instantiation_error, [predicate-compare_si/3]))
+    si__require_order(Order),
+    si__compare(Order, [A-B]).
+
+si__require_order(Order) :- var(Order), !.
+si__require_order(Order) :-
+    ( atom(Order) ->
+        ( (Order == (<) ; Order == (=) ; Order == (>)) -> true
+        ; throw(error(domain_error(order, Order), [predicate-compare_si/3]))
+        )
+    ; throw(error(type_error(atom, Order), [predicate-compare_si/3]))
     ).
 
-%  Both arguments are known to be non-identical here.
-si__order_decided(A, B) :- ( var(A) ; var(B) ), !, fail.
-si__order_decided(A, B) :-
+% Keep pending argument pairs in a work list. Recursing inside an if-then-else
+% condition retains a child Solver per list cell; testing whole-tail identity
+% at each step also repeatedly scans the same suffix (issue #105).
+si__compare(=, []).
+si__compare(Order, [A-B|Pairs]) :-
+    si__compare_pair(A, B, Comparison, Pairs, Next),
+    si__compare_next(Comparison, Order, Next).
+
+si__compare_next(=, Order, Pairs) :- si__compare(Order, Pairs).
+si__compare_next(<, <, _).
+si__compare_next(>, >, _).
+
+si__compare_pair(A, B, =, Pairs, Pairs) :-
+    ( var(A) ; var(B) ), !,
+    ( A == B -> true
+    ; throw(error(instantiation_error, [predicate-compare_si/3])) ).
+si__compare_pair([A|As], [B|Bs], =, Pairs, [A-B,As-Bs|Pairs]) :- !.
+si__compare_pair(A, B, Comparison, Pairs, Next) :-
     compound(A), compound(B), !,
     functor(A, NameA, ArityA),
     functor(B, NameB, ArityB),
-    (  ArityA =\= ArityB -> true
-    ;  NameA \== NameB -> true
+    (  ArityA =\= ArityB -> compare(Comparison, ArityA, ArityB), Next = Pairs
+    ;  NameA \== NameB -> compare(Comparison, NameA, NameB), Next = Pairs
     ;  A =.. [_|ArgsA],
        B =.. [_|ArgsB],
-       si__args_decided(ArgsA, ArgsB)
-    ).
-%  Otherwise both are non-variables and at least one is atomic, so either the
-%  type order or the values themselves settle it and no instantiation can
-%  change the outcome.
-si__order_decided(_, _).
-
-si__args_decided([A|As], [B|Bs]) :-
-    (  A == B
-    -> si__args_decided(As, Bs)
-    ;  si__order_decided(A, B)
+       Comparison = (=),
+       si__prepend_pairs(ArgsA, ArgsB, Next, Pairs)
     ).
+si__compare_pair(A, _, >, Pairs, Pairs) :- compound(A), !.
+si__compare_pair(_, B, <, Pairs, Pairs) :- compound(B), !.
+si__compare_pair(A, B, Comparison, Pairs, Pairs) :- compare(Comparison, A, B).
+
+si__prepend_pairs([], [], Pairs, Pairs).
+si__prepend_pairs([A|As], [B|Bs], [A-B|Pairs], Tail) :-
+    si__prepend_pairs(As, Bs, Pairs, Tail).

package/src/program.js

@@ -1219,7 +1219,7 @@ function collectAutoloadGoalDependencies(goal, out = []) {
     collectAutoloadGoalDependencies(goal.args[2], out);
   } else if ((goal.name === 'call_cleanup' || goal.name === 'setup_call_cleanup') && (goal.arity === 2 || goal.arity === 3)) {
     for (const arg of goal.args) collectAutoloadGoalDependencies(arg, out);
-  } else if (goal.name === 'call' && goal.arity === 1) {
+  } else if ((goal.name === 'call' || goal.name === 'time') && goal.arity === 1) {
     collectAutoloadGoalDependencies(goal.args[0], out);
   }
   return out;

package/test/regression/cases-regression.mjs

@@ -28,6 +28,103 @@ import {
 
 export function regressionCases() {
   return [
+    {
+      name: 'timed compare_si/3 backtracks over growing prefixes without exhausting the host stack (issue #105)',
+      run: () => {
+        // Bound the reported generator so the regression exhausts every
+        // answer, including sizes beyond the original 256-cell failure.
+        const result = runCli(['-'], { input:
+          '%% goal: answer(I,R,S)\n' +
+          'answer(I,R,S) :- length(_,I), (I =< 9 -> true ; !, fail), ' +
+          'N is 2^I, length(P,N), append(P,[1],L1), append(P,[2],L2), ' +
+          'time(compare(R,L1,L2)), time(compare_si(S,L1,L2)).\n',
+          timeout: 20000,
+        });
+        assertEqual(result.status, 0, `exit status; error=${result.error}; stderr=${result.stderr}`);
+        for (let i = 0; i <= 9; i++) {
+          assertIncludes(result.stdout, `answer(${i}, <, <).`, 'comparison result');
+        }
+        assertNotIncludes(result.stderr + result.stdout, 'Maximum call stack', 'host stack');
+      },
+    },
+    {
+      name: 'compare_si/3 work list preserves argument priority and instantiation errors',
+      run: () => {
+        const goals = [
+          'compare_si(=,f(X,g(Y)),f(X,g(Y))),var(X),var(Y)',
+          'compare_si(<,f(g(X),a),f(g(X),b)),var(X)',
+          'compare_si(>,f(g(b),a),f(g(a),z))',
+          'compare_si(<,[a|X],[b|Y]),var(X),var(Y)',
+          'compare_si(>,f(X),a),var(X)',
+          'compare_si(<,a,f(X)),var(X)',
+          '\\+ compare_si(>,f(g(X),a),f(g(X),b))',
+          'catch((compare_si(_,f(g(X),a),f(g(Y),b)),fail),error(instantiation_error,[predicate-compare_si/3]),true),var(X),var(Y)',
+        ];
+        for (const goal of goals) {
+          const result = runEyeProlog(`answer(ok) :- ${goal}.`, { goals: ['answer(X)'] });
+          assertIncludes(result.stdout, 'answer(ok)', goal);
+        }
+      },
+    },
+    {
+      name: 'compare_si/3 validates Order before term instantiation (issue #100)',
+      run: () => {
+        for (const terms of ['A,B', 'A,A', '1,2']) {
+          for (const [order, formal] of [['x', 'domain_error(order, x)'], ['1', 'type_error(atom, 1)']]) {
+            const result = runCli([], { input: `compare_si(${order},${terms}).\nhalt.\n` });
+            assertIncludes(result.stdout, `error(${formal}, [predicate-compare_si/3])`, 'order error');
+          }
+        }
+      },
+    },
+    {
+      name: 'list and chars type checks preserve partial lists and report precise errors (issues #102 and #103)',
+      run: () => {
+        const goals = [
+          'catch(must_be(list,L),error(instantiation_error,[predicate-must_be/2]),true),var(L)',
+          'catch(must_be(list,[a|L]),error(instantiation_error,[predicate-must_be/2]),true),var(L)',
+          'catch(must_be(list(integer),L),error(instantiation_error,[predicate-must_be/2]),true),var(L)',
+          'catch(must_be(list(integer),[1|L]),error(instantiation_error,[predicate-must_be/2]),true),var(L)',
+          'must_be(list,[X]),var(X)',
+          'must_be(chars,[a,b])',
+          'catch(must_be(chars,[C]),error(instantiation_error,[predicate-must_be/2]),true),var(C)',
+          'catch(must_be(chars,[C,ab]),error(type_error(character,ab),[predicate-must_be/2]),true),var(C)',
+          'can_be(chars,[C|L]),var(C),var(L)',
+          'can_be(list(integer),[C|L]),var(C),var(L)',
+          'catch(can_be(chars,[C|1]),error(type_error(list,[D|1]),[predicate-can_be/2]),true),var(C),var(D)',
+          'catch(must_be(chars,[C|1]),error(type_error(list,[D|1]),[predicate-must_be/2]),true),var(C),var(D)',
+          'catch(can_be(chars,[ab|L]),error(type_error(character,ab),[predicate-can_be/2]),true),var(L)',
+          'catch(can_be(pair,a),error(type_error(pair,a),[predicate-can_be/2]),true)',
+          'catch(can_be(integer,a),error(type_error(integer,a),[predicate-can_be/2]),true)',
+        ];
+        for (const goal of goals) {
+          const result = runCli(['-'], { input: `:- use_module(library(error)).\n%% goal: answer(X)\nanswer(ok) :- ${goal}.\n` });
+          assertEqual(result.status, 0, `${goal}: ${result.stderr}`);
+          assertIncludes(result.stdout, 'answer(ok)', goal);
+        }
+      },
+    },
+    {
+      name: 'call_with_error_context/2 preserves repeated variables in context pairs (issue #104)',
+      run: () => {
+        const result = runCli(['-'], { input: ':- use_module(library(error)).\n%% goal: answer(X)\n' +
+          'answer(ok) :- catch(call_with_error_context(throw(error(problem(X),[inner-X])),outer-f(Y,Y)),error(problem(A),[outer-f(B,C),inner-D]),true),B==C,A==D,var(Y).\n' });
+        assertEqual(result.status, 0, result.stderr);
+        assertIncludes(result.stdout, 'answer(ok)', 'shared error variables');
+      },
+    },
+    {
+      name: 'time/1 autoloads compare_si/3 on its first call (issue #105)',
+      run: () => {
+        const goal = 'length(P,8),append(P,[1],L1),append(P,[2],L2),time(compare(R,L1,L2)),time(compare_si(S,L1,L2))';
+        const repl = runCli([], { input: `${goal}.\n.\nhalt.\n` });
+        assertNotIncludes(repl.stdout, 'existence_error', 'first REPL call');
+        assertIncludes(repl.stdout, 'S = (<)', 'timed comparison');
+        const file = runCli(['-'], { input: `%% goal: answer(X)\nanswer(ok) :- ${goal},R==S.\n` });
+        assertEqual(file.status, 0, file.stderr);
+        assertIncludes(file.stdout, 'answer(ok)', 'file autoload');
+      },
+    },
     {
       name: 'dif/2 passes the WG17 finite-tree comparison cases (issue #68)',
       run: () => {
@@ -4638,9 +4735,9 @@ answer(Result) :- countdown(2048, Result), Result = 2048.
       },
     },
     {
-      // UWN asked for copy_term/2 semantics on the added element so that
-      // variables in it are not shared with bindings undone during unwinding.
-      name: 'call_with_error_context/2 copies the context element',
+      // Throwing the error ball already freshens its variables; the wrapper
+      // does not need a separate copy_term/2 call (issue #104).
+      name: 'throw/1 freshens variables in the propagated context element',
       run: () => {
         const input = ':- use_module(library(error)).\n%% goal: answer(X)\n' +
           'answer(ok) :- catch(call_with_error_context(atom_length(1.0,_), ctx-V), error(_,[ctx-W|_]), (V == W -> fail ; true)).\n';

package/the-art-of-eyeprolog.md

@@ -10794,8 +10794,10 @@ The host decides whether to reject, report, or inspect those answers.
 definite program; equivalently, the fixed point obtained by repeatedly adding
 supported ground consequences.
 
-**List.** Either `[]` or a cons cell written `[Head | Tail]`. A proper list
-eventually ends in `[]`.
+**List.** Either `[]` or `[Head | Tail]` where `Tail` is a list. A list
+ends in `[]`. A partial list ends in a variable, for example `[X,Y|Xs]`;
+a variable alone is also a partial list. `[X,Y|non_list]` is an instance
+of a partial list that is not a list.
 
 **Mode.** An intended direction of use described by which arguments are
 supplied and which are produced.