% -*- mode: ciao; mode: outshine -*-
%% * Headers

:- module(_,_).
% :- module(_,_,[classic,assertions,rtchecks]).
% :- use_package(['bf/bfall']). % Nice for grammars, rest better off

:- use_package([fsyntax]). 
% :- use_package([functional]). 

% :- set_prolog_flag(multi_arity_warnings,off).
% :- set_prolog_flag(single_var_warnings,off).
:- use_module(library(format)).
:- use_module(library(lists),[append/3]).
:- use_module(library(aggregates)).
% -------------------------------------------------------------------
%% * Occurs-check vs. cyclic terms (not bfall)

cycle(X) :-
    X = f(X),
    Y = f(Y),
    X=Y.

% (not really necessary:) set_prolog_flag(check_cycles,on).
% write(X).

% -------------------------------------------------------------------
%% * Operators
% Operators allow using functors in prefix, postfix, or infix syntax. 
% For example, if we include this declaration in a file: 
%
%          v------- Infix, no associativity
:- op(500,xfx,is_father_of).
%     ^---- Precedence = 500
% 
% then these two facts:
% 
% is_father_of(john, peter).
% is_father_of(peter,jim).
%
% can be written as: 

john  is_father_of  peter. 
peter is_father_of  jim.

% Try: ?- is_father_of(X,Y).

% To activate the operator in the top level:
% ?- op(500,xfx,is_father_of).
% (this happens by default if module/2 is used)
% ?- X is_father_of Y.

% Another example for defining facts that are instructions of an
% assembly language:

%% :- op(1100,fx,[load,mult,bne]).
%% :- op( 500,fx,@).
%% :- op( 500,xfx,@).
%% 
%% label1 : load @r3,r1.
%%          load 5,r2.
%%          mult r1,r2.
%%          bne  0,label1.

% -------------------------------------------------------------------
%% * Prolog execution rules / search tree / debugger

grandparent(C,G) :-
    parent(C,P),
    parent(P,G).

parent(C,P) :- 
    father(C,P).
parent(C,P) :- 
    mother(C,P).

father(charles, philip).
father(ana, george).

mother(charles, ana).

% Try:
% ?- grandparent(charles,X).

% Run it in the debugger (C-c d, or see menu above)
% to follow the execution step by step!

% -------------------------------------------------------------------

permutation([], []).
permutation([H|T], [H1|T1]) :- 
    select_el(H1, [H|T], R),
    permutation(R, T1). 

select_el(H, [H|T], T).
select_el(H1, [H|T], [H|T1]) :-
    select_el(H1, T, T1).

% Try:
% ?- permutation([a,b,c], L). 
% ?- select_el(X, [a,b,c]). 

% -------------------------------------------------------------------

mylist([_|T]) :- mylist(T).
mylist([]).

mymember(X,[X|_]).
mymember(X,[_|T]) :- 
    mymember(X,T).

% Try:
% ?- mymember(c,[a,b,c]).
% ?- mymember(d,[a,b,c]).
% ?- mymember(X,[a,b,c]).

mymember2(X,Y) :-
    Y = [X|_].
mymember2(X,Y) :- 
    Y = [_|T],
    mymember2(X,T).

% -------------------------------------------------------------------
%% * Module system

% (see module* files)

% -------------------------------------------------------------------
%% * ISO-Prolog arithmetic

%% Examples of success:

% Try:
% ?- X is 3*3//2.
% ?- X = 3//2, X is 3+Z.

%% Examples of failure:

% Try:
% ?- X=3, Y=4, Y < X+1.
% ?- X=3, Y=4, X is Y+1.
% ?- X=3, Y=4, X =:= Y.

%% Examples of error: 

% Try: 
% ?- Y=4, Y < a+1.
% ?- X is Z+1.
% ?- X=3, X =:= f(a).



% -------------------------------------------------------------------
%% * Comparing Peano arithmetic and ISO-Prolog is/2 built-in 
%%   for computing factorial

% a) Using Peano arithmetic: 

peano_factorial(0,s(0)).
peano_factorial(s(N),F) :-
    peano_factorial(N,F1),
    peano_times(s(N),F1,F).

peano_times(0,_,0).
peano_times(s(X),Y,Z) :- peano_plus(W,Y,Z), peano_times(X,Y,W).

peano_plus(0,Y,Y) :- nat(Y).
peano_plus(s(X),Y,s(Z)) :- peano_plus(X,Y,Z).

nat(0).
nat(s(X)) :- nat(X). 

% Try: 
% ?- peano_factorial(s(s(s(s(s(0))))),F).
% ?- peano_factorial(s(s(s(s(s(0))))),_).
% ?- peano_factorial(s(s(s(s(s(s(0)))))),_).
% ?- peano_factorial(s(s(s(s(s(s(s(0))))))),_).
% Takes long...

% b) Using ISO-Prolog is/2 and >/2:

factorial(0,1). 
factorial(N,F) :-
    N > 0,
    N1 is N-1,
    factorial(N1,F1),
    F is F1*N.

% Try:
% ?- factorial(7,F).
% ?- factorial(1000,F).
% ?- factorial(100000,_).
% But: 
% ?- factorial(N,6).
% Error!

wrong_factorial(0,1). 
wrong_factorial(N,F) :-
    N > 0,
    N1 is N-1,
    F is F1*N,
    wrong_factorial(N1,F1).

% Try: 
% ?- wrong_factorial(3,F).
% Error!

% Version with accumulating parameter: 

factorial_acc(0,1).
factorial_acc(N,F) :- 
    factorial_(N,1,F).

factorial_(1,F,F). 
factorial_(N,A,F) :-
    N > 1,
    N1 is N-1,
    NA is A*N,
    factorial_(N1,NA,F).

% Try: 
% ?- factorial_acc(7,F).
% ?- factorial_acc(1000,F).
% ?- factorial_acc(100000,_).
% ?- factorial_acc(300000,_).


% -------------------------------------------------------------------
%% * Recovering some reversibility for ISO-Prolog is/2 
%%   built-in 

plus(X,Y,Z) :- Z is X + Y.

% Try:
% ?- plus(4,5,Z).
% Works, but cannot 'run backwards':  
% ?- plus(X,5,9).

% To recover some reversibility: 

plus2(X,Y,Z) :- number(X),number(Y), Z is X + Y.
plus2(X,Y,Z) :- number(X),number(Z), Y is Z - X.
plus2(X,Y,Z) :- number(Y),number(Z), X is Z - Y.

% Try:
% ?- plus2(4,5,Z).
% ?- plus2(X,5,9).
% But, it cannot do: 
% ?- plus2(X,Y,9).

% In fact, this should raise an error, rather than simply 
% failing (we will see solutions for this later).

% A much better solution: the addition of constraints to 
% the language: Constraint Logic Programming (CLP) 
% --see later!

% -------------------------------------------------------------------
% :- module(_,_).
%% * Structure inspection: Examples for functor/3 and arg/2 

