Prolog dictionaries

I was once involved in a mail conversation about this, where I thought I had some good argument for why dicts may be nice to have, as well as some good arguments against. I repeat them here:

Why dicts might be great to have in Web Prolog

A. They map naturally to JSON. This might be a great feature in a web programming language.

B. If messages were dicts instead of ordinary terms, then instead of

wait_answer(Query, Pid) :-
    receive({
        failure(Pid) -> fail;
        error(Pid, Exception) ->
            throw(Exception);
        success(Pid, Solutions, true) ->
            (   member(Query, Solutions)
            ;   pengine_next(Pid),
                wait_answer(Query, Pid)
            );
        success(Pid, Solutions, false) ->
            member(Query, Solutions)
    }).

they would allow us to write something like this (untested!):

wait_answer(Query, Pid) :-
    receive({
        failure{pid:Pid} -> fail;
        error{pid:Pid} = Msg ->
            throw(Msg.data);
        success{pid:Pid, more:true} = Msg ->
            (   member(Query, Msg.data)
            ;   pengine_next(Pid),
                wait_answer(Query, Pid)
            );
        success{pid:Pid} = Msg ->
            member(Query, Msg.data)
    }).

The advantage of the second formulation is that it would work even if (say) the success dict was extended with (say) timing information. Note that the success terms in library(pengines) now have no less than five arguments (success(ID, Data, Projection, Time, More)). In the first formulation we would have to match all of them using anonymous variables for the arguments that we perhaps are not interested in. Using dicts we can easily avoid that.

C. I also think that sideways open dicts would be great to have. This is something that does not appear in other Web standards, but which would fit in very well in a web-enabled Prolog dialect such as
Web Prolog. Supporting JSON terms would show Web Prolog cares enough about web formats to treat JSON as a first class citizen. This is likely to look good in the eyes of the W3C, since JSON unification is something which seems to both fit in very well with Prolog and to be very useful when manipulating JSON. I once wrote this proposal: https://github.com/SWI-Prolog/roadmap/issues/50.

Computational linguists would love them, and in combination with the close relationship between dicts and JSON, we could argue that we offer JSON unification.

On the other hand… my own emphasis is on the notion of an actor and the abstractions (pengines and non-deterministic RPC) built on top of actors. Strings or no strings, dicts or no dicts - I see that as less important. It would work either way.

The problem I mention as point B can of course be solved like so instead:

wait_answer(Query, Pid) :-
    receive({
        failure(Pid) -> fail;
        error(Pid, Exception) ->
            throw(Exception);
        success(Pid, Solutions, true, _) ->
            (   member(Query, Solutions)
            ;   pengine_next(Pid),
                wait_answer(Query, Pid)
            );
        success(Pid, Solutions, false, _) ->
            member(Query, Solutions)
    }).

That is, each message is be given just one more argument, where information such as timing informations and projections can be stored if they are accessible and if you need it. This might be a (possibly empty) list of terms such as time(T), projections(Ps), so that you, if you want to select a receive clause on the basis of this information, can use memberchk/2 in the following manner:

        success(Pid, Solutions, true, Info)
            when memberchk(time(T), Info) ->
                ....

(Independent of the use of data type, we probably want to introduce options that can be passed to pengine_spawn/2 or pengine_ask/3 in order to “ask” for such information when the caller needs it.)

So, B is perhaps no big deal.

I’m also aware of the existence of the old method for representing JSON, the one that was used when SWI-Prolog didn’t have strings or dicts. That would work too, I suppose, although, if I remember well,
the representation has a problem distinguishing a list of integers from a string, something which JSON does. In my experience, one can live with that. It might be solvable without introducing strings. So my point A is no big deal either, I suppose.

And the same is true for library(assoc). You cannot create a realistic indexed name-value pair datatype with these properties, at least I wouldn’t know how. As shown in a pack, you can use constraints (attributed variables) to realise open dicts and you can probably also express “X should be a dict with a key g” this way and fail if this is not the case or add one it it is an open dict (constraint).

I don’t think this should be the goal of the core Prolog system. The core Prolog system should support such extensions in a friendly way though.

If you want to discuss dicts, please continue in a new topic. I must admit I’m mostly done with this discussion. We had that years ago. It has been discussed and suggested recently to use something else than a variable for the tag of anonymous dicts. This never really materialized. After all it is free for anyone to choose what s/he wants. Your claim on effect on GC seems strange to me. At least for the mark-and-sweep algorithm of SWI (after a paper by Mats Carlson) there is no impact. Otherwise an increasing number of people seem to be using them.

1 Like

(post withdrawn by author, will be automatically deleted in 24 hours unless flagged)

5 posts were split to a new topic: Splitting topics - a side discussion

(post withdrawn by author, will be automatically deleted in 24 hours unless flagged)

I use this code to ensure that there are no uninstantiated tags in my dicts from reading JSON:

my_json_read_dict(Stream, Dict) :-
    json_read_dict(Stream, Dict, [value_string_as(atom), end_of_file(end_of_file)]),
    set_json_dict_tag(json, Dict).

set_json_dict_tag(DefaultTag, Term) :-
    (  is_dict(Term),                                                                                                          
       dict_pairs(Term, DefaultTag, Pairs) % instantiates the tag
    -> pairs_values(Pairs, Values),                                                                                            
       maplist(set_json_dict_tag(DefaultTag), Values) 
    ;  is_dict(Term)            % tag != DefaultTag
    -> dict_pairs(Term, _, Pairs), % the tag is already set -- leave it
       pairs_values(Pairs, Values),
       maplist(set_json_dict_tag(DefaultTag), Values)
    ;  is_list(Term)
    -> maplist(set_json_dict_tag(DefaultTag), Term) 
    ;  true                     % do nothing for non-dicts
    ).    

Alternatively, use the default_tag option:

13 ?- [library(http/json)].
true.

14 ?- json_read_dict(current_input, Dict, [default_tag(json)]).
|: {"a":1}

Dict = json{a:1}.
2 Likes