1:- module(prog_in_prog, [solve/1]).    2
    3% Prolog in Prolog.
    4% Available codes in targets codes.
    5%
    6% true/0, fail/0, !/0, var/1, nonvar/1, ;/2,
    7% clause/2, call/1, predicate_property/2,
    8% SWI standard builtins
    9
   10% The codes relies on these primitives:
   11% true/0, fail/0, !/0, var/1, nonvar/1, ;/2,
   12% clause/2, call/1, predicate_property/2,
   13
   14% ?- solve(true).
   15% ?- solve(false).
   16% ?- solve(false -> true).   % Prolog behaviour.
   17% ?- solve(1=2 -> 1=2; 2=2).
   18% ?- solve(((X=1, X=2) -> (Y = 1; Y=2)); Y =3; Y=4).
   19% ?- solve(((X=1; X=2) -> (Y = 1; Y=2)); Y =3; Y=4).
   20% ?- solve(solve(((X=1, X=2) -> (Y = 1; Y=2)); Y =3; Y=4)).
   21% ?- solve(solve(((X=1; X=2) -> (Y = 1; Y=2)); Y =3; Y=4)).
   22
   23% test usual Prolog goals.
   24% ?- x(X).
   25% ?- solve(x(X)).
   26% ?- solve(solve(x(X))).  % Idempotency.
   27% ?- solve(solve(solve(x(X)))).
   28% ?- solve(solve(solve(solve(x(X))))).
   29
   30x(1).
   31x(2).
   32x(3):-!.
   33x(4).
   34
   35% test the cut (!) in toplevel query.
   36% ?- X=1; X=2; ! ; X=3; X=4.
   37% ?- solve(X=1; X=2; ! ; X=3; X=4).
   38% ?- solve((member(X, [1,2,3]), !, member(Y, [a,b,c]), !, member(Z, [u,v,w]))).
   39% ?- solve(solve((member(X, [1,2,3]), !, member(Y, [a,b,c]), !, member(Z, [u,v,w])))).
   40
   41% More samples which use clauses  a/1, b/1, c/1, d/2, e/1 defined below.
   42% ?- a(X).
   43% ?- solve(a(X)).
   44% ?- solve(solve(a(X))).
   45% ?- solve(solve(solve(a(X)))).
   46
   47% sample clauses.
   48a(X):- b(X).
   49%
   50b(Y):- (Y= 1 ; c(X), !, d(X, Y) ; Y =3).
   51%
   52c(2).
   53c(4).
   54%
   55d(X, f(X)).
   56d(X, g(X)).
   57%
   58e(X):- a(X).
   59
   60%
   61:- meta_predicate solve(0).   62solve(G):- solve(G, Cut, user),
   63		(	var(Cut)
   64		;	nonvar(Cut), !, fail
   65		).
   66%
   67solve(true, _, _):-!.
   68solve(fail, _, _):-!, fail.
   69solve(!, Cut, _):- var(Cut).	% crucial.
   70solve(!, !, _):-!.				% crucial.
   71solve(M:A, Cut, _):-!, solve(A, Cut, M).
   72solve((A, B), Cut, M):-!,
   73	( solve(A, Cut, M), solve(B, Cut, M) ).
   74solve((A; B), Cut, M):-!,
   75	( solve(A, Cut, M)
   76	; solve(B, Cut, M)
   77	).
   78solve(_, Cut, _):- Cut==!, !.
   79solve(solve(G), _, M):-!, solve(G, Cut, M),
   80	( var(Cut);  nonvar(Cut), !, fail).
   81% solve(solve(G), _, M):-!, solve(M:G).   % Also, of course, OK!
   82solve(A->B, Cut, M):-!, solve((A, !, B), Cut, M).
   83solve(call(G), _, M):-!, call(M:G).
   84solve(A, _, M):- predicate_property(M:A, built_in),	!,
   85	call(M:A).
   86solve(A, _, M):- predicate_property(M:A, imported_from(_)), !,
   87	call(M:A).
   88solve(A, _, M):- predicate_property(M:A, interpreted), !,
   89	clause(M:A, G),
   90	solve(G, Cut, M),
   91	( var(Cut); nonvar(Cut), !,	fail ).		% crucial.
   92solve(G, _, M):- call(M:G).  % Unexpected_type_of_call, though.