Heimseite
Seitenübersicht
An/abmeldung
Anschlagbrett
Herunterladen(c) 2005-2024 XLOG Technologies AG
/**
* 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.
*/
/****************************************************************/
/* Term Transform */
/****************************************************************/
/**
* sys_trans_horn(C, D):
* The predicate succeeds in D with the transformation
* of the clause or directive C.
*/
% sys_trans_horn(+Horn, -TRHorn)
sys_trans_horn(V, _) :- var(V),
throw(error(instantiation_error, _)).
sys_trans_horn((:- T), tr_goal(S)) :- !,
sys_trans_body(T, nothing, M, R, []),
sys_trans_mark(M, S, R).
sys_trans_horn((H :- T), tr_clause(M,H,R)) :- !,
sys_check_callable(H),
sys_trans_body(T, nothing, M, R, []).
sys_trans_horn(H, tr_clause(nothing,H,[])) :-
sys_check_callable(H).
/**
* sys_trans_body(B, N, M, R, L):
* The predicates succeeds in R with the transformation
* of the body B and the tail L. The options N and M
* do track the place holder used for cut transformation.
*/
% sys_trans_body(+Body, +Option, -Option, -List, +List)
sys_trans_body(A, N, N) --> {var(A)}, !, [call(A)].
sys_trans_body(true, N, N) --> !.
sys_trans_body((A,B), N, M) --> !,
sys_trans_body(A, N, J),
sys_trans_body(B, J, M).
sys_trans_body((A;B), N, M) --> !,
{sys_trans_disj((A;B), 0, N, M, R)},
['$ALT'(R)].
sys_trans_body((A->B), N, M) --> !,
{sys_trans_disj((A->B), 0, N, M, R)},
['$ALT'(R)].
sys_trans_body(!, N, just(X)) --> !,
{sys_trans_cut(N, X)},
['$CUT'(X)].
sys_trans_body(A, N, N) --> {sys_check_callable(A)},
[A].
/**
* 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, 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.
*/
% sys_trans_disj(+Disjunction, +Integer, +Option, -Option, -List)
sys_trans_disj(A, _, N, M, [R]) :- var(A), !,
sys_trans_alternative(A, N, M, R, _).
sys_trans_disj((A;B), _, N, M, [R|H]) :- !,
sys_trans_alternative(A, N, J, R, F),
sys_trans_disj(B, F, J, M, H).
sys_trans_disj(fail, 1, N, N, []) :- !.
sys_trans_disj(A, _, N, M, [R]) :-
sys_trans_alternative(A, N, M, R, _).
/**
* sys_trans_alternative(B, N, M, A, F):
* 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 F indicates whether
* the alternative was of the form (->)/2.
*/
% sys_trans_alternative(+Alternative, +Option, -Option, -Variant, -Integer)
sys_trans_alternative(A, N, M, '$SEQ'(nothing,R), 0) :- var(A), !,
sys_trans_body(A, N, M, R, []).
sys_trans_alternative((A->B), N, M, '$SEQ'(just(X),S), 1) :- !,
sys_trans_body(A, nothing, Q, R, ['$CUT'(X)|H]),
sys_trans_body(B, N, M, H, []),
sys_trans_mark(Q, S, R).
sys_trans_alternative(A, N, M, '$SEQ'(nothing,R), 0) :-
sys_trans_body(A, N, M, R, []).
/**
* sys_trans_mark(M, S, R):
* The 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).
/****************************************************************/
/* AST Encode */
/****************************************************************/
/**
* sys_encode_horn(C, D, F):
* The predicate succeeds in D with the encoded clause or directive C.
* The clause or directive needs to be already transformed.
* The flag F decide the indexing method.
*/
% sys_encode_horn(+TRHorn, -IRHorn, +Integer)
sys_encode_horn(tr_goal(R), ir_goal(S), F) :- !,
sys_ast_body(R, S, [], F, [], _).
sys_encode_horn(tr_clause(just(V),R,L), ir_clause(S,T,0,O), F) :- !,
R =.. [_|H],
sys_ast_list(H, S, [v(V,0,_)], M),
sys_ast_body(L, T, [R-V], F, M, _),
sys_idx_value(L, R, F, O).
sys_encode_horn(tr_clause(nothing,R,L), ir_clause(S,T,-1,O), F) :-
R =.. [_|H],
sys_ast_list(H, S, [], M),
sys_ast_body(L, T, [R], F, M, _),
sys_idx_value(L, R, F, O).
/**
* sys_encode_alternatives(L, G, R, F):
* The predicate succeeds in R with the encoded alternatives L
* and head G. The alternatives needs to be already transformed.
* The flag F decide the indexing method.
*/
% sys_encode_alternatives(+List, +Term, -List, +Integer)
sys_encode_alternatives(['$SEQ'(M,X)|L], G, [Y|R], F) :- !,
sys_encode_horn(tr_clause(M,G,X), Y, F),
sys_encode_alternatives(L, G, R, F).
sys_encode_alternatives([], _, [], _).
/**
* sys_ast_body(L, R, Z, F, I, O):
* The predicate succeeds in R with the ast for the list L.
* The parameter F is the indexing and linking flag, the
* parameter Z is the list of the previous goals in reverse
* order, the head and optionally the cut variable.
*/
% sys_ast_body(+List, -List, +List, +Integer, +Map, -Map)
sys_ast_body([X|L], [Y|R], Z, F) -->
sys_ast_goal(X, F, Y, L, Z),
sys_ast_body(L, R, [X|Z], F).
sys_ast_body([], [], _, _) --> [].
/**
* sys_ast_goal(G, F, H, T, Z, I, O):
* The predicate succeeds in H with the ast for the goal G.
* The parameter F is the indexing and linking flag, the
* parameter T is the tail goal list, the parameter Z is the
* list of the previous goals in reverse order, the head and
* optionally the cut variable.
*/
% sys_ast_goal(+Goal, +Integer, -Ast, +List, +List, +Map, -Map)
sys_ast_goal(call(G), 1, H, _, _) --> {var(G)}, !,
sys_ast_term(G, H).
sys_ast_goal('$ALT'(P), 1, H, T, Z) --> !,
{term_variables(T-Z, V),
term_variables(P, W),
eq_intersection(W, V, U),
G =.. [''|U],
sys_encode_alternatives(P, G, Q, 1)},
sys_ast_invoke(G, H, link(Q)).
sys_ast_goal(V is E, 1, D, _, _) --> !,
sys_ast_expr(E, F),
sys_ast_term(V, W),
{sys_const_functor(site('$EVAL'),[F,W],D)}.
sys_ast_goal(E =:= F, 1, D, _, _) --> !,
sys_ast_expr(E, G),
sys_ast_expr(F, H),
{sys_const_functor(site(=:=),[G,H],D)}.
sys_ast_goal(E =\= F, 1, D, _, _) --> !,
sys_ast_expr(E, G),
sys_ast_expr(F, H),
{sys_const_functor(site(=\=),[G,H],D)}.
sys_ast_goal(E < F, 1, D, _, _) --> !,
sys_ast_expr(E, G),
sys_ast_expr(F, H),
{sys_const_functor(site(<),[G,H],D)}.
sys_ast_goal(E > F, 1, D, _, _) --> !,
sys_ast_expr(E, G),
sys_ast_expr(F, H),
{sys_const_functor(site(>),[G,H],D)}.
sys_ast_goal(E =< F, 1, D, _, _) --> !,
sys_ast_expr(E, G),
sys_ast_expr(F, H),
{sys_const_functor(site(=<),[G,H],D)}.
sys_ast_goal(E >= F, 1, D, _, _) --> !,
sys_ast_expr(E, G),
sys_ast_expr(F, H),
{sys_const_functor(site(>=),[G,H],D)}.
sys_ast_goal(G, 1, H, _, _) --> {functor(G, F, _), atom(F)}, !,
sys_ast_invoke(G, H, site(F)).
sys_ast_goal(G, _, H, _, _) -->
sys_ast_term(G, H).
/**
* sys_ast_invoke(T, S, Q, I, O):
* Same like sys_ast_term/4 but will substitute the functor building.
*/
% sys_ast_invoke(+Term, -Ast, +Term, +Map, -Map)
sys_ast_invoke(C, D, Q) --> {compound(C)}, !,
{functor(C, _, _), C =.. [_|L]},
sys_ast_list(L, R),
{sys_const_functor(Q, R, D)}.
sys_ast_invoke(_, const(Q), Q) --> [].
/****************************************************************/
/* Expr AST */
/****************************************************************/
/**
* sys_ast_args(L, R, I, O):
* The predicate succeeds in R with the ast for the arguments L.
*/
% sys_ast_args(+List, -List, +Map, -Map)
sys_ast_args([X|L], [Y|R]) -->
sys_ast_expr(X, Y),
sys_ast_args(L, R).
sys_ast_args([], []) --> [].
/**
* sys_ast_expr(T, S, I, O):
* The predicate succeeds in S with the ast for the expression T.
*/
% sys_ast_expr(+Term, -Ast, +Map, -Map)
sys_ast_expr(V, W) --> {var(V)}, !,
sys_ast_var(V, W).
sys_ast_expr(C, H) --> {functor(C, F, _), atom(F)}, !,
sys_ast_compute(C, H, site(F)).
sys_ast_expr(C, D) --> {compound(C)}, !,
{functor(C, F, _), C =.. [_|L]},
sys_ast_args(L, R),
{sys_const_functor(F, R, D)}.
sys_ast_expr(A, const(A)) --> [].
/**
* sys_ast_compute(T, S, Q, I, O):
* Same like sys_ast_expr/4 but will substitute the functor building.
*/
% sys_ast_compute(+Term, -Ast, +Term, +Map, -Map)
sys_ast_compute(C, D, Q) --> {compound(C)}, !,
{functor(C, _, _), C =.. [_|L]},
sys_ast_args(L, R),
{sys_const_functor(Q, R, D)}.
sys_ast_compute(_, const(Q), Q) --> [].
/****************************************************************/
/* Term AST */
/****************************************************************/
/**
* sys_ast_list(L, R, I, O):
* The predicate succeeds in R with the ast for the list L.
*/
% sys_ast_list(+List, -List, +Map, -Map)
sys_ast_list([X|L], [Y|R]) -->
sys_ast_term(X, Y),
sys_ast_list(L, R).
sys_ast_list([], []) --> [].
/**
* sys_ast_term(T, S, I, O):
* The predicate succeeds in S with the ast for the term T.
*/
% sys_ast_term(+Term, -Ast, +Map, -Map)
sys_ast_term(V, W) --> {var(V)}, !,
sys_ast_var(V, W).
sys_ast_term(C, D) --> {compound(C)}, !,
{functor(C, F, _), C =.. [_|L]},
sys_ast_list(L, R),
{sys_const_functor(F, R, D)}.
sys_ast_term(A, const(A)) --> [].
% sys_const_functor(+Atom, +List, -Ast)
sys_const_functor(F, L, const(functor(F,R))) :-
sys_const_only(L, R), !.
sys_const_functor(F, L, functor(F,L)).
% sys_const_only(+List, -List)
sys_const_only([const(X)|L], [X|R]) :-
sys_const_only(L, R).
sys_const_only([], []).
/**
* sys_ast_var(V, W, I, O):
* The predicate succeeds in W with the ast for the variable V.
*/
% sys_ast_var(+Var, -Ast, +Map, -Map)
sys_ast_var(V, var(U,G)) --> sys_current_dcg(M),
{select(v(K,U,F), M, N), K == V}, !,
{F = 0},
sys_set_dcg([v(K,U,G)|N]).
sys_ast_var(V, first_var(U,G)) -->
sys_current_dcg(M),
sys_set_dcg([v(V,U,G)|M]).
% sys_current_dcg(-Map, +Map, -Map)
sys_current_dcg(M, M, M).
% sys_set_dcg(+Map, +Map, -Map)
sys_set_dcg(M, _, M).
/****************************************************************/
/* Body Indexing */
/****************************************************************/
/**
* sys_idx_value(L, R, F, O):
* The predicate succeeds in O with the indexing value of
* the clause with head R and body L. The flag F decide
* the indexing method.
*/
% sys_idx_value(+TRBody, +TRHead, +Integer, -Option)
sys_idx_value(_, R, F, O) :- arg(1, R, A), F /\ 1 =:= 0, !, sys_idx_value_term(A, O).
sys_idx_value(L, R, _, O) :- arg(1, R, A), !, sys_idx_value_arg(L, A, O).
sys_idx_value(_, _, _, nothing).
% sys_idx_value_arg(+TRBody, +Term, -Option)
sys_idx_value_arg(_, A, just(F)) :- nonvar(A), !, functor(A, F, _).
sys_idx_value_arg([B = C|L], A, O) :- A == B, !, sys_idx_value_arg(L, C, O).
sys_idx_value_arg([C = B|L], A, O) :- A == B, !, sys_idx_value_arg(L, C, O).
sys_idx_value_arg([_ = _|L], A, O) :- !, sys_idx_value_arg(L, A, O).
sys_idx_value_arg(_, _, nothing).
% sys_idx_value_term(+Term, -Option)
sys_idx_value_term(A, just(F)) :- nonvar(A), !, functor(A, F, _).
sys_idx_value_term(_, nothing).
/****************************************************************/
/* List Utility */
/****************************************************************/
/**
* eq_contains(S, E):
* The predicate succeeds when the set S contains the element E.
*/
% eq_contains(+List, +Elem)
eq_contains([X|_], Y) :- X == Y, !.
eq_contains([_|X], Y) :-
eq_contains(X, Y).
/**
* eq_intersection(S, T, R):
* The predicate succeeds in R with the intersection of S and T.
*/
% eq_intersection(+List, +List, -List)
eq_intersection([X|Y], Z, [X|T]) :-
eq_contains(Z, X), !,
eq_intersection(Y, Z, T).
eq_intersection([_|X], Y, Z) :- !,
eq_intersection(X, Y, Z).
eq_intersection([], _, []).
/****************************************************************/
/* Type Checks */
/****************************************************************/
% sys_check_callable(+Term)
sys_check_callable(A) :- callable(A), !.
sys_check_callable(V) :- var(V),
throw(error(instantiation_error,_)).
sys_check_callable(A) :-
throw(error(type_error(callable,A),_)).