% functor/3
% Try:
% ?- functor(t(b,a),F,A).
% ?- functor(Term,f,3).
% ?- functor(Vector,v,100).
% (< 256, see array lib for larger)

% arg/2
% Try: 
% ?- _T=date(9,February,1947), arg(3,_T,X).

% Same, using unification: 
% ?- _T=date(9,February,1947), _T=date(_,_,X).

% (_ in _T instructs top level not to print value of _T)

% ?- functor(Array,array,5), arg(1,Array,black), arg(5,Array,white).

% What does the following return? Explain why!
% ?- arg(2, [a,b,c,d], X).
% -------------------------------------------------------------------

% -------------------------------------------------------------------
%% * Example of structure inspection: Arrays

% An 'array' addition using functor/3 arg/2
% Explanations assume mode: add_arrays(+,+,?)
% i.e., we provide the first two arrays and obtain the sum.
% Step through in the debugger to see its operation!

add_arrays(A,B,C) :-
    functor(A,array,N), % Gets length N from array A
    functor(B,array,N), % Checks that array B is of same length
    functor(C,array,N), % Creates an array C to hold the result
    add_elements(N,A,B,C).

add_elements(0,_A,_B,_C).
add_elements(I,A,B,C) :-
    I>0, 
    arg(I,A,AI), 
    arg(I,B,BI), 
    arg(I,C,CI),
    CI is AI + BI, 
    I1 is I - 1,
    add_elements(I1,A,B,C).

% ?- add_arrays(array(1,2,3),array(4,5,6),R).
% ?- add_arrays(array(1,2,3),array(4,5,6),array(5,7,9)).
% ?- add_arrays(array(1,2,3),array(4,5),R).


% Alternative, using lists instead of structures: 

add_lists([],[],[]).
add_lists([X|Xs],[Y|Ys],[Z|Zs]) :-
    Z is X + Y,
    add_lists(Xs,Ys,Zs).

% Try: 
% ?- add_lists([1,2,3],[4,5,6],R).
% ?- add_lists([1,2,3],[4,5,6],[5,7,9]).
% ?- add_lists([1,2,3],[4,5],R).

% ------------------------------
% :- module(_,_).

% Example of Structure Inspection: Arrays

% Alternative 'array' addition using functor/3 and arg/2
% but adding some syntactic sugar for arg/3 in 
% add_els/4

%------- Syntactic sugar definitions ------------------------
:- use_package(fsyntax).  % Use functional notation.
:- op(250,xfx,@).         % Define @ as infix operator
T@N := A :- arg(N,T,A).   % Define @ to call arg/3
:- fun_eval @ / 2.        % Evaluate all occurrences of @/2
% Define array/2 to hide the call to functor:
array(A,N) :- functor(A,array,N).
:- fun_eval arith(true).  % Eval arithmetic expressions (I-1)
%------------------------------------------------------------

% Now we can define the array addition as: 

add_arr(A,B,C) :-    
    array(A,N), 
    array(B,N), 
    array(C,N),
    add_els(N,A,B,C).

add_els(0,_,_,_).
add_els(I,A,B,C) :-
    I>0, 
    C@I is A@I + B@I, 
    add_els(I-1,A,B,C).

% ?- add_arr(array(1,2,3),array(4,5,6),R).
% ?- add_arr(array(1,2,3),array(4,5,6),array(5,7,9)).
% ?- add_arr(array(1,2,3),array(4,5),R).

% ------------------------------

%% :- set_prolog_flag(read_postfix_blocks, on).
%% :- op(50,yf,([])).
%% :- fun_eval '@'/2.
%% 
%% '\006\postfix_block'(f,[4]) 
%% array(A,N) :- functor(A,array,N).
%% 
%% X = f[4]
%% '\006\postfix_block'(f,[4]) 

% ----Reset arith --------------
:- fun_eval arith(false).


% ------------------------------
% :- module(_,_).

%% * Example of structure inspection: Subterm

% subterm(Sub,Term): Sub is a subterm of Term
subterm(Term,Term).   % a) A term is always a subterm of itself
subterm(Sub,Term) :-   % b) The arguments are also subterms:
    functor(Term,_F,N),%    N is number of arguments of Term
    n_to_one(N, J),    %    J is a natural between N and 1
    arg(J,Term,Arg),   %    Arg is the J-th argument of Term
    subterm(Sub,Arg). %    Sub are the subterms of Arg

n_to_one(N, N) :- N > 0.
n_to_one(N, X) :- N > 1, N1 is N-1, n_to_one(N1, X).

% Try (asking also for other solutions): 
% ?- subterm( f(a) , g(b,f(a)) ).
% ?- subterm( f(b) , g(b,f(a)) ).
% ?- subterm( g(b,f(a)) , g(b,f(a)) ).
% ?- subterm( X , g(b,f(a)) ).
% ?- subterm( f(X) , g(b,f(a)) ).
% ?- subterm( X , g(X,f(a)) ).
% ?- subterm( f(X) , g(b,f(X)) ).

% ------------------------------

%%% Not used since it relies on non-ISO behavior of arg/3.
%% subterm2(Term,Term).   % a) A term is always a subterm of itself
%% subterm2(Sub,Term) :-  % b) The arguments are also subterms:
%%     functor(Term,_F,N),%    N is number of arguments of Term
%%     subterm_args(N,Sub,Term). % Iterate over the N arguments
%% 
%% subterm_args(N,Sub,Term) :- % a) Check current argument
%%     arg(N,Term,Arg), % Also checks N>0 (arg/3 fails if N=<0)
%%     subterm(Sub,Arg).
%% subterm_args(N,Sub,Term) :- % b) Check next argument
%%     N>1, 
%%     N1 is N-1, 
%%     subterm_args(N1,Sub,Term).
%% 
%% %% subterm( f(a) , g(b,f(a)) ).
%% %% subterm( f(b) , g(b,f(a)) ).
%% %% subterm( g(b,f(a)) , g(b,f(a)) ).
%% %% subterm( X , g(b,f(a)) ).
%% %% subterm( f(X) , g(b,f(a)) ).
%% %% subterm( X , g(X,f(a)) ).
%% %% subterm( f(X) , g(b,f(X)) ).

% -------------------------------------------------------------------
% :- module(_,_).

%% * 'Higher-order' structure inspection - simple examples

% Try: 
% ?- date(9,february,1947) =.. L.
% ?- T =.. [date,9,february,1947].
% ?- _F = '+', X =.. [_F,a,b].

% (_ in _F instructs top level not to print value of _F)

% -------------------------------------------------------------------
% :- module(_,_).

%% * 'Higher-order' structure inspection example - extending deriv
%     Extending derivative: 

deriv(sin(X), X, cos(X)). 
deriv(cos(X), X, -sin(X)). 
% Chain rule: 
deriv(FG_X,   X, DF_G * DG_X) :-
    FG_X =.. [_, G_X],
    deriv(FG_X, G_X, DF_G),
    deriv(G_X, X, DG_X).

