Example that shows how to use call_dcg/3 to implement state/context?

I’m using: SWI-Prolog version 8.1.9.

I have a DCG app coming up where I’m going to want to carry some state variables around during the parse. I noticed that the help page on call_dcg/3 seems to indicate you can use this call to do this:

https://www.swi-prolog.org/pldoc/doc_for?object=call_dcg/3

Is there a sophisticated example around that shows how to do this using SWI-Prolog and call_dcg/3?

To me the question is a bit confusing but understandably why it is confusing is because you are just learning about DCGs. As such I will answer this by taking various parts of the question out and and answer them but not in the order asked.

I don’t think I have ever used call_dcg/3 (source) except once to check it out to see how it works, I essentially use just phrase/3 (source) instead. The reason being that in the documentation it notes,

This predicate (call_dcg/3) was introduced after type checking was added to phrase/3.

In looking at the source one notices that phrase/3 executes call_dcg/3 but phrase/3 also has some type checking. I have never found the type checking of phrase/3 to cause me problems. Also most example you find will use phrase/2 which is just

phrase(RuleSet, Input) :-
    phrase(RuleSet, Input, []).

so essentially, phrase/2 is phrase/3 with the third parameter being set to [].

So the example below will use phrase/3.


Use phrase/2 or phrase/3.


I don’t know what you mean by sophisticated, so I will give what I consider a plain and simple example.

For the example I will use digits//1 (source) from library DCG basics - (predicates)

Notice that the signature of digits//1 has two / and not one. This is because digits//1 is to not be though of as a Prolog predicate with 1 argument but a clause with 1 visible argument. In reality it is also digits/3, a predicate with 3 arguments. To see this use listing/1, e.g.

?- listing(digits/3).
dcg_basics:digits([H|T], A, B) :-
    digit(H, A, C),
    !,
    D=C,
    digits(T, D, B).
dcg_basics:digits([], A, A).

true.

compare that with the source code

digits([H|T]) -->
	digit(H), !,
	digits(T).
digits([]) -->
	[].

listing/1 with digits//1 also works.

