Skip to content

Commit

Permalink
fix clash predicates in common - fixes #6
Browse files Browse the repository at this point in the history
  • Loading branch information
ssardina committed Aug 16, 2024
1 parent 7181736 commit cd3b91b
Show file tree
Hide file tree
Showing 4 changed files with 40 additions and 58 deletions.
9 changes: 4 additions & 5 deletions config.pl
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
This file contains various wide-system configuration variables and options
such as location of files/modules, libraries, constants, etc.
@author ssardina 2002-2024 - [email protected]
@author ssardina 2002-2024 - [email protected], [email protected]
*/

% asserts root_indigolog/1 with the path to the INDIGOLOG root folder
Expand All @@ -16,11 +16,9 @@
:- root_indigolog(Dir),
directory_file_path(Dir, 'lib', LibDir),
assert(library_directory(LibDir)),
% use_module(library(eclipse_swi)), init_eclipse_lib, % ECLIPSE Compat lib
% use_module(library(tools_swi)),
use_module(library(utils)),
use_module(library(time)), % for call_with_time_limit/2
% style_check(-discontiguous),
% style_check(-discontiguous), % use it where wanted
set_prolog_flag(optimise, true).


Expand Down Expand Up @@ -50,7 +48,8 @@
root_indigolog(Dir),
directory_file_path(Dir, "devices/exog.tcl", F).

:- dir(indigolog, F), consult(F).
% this consults the standard indigolog interpreter
% :- dir(indigolog, F), consult(F).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Expand Down
28 changes: 15 additions & 13 deletions interpreters/indigolog_plain.pl
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@
can use ask_exog_occurs (or fail, if none)
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- style_check(-discontiguous). % SWI dependent!
:- style_check(-discontiguous). % SWI specific!

:-dynamic senses/2.
:-dynamic exog_action/1.
Expand Down Expand Up @@ -79,10 +79,12 @@
% may use as a simulated environment.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ask_exog_occurs(A) :- write('Exogenous input (ending with "."): '), read(A).
ask_exog_occurs(A) :-
write('Exogenous input (ending with "."): '), read(A).

ask_execute(A, _) :- \+ senses(A, _), !, write(A), nl.
ask_execute(A, SR) :- senses(A,_), format("~w - Sensing outcome: ", [A]), read(SR).
ask_execute(A, SR) :- senses(A,_),
format("~w - Sensing outcome: ", [A]), read(SR).



Expand Down Expand Up @@ -175,19 +177,19 @@
holds(P,H) :- proc(P,P1), holds(P1,H).
holds(P,H) :- \+ proc(P, _), subf(P, P1, H), call(P1).

/* T2 is T1 with X1 replaced by X2 */
subv(_,_,T1,T2) :- (var(T1) ; integer(T1)), !, T2 = T1.
subv(X1,X2,T1,T2) :- T1 = X1, !, T2 = X2.
subv(X1,X2,T1,T2) :- T1 =..[F|L1], subvl(X1,X2,L1,L2), T2 =..[F|L2].
subvl(_,_,[],[]).
subvl(X1,X2,[T1|L1],[T2|L2]) :- subv(X1,X2,T1,T2), subvl(X1,X2,L1,L2).
/* T2 is T1 with X1 replaced by X2 */
% NOW parts of utils.pl module -- uncomment if loaded stand-alone
% subv(_,_,T1,T2) :- (var(T1) ; integer(T1)), !, T2 = T1.
% subv(X1,X2,T1,T2) :- T1 = X1, !, T2 = X2.
% subv(X1,X2,T1,T2) :- T1 =..[F|L1], subvl(X1,X2,L1,L2), T2 =..[F|L2].
% subvl(_,_,[],[]).
% subvl(X1,X2,[T1|L1],[T2|L2]) :- subv(X1,X2,T1,T2), subvl(X1,X2,L1,L2).