% Try:
% ?- deriv(sin(cos(x)),x,D).

% Adding original derivative code (from pure LP part, but using ISO arithmetic): 
deriv(X,     X, 1              ).
deriv(C,    _X, 0              ) :- pconstant(C).
deriv(U+V,   X, DU+DV          ) :- deriv(U,X,DU), deriv(V,X,DV). 
deriv(U-V,   X, DU-DV          ) :- deriv(U,X,DU), deriv(V,X,DV).
deriv(U*V,   X, DU*V+U*DV      ) :- deriv(U,X,DU), deriv(V,X,DV).
deriv(U/V,   X, (DU*V-U*DV)/V^2) :- deriv(U,X,DU), deriv(V,X,DV).
deriv(U^N,   X, N*U^N1*DU      ) :- deriv(U,X,DU), number(N), N1 is N-1.
deriv(log(U),X, DU/U           ) :- deriv(U,X,DU).

pconstant(X) :- number(X).
pconstant(a).
pconstant(b).
pconstant(c).

% Try:
% ?- deriv(sin(cos(x^2+3)),x,D).

% But not fully reversible:
% use clpq / clpr / clpfd!

%-------------------------------------------------------------------
% :- module(_,_).
%% * Conversion between strings and atoms
/*

Try:
?- name(hello,S).
?- name(A,[104,101,108,108,111]).
?- name(A,"hello").
?- set_prolog_flag(write_strings,on).
?- name(hello,S).

Ambiguity when converting strings which represent numbers:

Try: 
?- X='1', atom(X), name(X,S), name(Y,S), number(Y).

(Succeeds! Note that we start with the atom '1' and we 
 end up with the number 1.)

Thus, the ISO standard provides also the non-ambiguous:

Try:
?- atom_codes('1', L).
?- atom_codes(1, L).
?- number_codes('1', L).
?- number_codes(1, L).
?- number_codes(X, "1").
?- atom_codes(X, "1").

*/

%% * Misc/misplaced?

%---------------------------------------------------------------------

sumlist([],0).
sumlist([X|Xs],S) :-
    sumlist(Xs,SXs),
    S is X+SXs.

% -----

gsumlist(L,S) :- 
    gsumlist_(L, 0, S).

gsumlist_([], S, S).
gsumlist_([X|Xs], A, S) :-
    NS is A+X,
    gsumlist_(Xs, NS, S).
    

%---------------------------------------------------------------------

% :- use_package(clpq).

%% len([],0).
%% len([_|T],N) :-
%%     len(T,TN),
%%     N is TN+1.
%% 
%% % -----------
%% 
%% glen(L,Len) :-
%%     glen_(L,0,Len).
%% 
%% glen_([],Len,Len).
%% glen_([_|Xs],S,Len) :-
%%     S1 .=. 1+S,
%%     glen_(Xs,S1,Len).

%---------------------------------------------------------------------
% :- module(_,_).

%% * Meta-logical predicates example - choosing implementations
%    Choosing between two implementations based on calling mode (i.e.,
%    implementing reversibility 'by hand').

% A) Simple list length: 

len([],0).
len([_|T],N) :- len(T,TN), N is TN+1.

% B) Choosing between two implementations based on calling mode: 

% With better version also of create_list/2. 

mylength(Xs,N) :- 
    var(Xs),
    integer(N),
    create_list(N,Xs).
mylength(Xs,N) :- 
    nonvar(Xs),
    compute_length(Xs,N).

create_list(0,[]).
create_list(N,[_|Xs]) :- 
    N > 0,
    N1 is N - 1,
    create_list(N1,Xs).

compute_length([],0).
compute_length([_|T],N) :-
    compute_length(T,TN),
    N is TN+1.

% Try:
% ?- len([a,b,c],N).
% ?- len(L,3).
% ?- mylength([a,b,c],N).
% ?- mylength(L,3).

% The mylength/3 version is not strictly needed, since the normal
% definition of length is actually reversible, but note that len/2
% when called with L is a variable and N a number is less efficient
% than create_list/2 (which is tail-recursive).


%---------------------------------------------------------------------
% :- module(_,_).
%% * Meta-logical predicates example - choosing implementations
%    Choosing between two implementations based on calling mode (i.e.,
%    implementing reversibility 'by hand').

%% % A) Simple list length: 
%% 
%% len([],0).
%% len([_|T],N) :- len(T,TN), N is TN+1.
%% 
%% % B) Choosing between two implementations based on calling mode: 
%% 
%% % With better version also of compute_length/2 (using an 
%% % accumulating parameter). N both create_list/2 and 
%% % compute_length/2 are tail recursive.
%% 
%% mylength(Xs,N) :- 
%%     var(Xs),
%%     integer(N),
%%     create_list(N,Xs).
%% mylength(Xs,N) :- 
%%     nonvar(Xs),
%%     compute_length(Xs,N).
%% 
%% create_list(0,[]).
%% create_list(N,[_|Xs]) :- 
%%     N > 0,
%%     N1 is N - 1,
%%     create_list(N1,Xs).
%% 
%% compute_length(L,N) :-
%%     compute_length_(L,0,N).
%% 
%% compute_length_([],N,N).
%% compute_length_([_|T],A,N) :-
%%     NA is A+1,
%%     compute_length_(T,NA,N).
%% 
%% % Try:
%% % ?- len([a,b,c],N).
%% % ?- len(L,3).
%% % ?- mylength([a,b,c],N).
%% % ?- mylength(L,3).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Example application of comparing non-ground terms - subterm
%    (use of ==/2, \==/2, @>/2, ...)

% subterm_ng(Sub,Term): Sub is a strict subterm of Term
% (does not instantiate variables)

subterm_ng(Sub,Term) :-  % a) A term is a subterm of another
    Sub == Term.         %    if they are identical.
subterm_ng(Sub,Term) :-  % b) The arguments are also subterms:
    functor(Term,_F,N),  %    N is number of arguments of Term
    n_to_one(N, J),      %    J is a natural between N and 1
    arg(J,Term,Arg),     %    Arg is the J-th argument of Term
    subterm_ng(Sub,Arg). %    Sub are the subterms of Arg

%% n_to_one(N, N) :- N > 0.
%% n_to_one(N, X) :- N > 1, N1 is N-1, n_to_one(N1, X).

% Compare to subterm version with =/2 instead of ==/2 (below)

% Try (asking also for other solutions):
% ?- subterm_ng( f(a), g(b,f(a)) ).
% ?- subterm(    f(a), g(b,f(a)) ).
% ?- subterm_ng( f(b), g(b,f(a)) ).
% ?- subterm(    f(b), g(b,f(a)) ).
% ?- subterm_ng( g(b,f(a)), g(b,f(a)) ).
% ?- subterm(    g(b,f(a)), g(b,f(a)) ).
% ?- subterm_ng( X, g(b,f(a)) ).
% ?- subterm(    X, g(b,f(a)) ).
% ?- subterm_ng( f(X), g(b,f(a)) ).
% ?- subterm(    f(X), g(b,f(a)) ).
% ?- subterm_ng( f(a), g(b,f(X)) ).
% ?- subterm(    f(a), g(b,f(X)) ).
% ?- subterm_ng( f(X), g(b,f(X)) ).
% ?- subterm(    f(X), g(b,f(X)) ).
% ?- subterm_ng( X, g(X,f(a)) ).
% ?- subterm(    X, g(X,f(a)) ).

