/************************************************************************* * * * YAP Prolog * * * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 * * * *************************************************************************/ %% @{ :- system_module( '$_atoms', [ atom_concat/2, string_concat/2, atomic_list_concat/2, atomic_list_concat/3, current_atom/1], []). :- use_system_module( '$_errors', ['$do_error'/2]). %% @{ /** * @addtogroup Predicates_on_Atoms * @ingroup YAPChars * */ /** @pred atom_concat(+ _As_,? _A_) The predicate holds when the first argument is a list of atoms, and the second unifies with the atom obtained by concatenating all the atoms in the first list. */ atom_concat(Xs,At) :- ( var(At) -> '$atom_concat'(Xs, At ) ; '$atom_concat_constraints'(Xs, 0, At, Unbound), '$process_atom_holes'(Unbound) ). % the constraints are of the form hole: HoleAtom, Begin, Atom, End '$atom_concat_constraints'([At], 0, At, []) :- !. '$atom_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :- !. % just slice first atom '$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :- atom(At0), !, sub_atom(At0, 0, _Sz, L, _Ata ), sub_atom(At, _, L, 0, Atr ), %remainder '$atom_concat_constraints'(Xs, 0, Atr, Unbound). % first hole: Follow says whether we have two holes in a row, At1 will be our atom '$atom_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :- '$atom_concat_constraints'(Xs, mid(Next,_At1), At, Unbound). % end of a run '$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :- atom(At0), !, sub_atom(At, Next, _Sz, L, At0), sub_atom(At, 0, Next, Next, At1), sub_atom(At, _, L, 0, Atr), %remainder '$atom_concat_constraints'(Xs, 0, Atr, Unbound). '$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :- '$atom_concat_constraints'(Xs, mid(Follow, At1), At, Unbound). '$process_atom_holes'([]). '$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !, sub_atom(At1, Next, _, 0, At0), '$process_atom_holes'(Unbound). '$process_atom_holes'([hole(At0, Next, At1, Follow)|Unbound]) :- sub_atom(At1, Next, Sz, _Left, At0), Follow is Next+Sz, '$process_atom_holes'(Unbound). /** @pred atomic_list_concat(+ _As_,? _A_) The predicate holds when the first argument is a list of atomic terms, and the second unifies with the atom obtained by concatenating all the atomic terms in the first list. The first argument thus may contain atoms or numbers. */ atomic_list_concat(L,At) :- atomic_concat(L, At). /** @pred atomic_list_concat(? _As_,+ _Separator_,? _A_) Creates an atom just like atomic_list_concat/2, but inserts _Separator_ between each pair of atoms. For example: ~~~~~{.prolog} ?- atomic_list_concat([gnu, gnat], `, `, A). A = `gnu, gnat` ~~~~~ YAP emulates the SWI-Prolog version of this predicate that can also be used to split atoms by instantiating _Separator_ and _Atom_ as shown below. ~~~~~{.prolog} ?- atomic_list_concat(L, -, 'gnu-gnat'). L = [gnu, gnat] ~~~~~ */ atomic_list_concat(L, El, At) :- var(El), !, '$do_error'(instantiation_error,atomic_list_concat(L,El,At)). atomic_list_concat(L, El, At) :- ground(L), !, '$add_els'(L,El,LEl), atomic_concat(LEl, At). atomic_list_concat(L, El, At) :- nonvar(At), !, '$atomic_list_concat_all'( At, El, L). '$atomic_list_concat_all'( At, El, [A|L]) :- sub_atom(At, Pos, 1, Left, El), !, sub_atom(At, 0, Pos, _, A), sub_atom(At, _, Left, 0, At1), '$atomic_list_concat_all'( At1, El, L). '$atomic_list_concat_all'( At, _El, [At]). '$add_els'([A,B|L],El,[A,El|NL]) :- !, '$add_els'([B|L],El,NL). '$add_els'(L,_,L). % % small compatibility hack '$singletons_in_term'(T,VL) :- '$variables_in_term'(T,[],V10), '$sort'(V10, V1), '$non_singletons_in_term'(T,[],V20), '$sort'(V20, V2), '$subtract_lists_of_variables'(V2,V1,VL). '$subtract_lists_of_variables'([],VL,VL). '$subtract_lists_of_variables'([_|_],[],[]) :- !. '$subtract_lists_of_variables'([V1|VL1],[V2|VL2],VL) :- V1 == V2, !, '$subtract_lists_of_variables'(VL1,VL2,VL). '$subtract_lists_of_variables'([V1|VL1],[V2|VL2],[V2|VL]) :- '$subtract_lists_of_variables'([V1|VL1],VL2,VL). /** @pred current_atom( _A_) Checks whether _A_ is a currently defined atom. It is used to find all currently defined atoms by backtracking. */ current_atom(A) :- % check atom(A), !. current_atom(A) :- % generate '$current_atom'(A). string_concat(Xs,At) :- ( var(At) -> '$string_concat'(Xs, At ) ; '$string_concat_constraints'(Xs, 0, At, Unbound), '$process_string_holes'(Unbound) ). % the constraints are of the form hole: HoleString, Begin, String, End '$string_concat_constraints'([At], 0, At, []) :- !. '$string_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :- !. % just slice first string '$string_concat_constraints'([At0|Xs], 0, At, Unbound) :- string(At0), !, sub_string(At, 0, _Sz, L, At0 ), sub_string(At, _, L, 0, Atr ), %remainder '$string_concat_constraints'(Xs, 0, Atr, Unbound). % first hole: Follow says whether we have two holes in a row, At1 will be our string '$string_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :- '$string_concat_constraints'(Xs, mid(Next,_At1), At, Unbound). % end of a run '$string_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :- string(At0), !, sub_string(At, Next, _Sz, L, At0), sub_string(At, 0, Next, Next, At1), sub_string(At, _, L, 0, Atr), %remainder '$string_concat_constraints'(Xs, 0, Atr, Unbound). '$string_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :- '$string_concat_constraints'(Xs, mid(Follow, At1), At, Unbound). '$process_string_holes'([]). '$process_string_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !, sub_string(At1, Next, _, 0, At0), '$process_string_holes'(Unbound). '$process_string_holes'([hole(At0, Next, At1, Follow)|Unbound]) :- sub_string(At1, Next, Sz, _Left, At0), Follow is Next+Sz, '$process_string_holes'(Unbound). /** @} */