swipl-devel icon indicating copy to clipboard operation
swipl-devel copied to clipboard

Using `Dict.Key` inside of lambda expression inside of maplist causes compiler to build wrong code

Open dtonhofer opened this issue 3 years ago • 0 comments

Still playing with dicts.

A simple test: print the values of three keys from a dict (the alfa/1 and bravo/1 predicates have been consulted from a file)

Do not forget to run this

use_module(library(apply)).
use_module(library(yall)).

to avoid problems (with dynamic compilation?) whereby the variables inside yall expressions become visible to the outside context.

Then load this file

alfa(Dict) :- maplist({Dict}/[Key]>>(get_dict(Key,Dict,Val),format("~q\n",[Val])),[a,b,c]).  % works
bravo(Dict) :- maplist( ({Dict}/[Key]>> ( Dict.Key=Val,format("~q\n",[Val]) )) , [a,b,c]).    % doesn't work

Then:

alfa/1uses get_dict/3 and works

alfa(Dict) :- maplist({Dict}/[Key]>>(get_dict(Key,Dict,Val),format("~q\n",[Val])),[a,b,c]).

?- alfa(_{a:1,b:2,c:3}).
1
2
3
true.

listing(alfa/1) shows:

alfa(A) :-
    maplist('__aux_yall_7802335efc30679f9d993e372e4239950b60e572'(A),
            [a, b, c]).
            
'__aux_yall_7802335efc30679f9d993e372e4239950b60e572'(A, B) :-
    get_dict(B, A, C),
    format("~q\n", [C]).

Correct!

bravo/1uses ./2 and does not work

Now a nominally equivalent predicate using ./3 which goes off the rails:

bravo(Dict) :- maplist( ({Dict}/[Key]>> ( Dict.Key=Val,format("~q\n",[Val]) )) , [a,b,c]).
?- bravo(_{a:1,b:2,c:3}).
1
false.

The generated code computes the dict-get-result outside of the maplist context.

But on second thought, this is the same problem as in my earlier report ... Prolog does not know this is Lambda expression and is content with replacing the dot-call with a variable whose value is computed before the term that contained the dot-call.

And it cannot replace the dot-call by a by a call to get_dict/3 because this may become a function call.

?- listing(bravo/1).
bravo(Dict) :-
    '.'(Dict, Key, A),
    maplist({Dict}/[Key]>>(A=Val, format("~q\n", [Val])),
            [a, b, c]).

dtonhofer avatar Oct 09 '20 19:10 dtonhofer