%% % Version using =/2:
%% subterm(Sub,Term) :-   % a) A term is always a subterm of itself
%%     Sub = Term.        % 
%% subterm(Sub,Term) :-   % b) The arguments are also subterms:
%%     functor(Term,_F,N),%    N is number of arguments of Term
%%     n_to_one(N, J),    %    J is a natural between N and 1
%%     arg(J,Term,Arg),   %    Arg is the J-th argument of Term
%%     subterm(Sub,Arg).  %    Sub are the subterms of Arg
%% 


% -------------------------------------------------------------------
%% subterm_ng_old(Sub,Term) :-
%%     Sub == Term.
%% subterm_ng_old(Sub,Term) :- 
%%     nonvar(Term),
%%     functor(Term,_F,N), 
%%     subterm_ng_old_(N,Sub,Term).
%% 
%% subterm_ng_old_(N,Sub,Term) :-     
%%     arg(N,Term,Arg),   % also checks N > 0 (arg/1 fails otherwise!)
%%     subterm_ng_old(Sub,Arg).
%% subterm_ng_old_(N,Sub,Term) :- 
%%     N>1, 
%%     N1 is N-1, 
%%     subterm_ng_old_(N1,Sub,Term).
% -------------------------------------------------------------------

% -------------------------------------------------------------------
% :- module(_,_).

%% * Example application of comparing non-ground terms
% (use of ==/2, \==/2, @>/2, ...)
% Inserting and item into an ordered list.

% Version with ==/2, @>/2, @</2

insert_ee([], Item, [Item]).
insert_ee([H|T], Item, [H|T]) :- H == Item.
insert_ee([H|T], Item, [Item, H|T]) :- H @> Item.
insert_ee([H|T], Item, [H|NewT]) :- H @< Item, insert_ee(T, Item, NewT).

% Try:
% ?- insert_ee([], a, L).
% ?- insert_ee([a,b,e], c, L).
% ?- insert_ee([a,b,e], X, L).

% Compare with:

insert_unif([], Item, [Item]).
insert_unif([H|T], Item, [H|T]) :- H = Item.
insert_unif([H|T], Item, [Item, H|T]) :- H @> Item.
insert_unif([H|T], Item, [H|NewT]) :- H @< Item, insert_unif(T, Item, NewT).

% Try: 
% ?- insert_unif([], a, L).
% ?- insert_unif([a,b,e], c, L).
% ?- insert_unif([a,b,e], X, L).


% --------------------------------------
% :- module(_,_).

%% * Examples of ISO I/O

% Try:
% ?- tell(foo), write( f(g(a,[1,2,3])) ), told.
% We use a library predicate to see exact contents of foo: 
% ?- set_prolog_flag(write_strings,on).
% ?- show_file(foo).

% We define write_list_to_file/2: 

write_list_to_file(L,F) :- 
    telling(OldOutput),             % Grab current output stream.
    tell(F), write_list(L), told,   % Write into F, close.
    tell(OldOutput).                % Reset previous output stream.

write_list([]).
write_list([X|Xs]) :-
    write(X),
    % write_canonical(X),
    write('.'),
    nl,
    write_list(Xs).

% Try:
% ?- write_list_to_file([ f(a), m, g(k)],foo).
% ?- show_file(foo).
% ?- see(foo), read(X), seen.
% ?- see(foo).
% ?- read(X).
% ?- read(X).
% ?- read(X).
% ?- seen.

% We use other library predicates to print the exact contents of files:
:- use_module(library(stream_utils)).
show_file(F) :- 
    file_to_string(F,L),
    format("~s",[L]).

% --------------------------------------
% :- module(_,_).
%% * Example of cut execution

s(1).   
s(2).

l(a).    
l(b).    

r(8).  
r(9).

m(e).

p(X,_Y) :-
    l(X),
    write('\nReached end of clause 1 of p.').
p(X,_Y) :-
    r(X),
    !,    % Cut
    write('\nExecuted cut (no more alternatives of r/1 or p/1)'),
    write('\nAt end of clause 2 of p.').
p(X,_Y) :-
    write('\nReached clause 3 of p.'),
    m(X).
    
%  If execution reaches the cut (!):
%  - The second alternative of \ciaoinline{r/1} is not considered.
%  - The third clause of \ciaoinline{p/2} is not considered.

% Try (asking for more solutions):
% ?- s(S),p(X,Y).

% --------------------------------------
% :- module(_,_).

%% * Types of cuts - White and Green Cuts
%    ------------------------------------

% --------------------------------------
% White cuts - affect neither completeness nor correctness
% Use freely!

% Example: 
white_max(X,Y,X) :-
    X > Y,
    !.
white_max(X,Y,Y) :-
    X =< Y.

% Try:
% ?- white_max(5,2,M).
% ?- white_max(2,5,M).
% ?- white_max(5,2,2).

% --------------------------------------
% Green cuts - affect completeness but not correctness correctness
% Can be used if we do not need all the solutions
% Necessary in some situations (but be careful!)

address(X,Add) :-
    home_address(X,Add), 
    !.
address(X,Add) :-
    business_address(X,Add).

home_address(john,pfluggerville).

business_address(john,austin).
business_address(mary,boston).

% Try (look for all solutions):
% ?- address(a,Add).
% ?- address(b,Add).

member_normal(X,[X|_]).
member_normal(X,[_|T]) :-
    member_normal(X,T).

member_check(X,[X|_]) :- !.
member_check(X,[_|T]) :-
    member_check(X,T).

% Try (look for all solutions): 
% ?- member_normal(X,[1,2,3,4]).
% ?- member_check(X,[1,2,3,4]).
% ?- member_normal(1,[1,2,1,4]), write(hello), nl, fail.
% ?- member_check(1,[1,2,1,4]), write(hello), nl, fail.

% --------------------------------------
% :- module(_,_).

%% * Types of cuts - Red Cuts
%  --------------------------

% Used to discard solutions that are not correct 
% But can easily affect correctness - avoid when possible

% Examples: 

red_max(X,Y,X) :-
    X > Y,
    !. % Red cut!
red_max(_X,Y,Y). % :-  
    % X =< Y. % Missing!

% Try: 
% ?- red_max(5,2,M).
% ?- red_max(2,5,M).
% ?- red_max(5,2,2).
% Note that this last one produces a wrong answer!

% Useful tips regarding red cuts:
% -------------------------------

% Delaying output bindings to after the cut: 
red_max_delay_output(X,Y,M) :- 
    X > Y, 
    !,
    M = X.
red_max_delay_output(_X,Y,Y).
    % X =< Y.