/* P2 is P1 with all fluents replaced by their values */
subf(P1,P2,_) :- (var(P1);integer(P1)), !, P2 = P1.
subf(P1,P2,_) :- (var(P1) ; integer(P1)), !, P2 = P1.
subf(P1,P2,H) :- prim_fluent(P1), has_val(P1,P2,H).
subf(P1,P2,H) :- \+ prim_fluent(P1), P1=..[F|L1], subfl(L1,L2,H), P2=..[F|L2].
subfl([],[],_).
subfl([T1|L1],[T2|L2],H) :- subf(T1,T2,H), subfl(L1,L2,H).
subf(P1,P2,H) :- \+ prim_fluent(P1), P1=..[F|L1],
maplist({H}/[A,B]>>subf(A,B,H), L1, L2), P2=..[F|L2].


% has_val(F,V,H): Fluent F has value V in history H.
Expand Down
38 changes: 0 additions & 38 deletions lib/common.pl
Original file line number Diff line number Diff line change
@@ -1,45 +1,7 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 1 - GENERAL
%
% -- subv(+X1,+X2,+T1,-T2)
% T2 is T1 with X1 replaced by X2
% -- sublist(?SubList, +List)
% Succeeds if List is the list which contains all elements from SubList
% -- get_integer(+Low, ?N, +High)
% N is an integer between Low and High
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/* T2 is T1 with X1 replaced by X2 */
subv(X1,X2,T1,T2) :- var(T1), T1 == X1, !, T2 = X2.
subv(_,_,T1,T2) :- var(T1), !, T2 = T1.
subv(X1,X2,T1,T2) :- T1 == X1, !, T2 = X2.
subv(X1,X2,T1,T2) :- T1 =..[F|L1], subvl(X1,X2,L1,L2), T2 =..[F|L2].

subvl(_,_,[],[]).
subvl(X1,X2,[T1|L1],[T2|L2]) :- subv(X1,X2,T1,T2), subvl(X1,X2,L1,L2).




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 2 - STRINGS AND ATOMS
%
% -- any_to_number(+T, -Number)
% Convert an atom, string, or list of chars T into a number
% -- join_atom/3
% -- join_atom(+List, +Glue, -Atom)
% Atom is the atom formed by concatenating the elements of List with an
% instance of Glue beween each of them.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


% -- join_atom(List, Glue, Atom)
% Atom is the atom formed by concatenating the elements of List with an
% instance of Glue beween each of them.
join_atom(List, Glue, Atom) :-
maplist(any_to_string, List, List2),
join_string(List2, Glue, String),
string_to_atom(String, Atom).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Expand Down
23 changes: 21 additions & 2 deletions lib/utils.pl
Original file line number Diff line number Diff line change
@@ -1,20 +1,39 @@
:- module(utils, [
% 1 - TOOLS
% 2 - STRINGS
subv/4,
% 2 - DATA CONVERSION
any_to_string/2,
join_atom/3,
% 3 - OS TOOLS
send_term/2
]).


%! subv(++X2, ++X1, +T1, -T2) is det
% T2 is T1 with X1 replaced by X2 - T2 = T1|_{X1/X2}
subv(X1, X2, T1, T2) :- var(T1), T1 == X1, !, T2 = X2.
subv(_, _, T1, T2) :- var(T1), !, T2 = T1.
subv(X1, X2, T1, T2) :- T1 == X1, !, T2 = X2.
subv(X1, X2, T1, T2) :- T1 =..[F|L1], maplist(subv(X1, X2), L1, L2), T2 =..[F|L2].

% Convert anything into a string: generalizes term_string/2 to allow vars

%! any_to_string(+A, -S) is det
% Convert anything A into a string S.
% OBS: generalizes term_string/2 to allow variables
any_to_string(A, "_Var") :- var(A), !.
any_to_string(A, A) :- string(A), !.
any_to_string(A, S) :- atom(A), atom_string(A, S), !.
any_to_string(A, S) :- term_string(A, S).


%! join_atom(List, Glue, Atom)
% Atom is the atom formed by concatenating the elements of List with an
% instance of Glue between each of them.
join_atom(List, Glue, Atom) :-
maplist(any_to_string, List, List2),
join_string(List2, Glue, String),
string_to_atom(String, Atom).


% this will send the term, full stop, and a space
send_term(Stream, Term) :-
Expand Down

0 comments on commit cd3b91b

Please sign in to comment.