Prolog "trans"
/**
* Modern Albufeira Prolog Interpreter
*
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
/**
* Reversibly transform a body by replacing / introducing
* - $ALT/1 / $SEQ/2 for disjuction (;)/2 and if-then-else (->)/2
* - $CUT/1 / $MARK/1 for cut (!)/0.
* - inlining / outlining for (\+)/1 and once/1
*
* Main data structures:
* - tr_goal(M,R):
* M cut option,
* R transformed goal list
* - tr_clause(M,X,R):
* M cut option,
* X head callable,
* R transformed goal list
*/
/**
* sys_trans_horn(C, D, F):
* The predicate succeeds in D with the transformation
* of the clause or directive C. The flag F decide the
* expansion method.
*/
% sys_trans_horn(+Horn, -TRHorn, +Integer)
sys_trans_horn(V, _, _) :- var(V),
throw(error(instantiation_error, _)).
sys_trans_horn((:- T), tr_goal(M,R), F) :- !,
sys_trans_body(T, nothing, M, F, R, []).
sys_trans_horn((X :- T), tr_clause(M,X,R), F) :- !,
must_be(callable, X),
sys_trans_body(T, nothing, M, F, R, []).
sys_trans_horn(X, tr_clause(nothing,X,[]), _) :-
must_be(callable, X).
/****************************************************************/
/* Body Transform */
/****************************************************************/
/**
* sys_trans_body(B, N, M, F, I, O):
* The predicates succeeds in I with the transformation
* of the body B and the tail O. The options N and M
* do track the place holder used for cut transformation.
* The flag F decide the expansion method.
*/
% sys_trans_body(+Body, +Option, -Option, +Integer, -TRBody, +TRBody)
sys_trans_body(A, N, N, _) --> {var(A)}, !, [call(A)].
sys_trans_body(true, N, N, _) --> !.
sys_trans_body((A,B), N, M, F) --> !,
sys_trans_body(A, N, J, F),
sys_trans_body(B, J, M, F).
sys_trans_body(!, N, just(X), _) --> !,
{sys_trans_cut(N, X)},
['$CUT'(X)].
sys_trans_body((A;B), N, M, F) --> !,
{sys_trans_disj((A;B), 0, N, M, F, R)},
['$ALT'(R)].
sys_trans_body((A->B), N, M, F) --> !,
{sys_trans_disj((A->B), 0, N, M, F, R)},
['$ALT'(R)].
sys_trans_body((\+ A), N, M, 1) --> {sys_safe_meta(A)}, !,
sys_trans_body((A -> fail; true), N, M, 1).
sys_trans_body(once(A), N, M, 1) --> {sys_safe_meta(A)}, !,
sys_trans_body((A -> true), N, M, 1).
sys_trans_body(X, N, N, _) --> {must_be(callable, X)},
[X].
/**
* sys_trans_cut(N, V):
* The predicate succeeds in V with choice point variable from the option N.
*/
% sys_trans_cut(+Option, -Var)
sys_trans_cut(nothing, _) :- !.
sys_trans_cut(just(X), X).
/**
* sys_trans_disj(B, N, M, F, R):
* The predicates succeeds in R with the transformation
* of the disjunction B. The options N and M do track the
* place holder used for cut transformation. The flag F
* decide the expansion method.
*/
% sys_trans_disj(+Disjunction, +Integer, +Option, -Option, +Integer, -TRBody)
sys_trans_disj(A, _, N, M, F, [R]) :- var(A), !,
sys_trans_alter(A, N, M, R, F, _).
sys_trans_disj((A;B), _, N, M, F, [R|H]) :- !,
sys_trans_alter(A, N, J, R, F, G),
sys_trans_disj(B, G, J, M, F, H).
sys_trans_disj(fail, 1, N, N, _, []) :- !.
sys_trans_disj(A, _, N, M, F, [R]) :-
sys_trans_alter(A, N, M, R, F, _).
/**
* sys_trans_alter(B, N, M, A, F, G):
* The predicates succeeds in A with the transformation of the
* alternative B. The options N and M do track the place holder
* used for cut transformation. The argument G indicates whether
* the alternative was of the form (->)/2. The flag F
* decide the expansion method.
*/
% sys_trans_alter(+Alternative, +Option, -Option, -TRGoal, +Integer, -Integer)
sys_trans_alter(A, N, M, '$SEQ'(nothing,R), F, 0) :- var(A), !,
sys_trans_body(A, N, M, F, R, []).
sys_trans_alter((A->B), N, M, '$SEQ'(just(X),S), F, 1) :- !,
sys_trans_body(A, nothing, Q, F, R, ['$CUT'(X)|H]),
sys_trans_body(B, N, M, F, H, []),
sys_trans_mark(Q, S, R).
sys_trans_alter(A, N, M, '$SEQ'(nothing,R), F, 0) :-
sys_trans_body(A, N, M, F, R, []).
/**
* sys_trans_mark(M, S, R):
* The predicate succeeds in S with the list R, possibly prepended
* by a choice point variable access, depending on option M.
*/
% sys_trans_mark(+Option, -List, +List)
sys_trans_mark(just(X), ['$MARK'(X)|R], R) :- !.
sys_trans_mark(nothing, R, R).
/****************************************************************/
/* Goal Inlining */
/****************************************************************/
% sys_safe_meta(+Term)
sys_safe_meta(V) :- var(V), !, fail.
sys_safe_meta((X,Y)) :- !,
sys_safe_meta(X),
sys_safe_meta(Y).
sys_safe_meta((X;Y)) :- !,
sys_safe_meta(X),
sys_safe_meta(Y).
sys_safe_meta((X->Y)) :- !,
sys_safe_meta(X),
sys_safe_meta(Y).
sys_safe_meta(X) :-
callable(X).
/****************************************************************/
/* Body Untransform */
/****************************************************************/
/**
* sys_untrans_body(L, O, F, B):
* The predicate succeeds in B with the untransformed option O
* and goal list L. The flag F decide the deflation method.
*/
% sys_untrans_body(+List, +Option, +Integer, -Goal)
sys_untrans_body([], _, _, true).
sys_untrans_body([X|L], O, F, Y) :-
sys_untrans_goal(X, O, F, Z),
sys_untrans_rest(L, Z, O, F, Y).
% sys_untrans_rest(+List, +Goal, +Option, +Integer, -Goal)
sys_untrans_rest(L, (A -> fail; true), O, 1, Y) :- !,
sys_untrans_rest(L, (\+ A), O, 1, Y).
sys_untrans_rest(L, (A -> true), O, 1, Y) :- !,
sys_untrans_rest(L, once(A), O, 1, Y).
sys_untrans_rest([], X, _, _, X).
sys_untrans_rest([Y|L], X, O, F, (X, T)) :-
sys_untrans_goal(Y, O, F, Z),
sys_untrans_rest(L, Z, O, F, T).
/**
* sys_untrans_goal(G, O, F, H):
* The predicate succeeds in H with the untransformed option O
* and goal G. The flag F decide the deflation method.
*/
% sys_untrans_goal(+Callable, +Option, +Integer, -Goal)
sys_untrans_goal('$CUT'(X), just(Y), _, !) :- X == Y, !.
sys_untrans_goal('$ALT'(P), O, F, Q) :- !,
sys_untrans_disj(P, O, F, Q).
sys_untrans_goal(X, _, _, X).
/**
* sys_untrans_disj(P, O, F, Q):
* The predicate succeeds in Q with the untransformed option O
* and alternatives P. The flag F decide the deflation method.
*/
% sys_untrans_disj(+List, +Option, +Integer, -Goal)
sys_untrans_disj([], _, _, fail).
sys_untrans_disj([X|L], O, F, Y) :-
sys_untrans_more(L, X, O, F, Y).
% sys_untrans_more(+List, +Cond, +Option, +Integer, -Goal)
sys_untrans_more([], '$SEQ'(M,X), O, F, Y) :-
sys_untrans_alter(M, X, O, F, Y).
sys_untrans_more([Y|L], '$SEQ'(M,X), O, F, (Z;T)) :-
sys_untrans_alter(M, X, O, F, Z),
sys_untrans_more(L, Y, O, F, T).
/**
* sys_untrans_alter(U, V, O, F, Z):
* The predicate succeeds in Z with the untransformed option O
* and cutvar U and body V. The flag F decide the deflation method.
*/
% sys_untrans_alter(+Option, +List, +Option, +Integer, -Goal)
sys_untrans_alter(nothing, L, O, F, B) :-
sys_untrans_body(L, O, F, A),
sys_untrans_ambiguity(A, B).
sys_untrans_alter(just(X), L, O, F, (A -> B)) :-
sys_untrans_split(L, X, P, Q),
sys_trans_mark(M, P, R),
sys_untrans_body(R, M, F, A),
sys_untrans_body(Q, O, F, B).
/**
* sys_untrans_split(L, X, P, Q):
* The predicate succeeds in P and Q with the split of the
* list of goals L by the redo variable X.
*/
% sys_untrans_split(+List, +Var, -List, -List)
sys_untrans_split(['$CUT'(X)|L], Y, [], L) :- X == Y, !.
sys_untrans_split([X|L], Y, [X|P], Q) :-
sys_untrans_split(L, Y, P, Q).
/**
* sys_untrans_ambiguity(B, A):
* The predicate succeeds in A with a body logically
* equivalent to B, that doesn't have the form (_ -> _).
*/
% sys_untrans_ambiguity(+Alternative, -Body)
sys_untrans_ambiguity((A -> B), (A -> B; fail)) :- !.
sys_untrans_ambiguity(A, A).