% % Try:
% ?- red_max_delay_output(5,2,M).
% ?- red_max_delay_output(2,5,M).
% ?- red_max_delay_output(5,2,2).

% Syntactic sugar: 
if_then_else_max(X,Y,M) :- ( X>Y ->  M=X ;   M=Y).

% % Try:
% ?- if_then_else_max(5,2,M).
% ?- if_then_else_max(2,5,M).
% ?- if_then_else_max(5,2,2).

% --------------------------------------
% :- module(_,_).

%% * Types of cuts - Red Cuts
%    ------------------------

% Another example: 

days_in_year(Y,366) :-
    leap_year(Y),
    !.
days_in_year(_Y,365).

leap_year(Y) :-
    number(Y),
    0 is Y mod 4.

%% Try:
% ?- days_in_year(4,D).
% ?- days_in_year(3,D).
% ?- days_in_year(3,366).
% ?- days_in_year(4,366).
% ?- days_in_year(4,365).
% ?- days_in_year(Y,366).
% Note that the last two produce a wrong answer!

% The best solution: making the cut white by defining the other condition
days_in_year_good(Y,D) :-
    leap_year(Y),
    !,
    D = 366.
days_in_year_good(Y,D) :- 
    standard_year(Y),
    D = 365.

standard_year(Y) :-
    number(Y),
    R is Y mod 4,
    R \= 0.

% Try:
% ?- days_in_year_good(4,D).
% ?- days_in_year_good(4,366).
% ?- days_in_year_good(4,365).
% ?- days_in_year_good(Y,366).
% ?- days_in_year_good(a,D).


% Otherwise, if we still want to save the call to standard_year/1 with
% a cut, we have several solutions:

% Delaying output: 
days_in_year_delay_output(Y,D) :-
    leap_year(Y),
    !,
    D = 366.
days_in_year_delay_output(_Y,365).

% Try:
% ?- days_in_year_delay_output(4,D).
% ?- days_in_year_delay_output(4,365).
% ?- days_in_year_delay_output(4,366).
% ?- days_in_year_delay_output(Y,366).
% Note that the last one still produces a wrong answer!
% This is because we are probably thinking of a 'mode':
% that we provide the year and ask for the number of days. 

% Improvement: we check the 'mode': 
days_in_year_moded(Y,_D) :-
    var(Y),
    !,
    write('{ ERROR: the year must be bound. }\n'),
    abort.
days_in_year_moded(Y,D) :-
    leap_year(Y),
    !,
    D = 366.
days_in_year_moded(_Y,365).

% Try:
% ?- days_in_year_moded(4,D).
% ?- days_in_year_moded(3,D).
% ?- days_in_year_moded(4,365).
% ?- days_in_year_moded(4,366).
% ?- days_in_year_moded(Y,366).
% ?- days_in_year_moded(a,D).

% Even better: ensure mode and type of input and output with an assertion
% Load assertions package and run-time checking of assertions
:- use_package([assertions,modes,rtchecks]).

:- pred days_in_year_moded_assrt(+int,-int). 
% :- pred days_in_year_moded_assrt(Y,D) : (int(Y),var(D)).

days_in_year_moded_assrt(Y,D) :-
    leap_year(Y),
    !,
    D=366.
days_in_year_moded_assrt(_Y,365).

% Try:
% ?- days_in_year_moded_assrt(4,D).
% ?- days_in_year_moded_assrt(4,366).
% ?- days_in_year_moded_assrt(4,365).
% ?- days_in_year_moded_assrt(Y,366).
% ?- days_in_year_moded_assrt(a,D).



% --------------------------------------
%% * More examples of cut. Case statement.

%%  case x
%%     x=a : y=1 ...
%%     x=b : y=2 ...
%%     x=c : y=3 ...

%% case(a,1).
%% case(b,2).
%% case(c,3).

% "Case"
%% case(a,Y) :- !, Y=1.
%% case(b,Y) :- !, Y=2.
%% case(c,Y) :- !, Y=3.

case(f(a),Y) :- !, Y=1.
case(g(b),Y) :- !, Y=2.
case(h(c),Y) :- !, Y=3.

%% ?- case(h(b),Y).



% --------------------------------------
%% * More examples of cut. Splitting a list.
split([],[],[]).
split([X|L],[X|L1],L2) :-
    X >= 0, !,
    split(L,L1,L2).
split([X|L],L1,[X|L2]) :-
    % X < 0,
    split(L,L1,L2).

% First, test it without cut
% Then,  test again with cut
% queries: split([1,-1,3],L1,L2).
%          split([1,-1,3],L1,L2),!.
% --------------------------------------

k_1sol(j,k). 
k_1sol(X,Y) :- k(X), !, z(Y).
k_1sol(l,m). 

k(a).
k(b).

z(1).
z(2).


% -------------------------------------------------------------------
% :- module(_,_).

%% * Meta-calls: call/1
%   -------------------

% call/1 example: simple call

p1(X) :- call(X). 

q(a,1).
q(b,2).

% Try (ask also for more solutions):
% ?- P = q(X,Y), p1(P).
% ?- P = member(Y,[1,2,3]), p1(P).


% call/1 example: constructing apply

apply(P,Args) :-
    G =.. [P|Args],
    call(G).

% Try: 
% ?- P = q, apply(P,[a,Y]).
% ?- P = q, apply(P,[X,Y]).

maplist(_P,[]).
maplist(P,[Tuple|RTuples]) :-
    apply(P,Tuple),
    maplist(P,RTuples).

% Try: 
%   ?- maplist(q,[[a,X],[b,Y]]).
/*  ?- maplist(append, [ [ [a],[c,d], X ],
                       [ X,  [e,f], Y ],
                       [ X,  Y,     Z ]  ]).
*/

%% * Meta-calls: call/n
%    ------------------
% There is also a family of predicates call/1, call/2, ..., call/n 

% Try:
% ?- P = q, call(P,X,Y).
% ?- P = append, call(P,[1,2],[3.4],Y).
% ?- P = append, call(P, X,Y,[1,2,3,4]).

% Ciao implements additional functionality (hiord package): 
% - Predicate abstractions 
% - Optional special syntax for call/n

% Try (ask for more solutions):
% ?- use_package(hiord).
% (Loads hiord package in top level)
% ?- P = q, P(X,Y).
% ?- P = append, P([1,2],[3.4],Y).
% ?- P = append, P(X,Y,[1,2,3,4]).
% Predicate abstraction (read _ as lambda): 
% ?- P = { _(X,Y) :- Y is X+1 }, P(3,R).

:- use_package(hiord).

maplistho(_P,[]).
maplistho(P,[[X,Y,Z]|RTuples]) :-
    P(X,Y,Z),
    maplistho(P,RTuples).

% Try:
/* ?- maplistho(append,[ [ [a],[c,d], X ],
                       [ X,  [e,f], Y ],
                       [ X,  Y,     Z ]  ]).
*/