?- listing(digits//1).
dcg_basics:digits([H|T], A, B) :-
    digit(H, A, C),
    !,
    D=C,
    digits(T, D, B).
dcg_basics:digits([], A, A).

true.

If you change the A and B to S0 and S
and C to S1
and D to S2
you get

dcg_basics:digits([H|T], S0, S) :-
    digit(H, S0, S1),
    !,
    S2=S1,
    digits(T, S2, S).
dcg_basics:digits([], S0, S0).

which is the S0 and S from call_dcg/3. So S0 and S are hidden state variables you are looking to pass around.

For the actual example I will use Prolog unit tests so that you will and others will have the basic template for doing this and so that you can add more test easily without having to write the basic code over and over.

:- use_module(library(dcg/basics)).

:- begin_tests(digits).

digits_test_case("1",[49],[]).
digits_test_case("1",[0'1],[]).

test(001, [forall(digits_test_case(Input,Expected_digits,Expected_rest))]) :-
    string_codes(Input,Codes),
    DCG = digits(Digits),
    phrase(DCG,Codes,Rest),
    assertion( Rest == Expected_rest ),
    assertion( Digits == Expected_digits ).

:- end_tests(digits).

To use this consult the code as normal, then run_tests.

?- consult("C:/Users/Eric/Documents/Projects/Prolog/swi-discourse_004.pl").
true.

?- run_tests.
% PL-Unit: digits .. done
% All 2 tests passed
true.

This shows that the code was successfully loaded and that the two test case ran successfully.

The two test case are identical, but the expected result, while being the same, is written with two different ways of portraying the ASCII character 1. The first is as the character code as a decimal, 49 and the second is as a special Prolog form that uses the human readable glyph for the number one, 1 but so that it is converted to the character code during complication, the 0' prefix tells the compiler to covert this to a character code.

To add more test cases just edit the code and save

digits_test_case("9",[0'9],[]).
digits_test_case("123",[0'1,0'2,0'3],[]).

then run make.

?- make.
% c:/users/eric/documents/projects/prolog/swi-discourse_004 compiled 0.00 sec, 1 clauses
% PL-Unit: digits .... done
% All 4 tests passed
true.

The code loaded, compiled, ran 4 tests, and all 4 tests passed.


When using DCGs, some people like to process the data as characters codes and some people like to process the data as atoms. It took me a while to get this. The code in the library dcg/basics processes the data as character codes so be fore warned.

You should also be aware of set_prolog_flag/2 and the option doublequotes. See: The string type and its double quoted syntax. I used it in this earlier example


Since digits//1 is really digits/3 you can also do this

digits(Digits,S0,S).

If you add this test case to the example which uses digits/3 instead

test(002, [forall(digits_test_case(Input,Expected_digits,Expected_rest))]) :-
    string_codes(Input,Codes),
    digits(Digits,Codes,Rest),
    assertion( Rest == Expected_rest ),
    assertion( Digits == Expected_digits ).

then you get

?- make.
% c:/users/eric/documents/projects/prolog/swi-discourse_004 compiled 0.00 sec, 2 clauses
% PL-Unit: digits ........ done
% All 8 tests passed
true.

So the 4 test of test case 01 worked and the same 4 test with test 02 also worked the same.

2 Likes

Thanks for such a detailed, thorough reply Eric!

I have an example of a Zebra puzzle, solved following Markus’ suggestion about state threading in a DCG. Alas, it doesn’t use call_dcg…

/*
    Norwegian lives in first house.
    The Englishman lives in a red house.
    The green house is located directly on the left side of the white house.
    Dane drinks tea.
    Light smoker lives next to the breeders of cats.
    A resident of the yellow house smokes a cigar.
    German smokes a water-pipe.
    A resident of the center house drinks milk.
    Light smoker has a neighbor who drinks the water.
    Smoke cigarettes without filter breeding birds.
    Swede breds dogs.
    The Norwegian lives next to the blue house.
    Breeder of horses lives next to the yellow house.
    Smoke menthol drinks beer.
    In the green house they drink coffee.
*/

solve :- solve(Sol, From), maplist(writeln, [From|Sol]).

solve(Sol, From) :-
  phrase(
    (from(1, norway)
    ,color(red) = from(england)
    ,color(Green, green), color(White, white), {Green is White-1}
    ,from(denmark) = drink(tea)
    ,smoke(Light, light), animal(Cat, cat), next_to(Light, Cat)
    ,color(Yellow, yellow), smoke(Yellow, cigar)
    ,from(germany) = smoke(waterpipe)
    ,drink(3, milk)
    ,drink(Water, water), next_to(Light, Water)
    ,animal(bird) = smoke(nofilter)
    ,from(sweden) = animal(dog)
    ,from(Norway, norway), color(Blue, blue), next_to(Norway, Blue)
    ,animal(Horse, horse), next_to(Horse, Yellow)
    ,drink(beer) = smoke(menthol)
    ,color(green) = drink(coffee)
    ,animal(Fish, fish), from(Fish, From)
    ), [[1,_,_,_,_,_],
        [2,_,_,_,_,_],
        [3,_,_,_,_,_],
        [4,_,_,_,_,_],
        [5,_,_,_,_,_]
    ], Sol).

state(S), [A,B,C,D,E] --> [A,B,C,D,E], {member(S, [A,B,C,D,E])}.
%state(S), L --> L, {member(S, L)}.

color(A, B)  --> state([A,B,_,_,_,_]).
from(A, B)   --> state([A,_,B,_,_,_]).
animal(A, B) --> state([A,_,_,B,_,_]).
drink(A, B)  --> state([A,_,_,_,B,_]).
smoke(A, B)  --> state([A,_,_,_,_,B]).

X = Y --> {
    X=..[Fx|Ax], Y=..[Fy|Ay],
    Xs=..[Fx,S|Ax], Ys=..[Fy,S|Ay]
}, call(Xs), call(Ys).

next_to(X, Y) --> {1 is abs(X-Y)}.
3 Likes

This is the most elegant solution I have seen for the zebra problem. Thanks for sharing!

I think it also matches what (I think) O’Keefe said, if your solution is elegant, it will generally be the fastest:


 ?- time(solve).
germany
[1,yellow,norway,cat,water,cigar]
[2,blue,denmark,horse,tea,light]
[3,red,england,bird,milk,nofilter]
[4,green,germany,fish,coffee,waterpipe]
[5,white,sweden,dog,beer,menthol]
% 26,456 inferences, 0.004 CPU in 0.004 seconds (100% CPU, 6419032 Lips)

Question, why did you replace:

state(S), L --> L, {member(S, L)}.

with

state(S), [A,B,C,D,E] --> [A,B,C,D,E], {member(S, [A,B,C,D,E])}.

any special reason besides being more explicit about the fixed number of elements?

I tried that and:

ERROR: Arguments are not sufficiently instantiated
ERROR: In:
ERROR:   [17] '$dcg':call_dcg(user:_2800,[[1|...],...|...],_2794)
ERROR:   [15] state([1,_2856|...],[[1|...],...|...],_2846) at /tmp/zebra_dcg.pl:46
ERROR:   [13] '<meta-call>'(user:(...,...)) <foreign>
ERROR:   [12] '$dcg':call_dcg(user:(...,...),[[1|...],...|...],_2956) at /usr/lib/swi-prolog/boot/dcg.pl:36\
8
ERROR:    [9] solve at /tmp/zebra_dcg.pl:19
ERROR:    [8] '$tabling':'$wfs_call'(user:solve,user:_3050) at /usr/lib/swi-prolog/boot/tabling.pl:675

PS: @jan – why the tabling message?

Thanks, that explains it.

I think it is using call_dcg under the covers because you used call//1 here:

AFAIK the (long due) DCG standard demands the push back list to be a proper list.

Still something to be fixed. The toplevel backtrace is supposed to hide the internal stuff, but this was modified to deal with well founded semantics undefined result. The backtrace code need to be adjusted to compensate for that :frowning: