Bracy part of `{X}/[Y,Z]>>foo(X,Y,Z)` - does it have any effect?

At yall.pl – Lambda expressions, we read:

The {...} optional part is used for lambda-free variables. The order of variables doesn’t matter hence the {...} set notation.

The “bracy part” is indeed “optional” in that it seems to have no effect at all, at least in the context of maplist/N (see tests c2 and c3 below). It really should be mandatory (IMHO etc, hopefully in a future version).

But is there anyplace currently where it is NOT optional? Maybe in Logtalk?

:- begin_tests(maplist_and_yall).

% ---
% Calling maplist/4 with an atomic goal and an equivalent
% Lambda-Expression
% (i.e. a "predicate shim") suing library(yall).
% Everything is as expected.
% ---

test(a1, true(L = [a1, b2, c3, d4])) :- 
   maplist(atom_concat, [a,b,c,d], [1,2,3,4], L).
test(a2, true(L = [a1, b2, c3, d4])) :- 
   maplist([X,Y,Z]>>atom_concat(X,Y,Z), [a,b,c,d], [1,2,3,4], L).

% ---
% Calling maplist/3 with a "Prolog closure" (i.e. an atomic goal with 
% leftmost arguments instantiated).
% Alternatively, calling maplist/3 with a dedicated helper predicate.
% Everything is as expected. But as usual, Richard III applies: "A 
% clause-local namespace accepting predicates, my kingdom for a
% clause-local namespace accepting predicates ... that I 
% can just cut & paste at the toplevel without having to go [user].!". 
% "No, sir!"
% ---

test(b1, true(L = [a1, a2, a3, a4])) :- 
   maplist(atom_concat(a), [1,2,3,4], L).

b2_helper(X,Y) :- atom_concat(a,X,Y). 

test(b2, true(L = [a1, a2, a3, a4])) :- 
   maplist(atom_concat(a), [1,2,3,4], L).

% ---
% Alternatively, calling maplist/3 with and Lambda-Expressions from
% library(yall):
%
% The point of the exercise is here: c2 and c3 work the same, the "{X}"
% notation which is supposed to "grab a variable from the enclosing
% context" has no effect, really.
% ---

test(c1, true(L = [a1, a2, a3, a4])) :- 
   maplist([Y,Z]>>atom_concat(a,Y,Z), [1,2,3,4], L).
test(c2, true(L = [a1, a2, a3, a4])) :- 
   X=a, maplist([Y,Z]>>atom_concat(X,Y,Z), [1,2,3,4], L).
test(c3, true(L = [a1, a2, a3, a4])) :- 
   X=a, maplist({X}/[Y,Z]>>atom_concat(X,Y,Z), [1,2,3,4], L).

% ---
% Alternatively, an example accepting fresh variables (a leftover in my
% test code, just adding it)
% ---

freshy(X,fresh)    :- var(X),!.
freshy(X,cured(X)) :- nonvar(X).

test(d1, true(L = ["fresh 1", "fresh 2", "fresh 3", "fresh 4"])) :- 
   maplist([Y,Z]>>(freshy(_X,Xf),with_output_to(string(Z),format("~q ~q",[Xf,Y]))), [1,2,3,4], L).

test(d2, true(L =  ["cured(a) 1", "cured(a) 2", "cured(a) 3", "cured(a) 4"])) :- 
   X=a, maplist([Y,Z]>>(freshy(X,Xf),with_output_to(string(Z),format("~q ~q",[Xf,Y]))), [1,2,3,4], L).

:- end_tests(maplist_and_yall).

rt :- run_tests(maplist_and_yall).

This is a side effect of using autoloading.
If you explicitly include the modules at the start of your script:

:- use_module(library(apply)).
:- use_module(library(yall)).

Then running the tests shows:

ERROR: test.pl:48:
	test c2: received error: atom_concat/3: Arguments are not sufficiently instantiated
..
ERROR: test.pl:64:
	test d2: wrong answer (compared using =)
ERROR:     Expected: ["cured(a) 1","cured(a) 2","cured(a) 3","cured(a) 4"]
ERROR:     Got:      ["fresh 1","fresh 2","fresh 3","fresh 4"]
1 Like

Autoloading changes program semantics?

More precisely, the semantics of “interpreted” yall expressions is not the same as of “compiled” yall expressions AFAIK. There has been discussion on this before on this list as far as I recall.

2 Likes

Taking a closer look.

Let’s define:

bracy(L)   :- X=a, maplist({X}/[Y,Z]>>atom_concat(X,Y,Z), [1,2,3,4], L).
nobracy(L) :- X=a, maplist([Y,Z]>>atom_concat(X,Y,Z), [1,2,3,4], L).

At the toplevel, add them with [user].. Then both predicates work.

And we can list them. The code is still unmodified, yall syntax:

?- listing(bracy).
bracy(D) :-
    A=a,
    maplist({A}/[B, C]>>atom_concat(A, B, C),
            [1, 2, 3, 4],
            D).

true.

?- listing(nobracy).
nobracy(D) :-
    A=a,
    maplist([B, C]>>atom_concat(A, B, C),
            [1, 2, 3, 4],
            D).

true.

On the other hand, load the modules first, as indicated by Ian:

?- use_module(library(apply)).
true.

?- use_module(library(yall)).
true.

?- [user].
|: bracy(L)   :- X=a, maplist({X}/[Y,Z]>>atom_concat(X,Y,Z), [1,2,3,4], L).
|: nobracy(L) :- X=a, maplist([Y,Z]>>atom_concat(X,Y,Z), [1,2,3,4], L).
|: % user://1 compiled 0.01 sec, 5 clauses
true.

Then run them. The code is more picky and nobracy/1 isn’t working:

?- bracy(X).
X = [a1, a2, a3, a4].

?- nobracy(X).
ERROR: Arguments are not sufficiently instantiated

Listing reveals bracy/1 has been compiled down to a standard “closure” call (and one could actually be simplified even some more … time for another compiler pass?):

?- listing(bracy).
bracy(B) :-
    A=a,
    maplist('__aux_yall_c4b80c202b8df1475ce81b2dc37eebc9678604b8'(A),
            [1, 2, 3, 4],
            B).

true.

?- listing('__aux_yall_c4b80c202b8df1475ce81b2dc37eebc9678604b8').
'__aux_yall_c4b80c202b8df1475ce81b2dc37eebc9678604b8'(A, B, C) :-
    atom_concat(A, B, C).

true.

versus nobracy where the X indeed stays (correctly) restricted to the “inner context” and reappears as _ in a helper predicate:

?- listing(nobracy).
nobracy(A) :-
    true,
    maplist('__aux_yall_c4da103176fa8ec13a605c05ca9dd921fc8acdbf',
            [1, 2, 3, 4],
            A).

true.

?- listing('__aux_yall_c4da103176fa8ec13a605c05ca9dd921fc8acdbf').
'__aux_yall_c4da103176fa8ec13a605c05ca9dd921fc8acdbf'(A, B) :-
    atom_concat(_, A, B).

true.

Which is not going to work.

The compiler could protest if it knew about allowed modes of atom_concat/3. Not yet, not yet…