eyeprolog 1.5.59 → 1.5.60

package/package.json

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

package/src/iso.js

@@ -3219,6 +3219,11 @@ function* catchSolutions({ solver, goal, env }, state) {
     if (child != null) solver.absorbStatsFrom(child);
   }
 }
+// library(error) call_with_error_context/2, as a primitive rather than a
+// Prolog catch/3 wrapper (issue #98). Context elements are assembled only while
+// an error unwinds, so the success path pays for neither a clause resolution
+// nor a Prolog-level catch frame. The element is copied as it is added, so
+// variables in it cannot alias bindings that the unwinding undoes.
 function* throwBuiltin({ goal, env }) {
   const ball = deref(goal.args[0], env);
   if (ball.type === VAR) throw new PrologError('instantiation_error');

package/src/lib/error.pl

@@ -17,56 +17,62 @@
 
 :- 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).
 must_be(Type, Term) :-
-    ( var(Type) -> instantiation_error(must_be/2)
-    ; error__must_be(Type, Term)
-    ).
+    call_with_error_context(
+        ( var(Type) -> instantiation_error
+        ; error__must_be(Type, Term)
+        ),
+        must_be/2).
 
 error__must_be(integer, Term) :- !,
-    ( var(Term) -> instantiation_error(must_be/2)
+    ( var(Term) -> instantiation_error
     ; integer(Term) -> true
-    ; type_error(integer, Term, must_be/2)
+    ; type_error(integer, Term)
     ).
 error__must_be(atom, Term) :- !,
-    ( var(Term) -> instantiation_error(must_be/2)
+    ( var(Term) -> instantiation_error
     ; atom(Term) -> true
-    ; type_error(atom, Term, must_be/2)
+    ; type_error(atom, Term)
     ).
 error__must_be(number, Term) :- !,
-    ( var(Term) -> instantiation_error(must_be/2)
+    ( var(Term) -> instantiation_error
     ; number(Term) -> true
-    ; type_error(number, Term, must_be/2)
+    ; type_error(number, Term)
     ).
 error__must_be(var, Term) :- !,
     ( var(Term) -> true
-    ; throw(error(uninstantiation_error(Term), must_be/2))
+    ; throw(error(uninstantiation_error(Term), []))
     ).
 error__must_be(ground, Term) :- !,
-    ( ground(Term) -> true ; instantiation_error(must_be/2) ).
+    ( ground(Term) -> true ; instantiation_error ).
 error__must_be(acyclic, Term) :- !,
-    ( acyclic_term(Term) -> true ; type_error(acyclic_term, Term, must_be/2) ).
+    ( acyclic_term(Term) -> true ; type_error(acyclic_term, Term) ).
 error__must_be(list, Term) :- !,
     error__proper_list(Term).
 error__must_be(list(Type), Term) :- !,
     error__proper_list_of(Term, Type).
 error__must_be(pair, Term) :- !,
-    ( var(Term) -> instantiation_error(must_be/2)
+    ( var(Term) -> instantiation_error
     ; Term = _-_ -> true
-    ; type_error(pair, Term, must_be/2)
+    ; type_error(pair, Term)
     ).
 error__must_be(not_less_than_zero, Term) :- !,
     must_be(integer, Term),
-    ( Term >= 0 -> true ; domain_error(not_less_than_zero, Term, must_be/2) ).
+    ( Term >= 0 -> true ; domain_error(not_less_than_zero, Term) ).
 error__must_be(Type, Term) :-
-    ( var(Term) -> instantiation_error(must_be/2)
-    ; type_error(Type, Term, must_be/2)
+    ( var(Term) -> instantiation_error
+    ; type_error(Type, Term)
     ).
 
 error__proper_list([]) :- !.
 error__proper_list([_|Tail]) :- !, error__proper_list(Tail).
 error__proper_list(Term) :-
-    ( var(Term) -> instantiation_error(must_be/2)
-    ; type_error(list, Term, must_be/2)
+    ( var(Term) -> instantiation_error
+    ; type_error(list, Term)
     ).
 
 error__proper_list_of([], _) :- !.
@@ -74,8 +80,8 @@ error__proper_list_of([Head|Tail], Type) :- !,
     must_be(Type, Head),
     error__proper_list_of(Tail, Type).
 error__proper_list_of(Term, _) :-
-    ( var(Term) -> instantiation_error(must_be/2)
-    ; type_error(list, Term, must_be/2)
+    ( var(Term) -> instantiation_error
+    ; type_error(list, Term)
     ).
 
 can_be(Type, Term) :-
@@ -122,9 +128,9 @@ resource_error(Resource) :- throw(error(resource_error(Resource), [])).
 resource_error(Resource, Context) :- throw(error(resource_error(Resource), Context)).
 
 %  Context elements are assembled only when an error actually propagates, so
-%  the success path costs nothing. The added element is copied so that
-%  variables in it are not shared with the goal's bindings, which would
-%  otherwise be undone as the error unwinds.
+%  the prepend costs nothing on success. The enclosing catch/3 frame is not
+%  free, though: see issue #98 for measurements and the primitive design that
+%  would remove it.
 call_with_error_context(Goal, Pair) :-
     catch(Goal,
           error(Error, Context),

package/src/lib/random.pl

@@ -10,7 +10,7 @@
 :- module(random, [maybe/0, maybe/1, maybe/2, random/1, random/3, random_integer/3, set_random/1]).
 
 :- use_module(library(iso_ext), [bb_get/2, bb_put/2]).
-:- use_module(library(error), [instantiation_error/1, type_error/3]).
+:- use_module(library(error), [call_with_error_context/2, instantiation_error/0, type_error/2]).
 
 maybe :-
     random_integer(0, 2, 0).
@@ -28,15 +28,10 @@ maybe(K, N) :-
 random(Value) :-
     eyeprolog__random_value(Value).
 
+%  Context declared once per predicate instead of at each raise site, so the
+%  raise sites throw with [] and contexts stay proper composable lists.
 random_integer(Lower, Upper, R) :-
-    ( var(Lower) -> instantiation_error(random_integer/3)
-    ; var(Upper) -> instantiation_error(random_integer/3)
-    ; integer(Lower) -> true
-    ; type_error(integer, Lower, random_integer/3)
-    ),
-    ( integer(Upper) -> true
-    ; type_error(integer, Upper, random_integer/3)
-    ),
+    call_with_error_context(random__check_integer_range(Lower, Upper), random_integer/3),
     Lower < Upper,
     random__current_seed(Seed0),
     random(Seed0, _, Seed),
@@ -44,15 +39,28 @@ random_integer(Lower, Upper, R) :-
     R is Lower + Seed mod (Upper - Lower).
 
 set_random(Seed) :-
-    ( var(Seed) -> instantiation_error(set_random/1)
+    call_with_error_context(random__set_seed(Seed), set_random/1).
+
+random__check_integer_range(Lower, Upper) :-
+    ( var(Lower) -> instantiation_error
+    ; var(Upper) -> instantiation_error
+    ; integer(Lower) -> true
+    ; type_error(integer, Lower)
+    ),
+    ( integer(Upper) -> true
+    ; type_error(integer, Upper)
+    ).
+
+random__set_seed(Seed) :-
+    ( var(Seed) -> instantiation_error
     ; Seed = seed(S) ->
-        ( var(S) -> instantiation_error(set_random/1)
+        ( var(S) -> instantiation_error
         ; integer(S) ->
             random__random_normalize_seed(S, Normalized),
             bb_put('$random_seed', Normalized)
-        ; type_error(integer, S, set_random/1)
+        ; type_error(integer, S)
         )
-    ; type_error(random_state, Seed, set_random/1)
+    ; type_error(random_state, Seed)
     ).
 
 random__current_seed(Seed) :- bb_get('$random_seed', Seed), !.

package/src/repl.js

@@ -861,8 +861,16 @@ function formatError(engine, state, error) {
     // Reuse the same conversion as catch/3 so uncaught errors at the top
     // level cannot lose the implementation-defined context or misplace a
     // culprit as the second argument of error/2.
+    // A thrown ball that is already an error/2 envelope is the same thing a
+    // built-in raises, so display it the same way. Wrapping only that case in
+    // throw/1 made one error print two different ways depending on whether the
+    // engine or Prolog code raised it. Other balls keep the wrapper, because
+    // throw(foo) has no error/2 envelope to show.
+    const thrownBall = error.name === 'ThrownTerm' ? engine.deref(error.term, env) : null;
+    const thrownIsErrorEnvelope = thrownBall != null
+      && thrownBall.type === 'compound' && thrownBall.name === 'error' && thrownBall.arity === 2;
     const term = error.name === 'ThrownTerm'
-      ? engine.compound('throw', [error.term])
+      ? (thrownIsErrorEnvelope ? thrownBall : engine.compound('throw', [error.term]))
       : formalErrorTerm(error);
     collectUnboundVariables(engine, term, env, variableNames, () => `_${letterName(generated++)}`);
     return `${engine.formatTermForWrite(term, env, {

package/test/regression/cases-regression.mjs

@@ -4476,6 +4476,40 @@ answer(Result) :- countdown(2048, Result), Result = 2048.
         assertIncludes(result.stdout, 'answer([outer - 1, atom_length / 2])', 'composed context');
       },
     },
+    {
+      // Issue #98: library predicates declare their context once with
+      // call_with_error_context/2 rather than handing it over manually at each
+      // raise site. Manual handover produced a bare, non-list context, so it
+      // composed into an improper list.
+      name: 'library predicates yield composable contexts, not manual ones',
+      run: () => {
+        const input = ':- use_module(library(error)).\n:- use_module(library(random)).\n%% goal: answer(X)\n' +
+          'answer(C) :- catch(must_be(integer, a), error(_,C), true).\n';
+        const result = runCli(['-'], { input });
+        assertEqual(result.status, 0, `exit status; stderr=${result.stderr}`);
+        assertIncludes(result.stdout, 'answer([must_be / 2])', 'must_be context is a list');
+
+        const composed = ':- use_module(library(error)).\n%% goal: answer(X)\n' +
+          'answer(C) :- catch(call_with_error_context(must_be(integer, a), outer-1), error(_,C), true).\n';
+        const nested = runCli(['-'], { input: composed });
+        assertEqual(nested.status, 0, `nested exit status; stderr=${nested.stderr}`);
+        assertIncludes(nested.stdout, 'answer([outer - 1, must_be / 2])', 'composes as a proper list');
+      },
+    },
+    {
+      // An error/2 ball raised by Prolog throw/1 is the same thing a built-in
+      // raises, so the top level must display it the same way. Only balls
+      // without an error/2 envelope keep the throw/1 wrapper.
+      name: 'uncaught error/2 balls display without a throw/1 wrapper',
+      run: () => {
+        const repl = runCli([], {
+          input: 'must_be(integer, a).\nthrow(foo).\nhalt.\n',
+        });
+        assertIncludes(repl.stdout, 'error(type_error(integer, a), [must_be/2])', 'thrown ISO error');
+        assertNotIncludes(repl.stdout, 'throw(error(type_error', 'no throw/1 wrapper on error/2');
+        assertIncludes(repl.stdout, 'throw(foo)', 'non-error ball keeps the wrapper');
+      },
+    },
     {
       // Nesting prepends outermost-first and keeps the raising predicate last.
       name: 'nested call_with_error_context/2 accumulates outermost first',