% -------------------------------------------------------------------
% :- module(_,_).

%% * Meta-calls: aggregation predicates 
%    ----------------------------------
% Examples of setof/3, bagof/3, findall/3


% Try (asking for more solutions):
% ?- findall(X, member(X,[d,a,b,c,b,d]), L).
% ?- setof(X, member(X,[d,a,b,c,b,d]), L).
% ?- bagof(X, member(X,[d,a,b,c,b,d]), L).
% ?- findall(X, (member(X,[d,a,b,c,b,d]), X @< c), L).

likes(bill,  cider).
likes(dick,  beer).
likes(tom,   beer).
likes(tom,   beer).
likes(tom,   cider).
likes(harry, beer).
likes(jan,   cider).

% Try (asking for more solutions):
% ?- findall(X, likes(X,Y), S).
% ?- findall(X, likes(X,water),S).
%    (empty list)
%
% ?- setof(X, likes(X,Y), S).
% ?- setof(X, Y^likes(X,Y), S).
% ?- setof(X, likes(X,water), S).
% 
% ?- bagof(X, likes(X,Y), S).
% ?- bagof(X, Y^likes(X,Y), S).
% ?- bagof(X, likes(X,water),S).
%    (fails)
% 
% Using a term in the first argument: 
% ?- findall( Y-L ,  setof(X,likes(X,Y),L),  Pairs).
% ?- findall(beer_lover(X), likes(X,beer), S).

% Another setof/3 example: 

subset([],[]).
subset([X|Xs],[X|Ys]) :-
    subset(Xs,Ys).
subset([_|Xs],Ys) :-
    subset(Xs,Ys).

powerset(Set,Pset) :-
    setof(X,subset(Set,X),Pset).

% Try (asking for more solutions):
% ?- subset([1,2,3],S).
% ?- powerset([1,2,3],Pset).



% -------------------------------------------------------------------
% :- module(_,_).

%% * Meta-calls and cut: Negation as failure
%    ---------------------------------------

not( Goal) :- call(Goal), !, fail.
not(_Goal).
% This is available from the library as \+/1

% Try:
% ?- not( member(c, [a, k, l]) ).
% ?- \+ member(c, [a, k, l]).

% Another example: 
% ----------------
    
unmarried_student(X) :- 
    \+ married(X),
    student(X).

student(joe).
married(john).

% Note that:
% Joe is an unmarried student
% John is NOT an unmarried student!

% Try:
% ?- unmarried_student(joe).
% ?- unmarried_student(john).
% ?- unmarried_student(X).
% This last one is wrong, an unmarried student does exist!

% Observation: not/1 is correct if the argument is ground (is a term
% that does not contain variables). 
% ground/1 is available:

% Try:
% ?- ground(unmarried_student(joe)).
% ?- ground(unmarried_student(X)).

% Better (safer) implementation of negation: 
not_(G) :-
    ground(G), !,
    \+ G. 
not_(G) :-
    write('ERROR: Non-ground goal in negation: '), write(G), nl,
    abort.

better_unmarried_student(X) :- 
    not_(married(X)), 
    student(X).

% Try:
% ?- better_unmarried_student(joe).
% ?- better_unmarried_student(john).
% ?- better_unmarried_student(X).

% Alternative implementation using an assertion.
% We load assertions package and run-time checking of assertions:
:- use_package([assertions,modes,rtchecks]).

:- pred not__(G) : ground(G).
not__(G) :- \+ G.

assrt_unmarried_student(X) :- 
    not__(married(X)), 
    student(X).

% Try:
% ?- assrt_unmarried_student(joe).
% ?- assrt_unmarried_student(X).

% Another example: overlap/2 and disjoint/2
overlap(S1,S2) :-  % S1 and S2 overlap if they share an element
    member(X,S1), member(X,S2).

disjoint(S1,S2) :- \+ overlap(S1,S2).

% Try:
% ?- disjoint([1,2,3,4],[a,b,c]).
% ?- disjoint([1,2,3,4],[2,4,c]).

% Another example of meta-call + cut:
% once(G): only one solution of G
once(X) :- call(X), !.

% Try (asking for more alternatives):
% ?- member(X,[1,2,3]).
% ?- once(member(X,[1,2,3])).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Meta-calls and cut: cut-fail 
%    ----------------------------

% Fail can be easily programmed in pure logic:
myfail :- a=b.
% Is available simply as 'fail'. 

% We tell the compiler we are redefining the ground/1 built-in: 
:- redefining(ground/1).

% Definition of ground/1 using cut and fail:
ground(Term) :- 
    var(Term), 
    !, 
    fail.
ground(Term) :- 
    nonvar(Term), 
    functor(Term,_F,N),
    ground_(N,Term).

ground_(0,_T).       %% All subterms traversed
ground_(N,T) :- 
    N>0, 
    arg(N,T,Arg), 
    ground(Arg), 
    N1 is N-1, 
    ground_(N1,T).

% Try (also in the debugger):
% ?- ground(a).
% ?- ground(X).
% ?- ground(f(a,f(X,d),b)).

% Comment out the first clause of ground/1 and guess what happens.
%
% Try (also in the debugger):
% ?- ground(f(a,f(c,d),Z)).


% ground_(0,T).       %% All subterms traversed
% ground_(N,T) :- 
%     N>0, 
%     ground(~arg(N,T)), 
%     ground_(N-1,T).

% ----------------------------------------------------
% :- module(_,_).

%% * Dynamic predicates
%    ------------------

% A) New, dynamically created predicates are directly modifiable: 

% Try (asking for more solutions):
% ?- p(X). 
% ?- assert(p(a)).
% ?- p(X).
% ?- assert(p(b)).
% ?- p(X).
% ?- retract(p(a)).
% ?- retract(p(b)).
% ?- p(X).
% ?- abolish(p/1).
% ?- p(X).

% B) If the predicate is already defined in the program: 
related(3,4).
% it must be declared dynamic for it to be modifiable: 
:-  dynamic related/2.

% Some operations on related/2: 
relate_numbers(X,Y) :- assert(related(X,Y)).
unrelate_numbers(X,Y) :- retract(related(X,Y)).

% Try:
% ?- related(3, 4).
% ?- related(1, 2).
% ?- relate_numbers(1, 2).
% ?- related(1, 2).
% ?- related(X, Y).
% ?- unrelate_numbers(1, 2).
% ?- related(1, 2).
% ?- abolish(related/2).
% ?- related(1, 2).

% B) A definition of append that we can add or delete dynamically: 
:- dynamic app/3.

% Create the definition of append
define_app :-
    assert(   app([], X, X) ),
    assert( ( app([X|Y], Z, [X|W]) :- app(Y,Z,W) ) ).

% Erase the definition of append
erase_app :- 
    abolish(app/3).

% Try:
% ?- app([1,2],[3,4],Y).
% ?- erase_app.
% ?- app([1,2],[3,4],Y).
% ?- define_app.
% ?- app([1,2],[3,4],Y).
% ?- app(X,Y,[1,2,3,4]).
% ?- erase_app.
% ?- app(X,Y,[1,2,3,4]).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Dynamic program modification example: using lemmas
%    --------------------------------------------------

