
/****** Contrived example that uses cut (!):   */

isSweet(icecream).
isSweet(candy).

likes(john, icecream).
likes(john, X) :- likes(kim, X).
likes(kim, X) :- isSweet(X).

likesSweet(Who, What) :- isSweet(What), likes(Who, What).

likesFirst(Who, What) :- isSweet(What), !, likes(Who, What).
/* Cut (!) does not allow backtracking past !.
   Whatever environment first arrives at  !  must be retained.
   Here, all proofs must use the first value for  What  such that
     isSweet(What)  holds true.   */

/* Using cut to get at most one answer:  */
likesOne(Who, What) :- isSweet(What), likes(Who, What), !.


/****** Using cut for "exception handling": */

/* get(I, L, E)  holds true if  E  is the  I-th  element in list L */
get(0, [H|T], H).
get(I, [H|T], E) :-  J is I - 1,  get(J, T, E).
/* all other combinations of arguments are erroneous: */
get(I, L, error).


/* The above doesn't work correctly (try it).  Add cut (!): */
getE(0, [H|T], H) :- !.
getE(I, [H|T], E) :-  J is I - 1,  getE(J, T, E), !.
/* all other combinations of arguments are erroneous:  */
getE(I, L, error).


/**** using cut to define "negation as proof failure": */

not(P) :- call(P), !, fail.     /* fail  means  "false" */
not(P).
/*  call(P)  executes  P  as a predicate. It's similar to  exec  in Python
    and  eval  in Lisp.  */
/* example queries:   ?- not(likes(john, poison)).
                      ?- not(likes(ed, X)). 
                      ?- not(not(true)).      
   ?- write('Type a predicate and a period to run: '), read(P), nl, call(P). 
*/