% The Fibonacci sequence: 0, 1, and then:
% element n is element n-1 + element n-2
% i.e., 0 1 1 2 3 5 8 13 21 ...

% First version, applying directly the definition: 

fib(0, 0). 
fib(1, 1). 
fib(N, F) :-  
    N > 1,        
    N1 is N-1, fib(N1, F1), 
    N2 is N-2, fib(N2, F2),  
    F is F1 + F2. 

% Same, in functional notation: 
% :- use_package(fsyntax).
:- fun_eval arith(true).

ffib(0) := 0.
ffib(1) := 1.
ffib(N) := ~ffib(N-1)+ ~ffib(N-2) :- N>1.

% A version that records 'lemmas' (things already proved)

% We define a table (with a dynamic predicate) that holds the
% first two elements, i.e., for N=0 and N=1: 
:- dynamic lemma_fib/2.
lemma_fib(0, 0). 
lemma_fib(1, 1). 

% To compute the rest: 
lfib(N, F) :-
    % First check if we the Nth element in the table, 
    % and we take it from there. 
    lemma_fib(N, F),
    !. 
lfib(N, F) :- 
    % Else, we compute the Nth number...
    N > 1,   
    N1 is N - 1,  
    N2 is N - 2, 
    lfib(N1, F1), 
    lfib(N2, F2), 
    F is F1 + F2,     
    % ...and once we have it we record it: 
    assert(lemma_fib(N, F)). 

% Try (comare the computation time!): 
% ?- fib(30,Y).
% ?- fib(31,Y).
% ?- fib(32,Y).
% ?- fib(35,Y).
%  ...
% ?- lfib(30,Y).
% ?- lfib(35,Y).
% ?- lfib(200,Y).
% ?- lfib(1000,Y).
%  ...


:- fun_eval arith(false).
% -------------------------------------------------------------------
% :- module(_,_).

%% * Meta-interpreters
%    ----------------

% Ciao-specific: makes dynamic clauses visible to clause/2
:- use_package(dynamic_clauses).
:- redefining(assert/1).
:- redefining(retract/1).
:- redefining(abolish/1).

% Declares lappend/3 dynamic, and thus visible to clause/2 
:- dynamic lappend/3.

lappend([],X,X).
lappend([X|Y],Z,[X|W]) :- lappend(Y,Z,W).

% Try (ask for several solutions):
% ?- '3examples':clause(H,B). 


% The 'vanilla' 3-line meta-interpreter: 
solve( true  ).
solve( (A,B) ) :- solve(A),    solve(B).
solve( A     ) :- clause(A,B), solve(B).

% Try (asking for multiple solutions):
% ?- solve(lappend([1,2],[3,4],L)).
% ?- solve(lappend(X,Y,[1,2,3,4])).

% This meta interpreter also implements backtracking!
 
% An application: 
% A version of the meta-interpreter that uses an extra argument to 
% counts the number of (forward) steps.
csolve( true,  0).
csolve( (A,B), N) :- csolve(A,NA), csolve(B,NB), N is NA+NB.
csolve( A,     N) :- clause(A,B),  csolve(B,N1), N is N1+1.

% Try:
% ?- csolve(lappend([1,2],[3,4],L),N).
% ?- csolve(lappend([1,2,a,b],[3,4],L),N).
% ?- csolve(lappend([1,2],[3,4,a,b],L),N).

% What does the cost (number of steps) of a call to append depend on?


% :- pred append(X,Y,Z) : list  * list * var + ub_steps(length(X)).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Difference lists 
%    ----------------

% Also known as open lists, incomplete lists, ...

% Try:

% ?- L = [1,2,3],
% A closed list; cannot easily add at the end.

% ?- L = [1,2,3|T].
% An incomplete list: we can add at the end by
% instantiating T!

% Create two difference lists L1 and L2 and append them:
% ``by hand'' 
% ?- L1 = [1,2,3|X], L2 = [3,4,5|Y], L2=X.

% A pseudo-type definition for difference lists:
dlist(X-X). 
dlist([_|DL]-X) :- dlist(DL-X).

% Try (ask for multiple solutions):
% ?- dlist(L).

% Appending difference lists (in constant time):

append_dl(B1-E1,E1-E2,B1-E2).

% Try: 
% ?- append_dl( [1,2,3|X]-X, [4,5|Y]-Y, L).
% L has the resulting (appended) diference list.
% But note that we have modified the tail of the 
% first list: we cannot append to it again.

% Checking:
% ?- append_dl( [1,2,3|X]-X, [4,5|Y]-Y, [1,2,3,4,5|Z]-Z).
% Substracting:
% ?- append_dl( L-X, [4,5|Y]-Y, [1,2,3,4,5|Z]-Z).
% ?- append_dl( L1-X, L2-Y, [1,2,3,4,5|Z]-Z).
% But only one solution!

% -------------------------------------------------------------------
% :- module(_,_).

%% * Quick-sort using standard lists and append
%    ------------------------------------------

qsort([],[]).
qsort([X|L],S) :-         % Take first element of list in X
   partition(L,X,LS,LB),  % LS are the elements of L < X
                          % LB are the elements of L >= X
   qsort(LS,LSS),         % LSS is LS sorted 
   qsort(LB,LBS),         % LBS is LB sorted 
   append(LSS,[X|LBS],S). % We append the small ones sorted to 
                          % the big ones sorted (w/X in front)

partition([],_P,[],[]).
partition([E|R],P,[E|Smalls],Bigs) :- % Take first element E
    E < P,            % If E < P add to list of smaller ones
    partition(R,P,Smalls,Bigs).
partition([E|R],P,Smalls,[E|Bigs]) :-
    E >= P,           % If E >= P add to list of larger ones
    partition(R,P,Smalls,Bigs).

% Try:
% ?- qsort([5,2,1,3,7,6], SL).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Quick-sort qsort using difference lists (no append!)
%    ----------------------------------------------------

% Partition is same as above!

%% ** Version 1: using -/2 functor and explicit unifications
%% (for explanation)

qsort_dl1(L,SL) :-
    qsort_dl1_(L,SL-SLE),
    SLE = [].

qsort_dl1_([],SLE-SLE).
qsort_dl1_([X|L],SL-SLE) :-
    partition(L,X,S,B),
    qsort_dl1_(S,SS-SSE),
    qsort_dl1_(B,BS-BSE),
    SSE = [X|BS],
    SL = SS,
    BSE = SLE.

% Try:
% qsort_dl1([5,2,1,3,7,6], SL).
% Run it in the debugger!

%% ** Version 2: still using -/ functor, but implicit unifications

qsort_dl2(L,SL) :-
    qsort_dl2_(L,SL-[]).

    
qsort_dl2_([],SLE-SLE).
qsort_dl2_([X|L],SL-SLE) :-
    partition(L,X,S,B),
    qsort_dl2_(S,SL-[X|BS]),
    qsort_dl2_(B,BS-SLE).

% Try:
% qsort_dl2([5,2,1,3,7,6], SL).

%% ** Version 3: using extra arguments, implicit unifications

qsort_dl(L,SL) :-
    qsort_dl_(L,SL,[]).
    
qsort_dl_([],SLE,SLE).
qsort_dl_([X|L],SL,SLE) :-
    partition(L,X,S,B),
    qsort_dl_(S,SL,[X|BS]),
    qsort_dl_(B,BS,SLE).

% Try:
% qsort_dl3([5,2,1,3,7,6], SL).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Parsing: using append and standard lists
%    ----------------------------------------

% A first approach at parsing: using append to match: 

myphrase_app(X) :-
    article_app(A),
    % A must be at the beginning of X, T1 is the rest:
    append(A,T1,X),
    spaces_app(S1),
    append(S1,T2,T1),
    noun_app(N),
    append(N,T3,T2),
    spaces_app(S2),
    append(S2,V,T3),
    verb_app(V).

article_app([a]).
article_app([t,h,e]).

spaces_app([' ']).
spaces_app([' ' | T]) :- 
    spaces_app(T).

noun_app([c,a,r]).
noun_app([p,l,a,n,e]).

verb_app([f,l,i,e,s]).
verb_app([d,r,i,v,e,s]).

% Try:
% ?- _X = [t,h,e,' ',p,l,a,n,e,' ',f,l,i,e,s],   myphrase_app(_X).
% ?- myphrase_app(X).


% -------------------------------------------------------------------
% :- module(_,_).

%% * Parsing: using difference lists
%    -------------------------------

% Reminder - difference lists:
% ?- L = [t,h,e|T], T = [' ',p,l,a,n,e|T2].
% We can add at the end by instantiating T, then T2, etc..

myphrase_dl(H,T) :-
    % Head of article is head of phrase, tail head of spaces
    article_dl(H,TA), spaces_dl(TA,TS1),
    noun_dl(TS1,TN),  spaces_dl(TN,TS2),
    verb_dl(TS2,T).

article_dl([a|T],T).
article_dl([t,h,e|T],T).

spaces_dl([' ' | T],T).
spaces_dl([' ' | Y],T) :- 
    spaces_dl(Y,T).

noun_dl([c,a,r | T],T).
noun_dl([p,l,a,n,e | T],T).

verb_dl([f,l,i,e,s | T],T).
verb_dl([d,r,i,v,e,s | T],T).

% Try:
% ?- _H = [t,h,e,' ',p,l,a,n,e,' ',f,l,i,e,s|T], myphrase_dl(_H,T).
% ?- myphrase_dl([t,h,e,' ',p,l,a,n,e,' ',f,l,i,e,s|T],T).
% We can also call with a closed list: 
% ?- myphrase_dl([t,h,e,' ',p,l,a,n,e,' ',f,l,i,e,s],[]).
% And we can generate both 
% ?- myphrase_dl(X,T).
% ?- myphrase_dl(X,[]).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Parsing: adding some syntax - using strings
%    -------------------------------------------

myphrase_dls(H,T) :-
    article_dls(H,TA), spaces_dls(TA,TS1),
    noun_dls(TS1,TN),  spaces_dls(TN,TS2),
    verb_dls(TS2,T).


% Reminder: strings "..." are lists of characters 
% i.e., X = "the"  means X = [0't,0'h,0'e], i.e., X = [116,104,101]
% || is for string like | for lists, i.e., 
% what follows is the tail of the list.

article_dls( "a"   || T, T).
% Translates to  article_dls( [ 97|T], T).
% i.e.,          article_dls( [0'a|T], T).
article_dls( "the" || T, T).
% Translates to  article_dls( [0't,0'h,0'e|T], T).


spaces_dls( " "    || T, T).
spaces_dls( " "    || Y, T) :- spaces_dls(Y, T).

noun_dls( "car"    || T, T).
noun_dls( "plane"  || T, T).

verb_dls( "flies"  || T, T).
verb_dls( "drives" || T, T).

% Try:
% ?- _S = "the plane flies", myphrase_dls(_S,[]).
% ?- myphrase_dls(S,[]).

% ?- set_prolog_flag(write_strings,on).
% ?- _S = "the plane flies", myphrase_dls(_S,[]).
% ?- myphrase_dls(S,[]).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Parsing: making the pairs of arguments implicit -> DCGs
%    -------------------------------------------------------
%    Definite CLause Grammars (DCGs)

:- use_package(dcg).
% :- use_package(sr/bfall).

myphrase --> article, spaces, noun, spaces, verb.
% Translates to:
% myphrase(X,CV) :- article(X,CA), spaces(CA,CS1), noun(CS1,CN),
%                   spaces(CN,CS2), verb(CS2,CV).

article --> "a".  % Translates to: article( "a"   || X, X).
article --> "the".

spaces --> " ".
spaces --> " ", spaces.

noun --> "car".
noun --> "plane".

verb --> "flies".
verb --> "drives".

% Try:
% ?- set_prolog_flag(write_strings,on).
% ?- _S = "the plane flies", myphrase(_S,[]).
% ?- myphrase(S,[]).
% Try also uncommenting :- use_pakage(sr/bfall).
% above and, again:
% ?- myphrase(S,[]).

% -------------------------------------------------------------------
% :- module(_,_).

%% * Parsing: DCGs + normal Prolog calls
%    -----------------------------------

% - Other actions can be interspersed with the grammar.
%   Plain Prolog can be called between ``{ ... }''
% - Additional arguments can be added; they go before the implicit ones. 

% Example: we add an additional argument to count number
% of characters parsed: 

myphrase_c(N) --> article_c(AC), spaces_c(S1), noun_c(NC), spaces_c(S2), 
                  verb_c(VC), { N is AC + S1 + NC + S2 + VC }.
% Translates to: 
% myphrase(N,X1,X6) :- article_c(AC,X1,X2), spaces_c(S1,X2,X3), noun_c(NC,X3,X4),
%                      spaces_c(S2,X4,X5), verb_c(VC,X5,X6), N is AC+S1+NC+S2+VC.

article_c(1) --> "a".
article_c(3) --> "the".

spaces_c(1) --> " ".
spaces_c(N) --> " ", spaces_c(N1), { N is N1+1 }.

noun_c(3) --> "car".
noun_c(5) --> "plane".

verb_c(5) --> "flies".
verb_c(6) --> "drives".

% Try:
% ?- set_prolog_flag(write_strings,on).
% ?- _S = "the plane flies",  myphrase_c(NChars,_S,[]).
% ?- myphrase_c(NChars,S,[]).

% -------------------------------------------------------------------
%% * Failure-driven loops

foo :- repeat, read(X), process(X).

process(end).
process(X) :- display(X), nl, fail.

% -------------------------------------------------------------------

wrepeat.
wrepeat :- wrepeat.

%% * End
